April 2008 - claw-cvs@common-lisp.net - mailman3.common-lisp.net

[claw-cvs] r43 - in trunk/main/claw-core: src tests
by achiumenti＠common-lisp.net 27 Apr '08

27 Apr '08

Author: achiumenti Date: Sun Apr 27 12:15:22 2008 New Revision: 43 Modified: trunk/main/claw-core/src/lisplet.lisp 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/translators.lisp trunk/main/claw-core/src/validators.lisp trunk/main/claw-core/tests/test1.lisp Log: API cleanup Modified: trunk/main/claw-core/src/lisplet.lisp ============================================================================== --- trunk/main/claw-core/src/lisplet.lisp (original) +++ trunk/main/claw-core/src/lisplet.lisp Sun Apr 27 12:15:22 2008 @@ -86,7 +86,7 @@ (setf *http-error-handler* ;;overrides the default hunchentoot error handling #'(lambda (error-code) - (let* ((error-handlers (lisplet-error-hadlers (current-lisplet))) + (let* ((error-handlers (lisplet-error-handlers (current-lisplet))) (handler (gethash error-code error-handlers))) (if handler (funcall handler) @@ -112,7 +112,7 @@ :accessor lisplet-pages :documentation "A collection of cons where the car is an url location and the cdr is a dispatcher") (error-handlers :initform (make-hash-table) - :accessor lisplet-error-hadlers + :accessor lisplet-error-handlers :documentation "An hash table where keys are http error codes and values are functions with no parameters") (protected-resources :initform nil :accessor lisplet-protected-resources @@ -192,9 +192,7 @@ (uri (request-uri)) (welcome-page (lisplet-welcome-page lisplet))) (progn - ;;(setf (aux-request-value 'lisplet) lisplet) (setf (current-lisplet) lisplet) - ;;(setf (aux-request-value 'realm) (lisplet-realm lisplet)) (setf (current-realm) (lisplet-realm lisplet)) (lisplet-check-authorization lisplet) (when (= (return-code) +http-ok+) Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Sun Apr 27 12:15:22 2008 @@ -74,7 +74,7 @@ (let ((result (remove-by-location (car location-cons) cons-list))) (setf result (push location-cons result)))) -(defun lisplet-start-session () +(defun start-session () "Starts a session bound to the current lisplet base path" (start-session (format nil "~@[~a~]~a/" *clawserver-base-path* (lisplet-base-path (current-lisplet))))) @@ -119,7 +119,7 @@ (defun (setf current-principal) (principal &optional (session *session*)) "Setf the principal(user) that logged into the application" (unless session - (setf session (lisplet-start-session))) + (setf session (start-session))) (setf (session-value 'principal session) principal)) (defun user-in-role-p (roles &optional (session *session*)) @@ -191,7 +191,7 @@ ,default-val))))) (defun do-message (key &optional (default "") locale) - "This function call the lambda function returned by the WITH-MESSAGE macro." + "This function calls the lambda function returned by the WITH-MESSAGE macro." (funcall (with-message key default locale))) (defun user-locale (&optional (request *request*) (session *session*)) @@ -211,7 +211,7 @@ "This function forces the locale for the current user, binding it to the user session, that is created if no session exists." (unless session - (setf session (lisplet-start-session))) + (setf session (start-session))) (setf (session-value 'locale session) locale)) (defun validation-errors (&optional (request *request*)) Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Sun Apr 27 12:15:22 2008 @@ -34,7 +34,7 @@ (defpackage :claw (:use :cl :closer-mop :hunchentoot :alexandria :cl-ppcre :cl-fad :local-time) - (:shadow :flatten) + (:shadow :flatten :start-session) (:documentation "A comprehensive web application framework and server for the Common Lisp programming language") (:export :*html-4.01-strict* :*html-4.01-transitional* @@ -52,46 +52,29 @@ :strings-to-jsarray :empty-string-p :build-tagf - :parse-htcomponent-function - :page ;page classes hadle the whole rendering cycle - :message-dispatch - :page-writer - :page-can-print - :page-url + :page + :message-dispatch :page-lisplet :page-current-form - :page-req-parameter - :page-json-id-list - :page-format - :page-format-raw + :page-req-parameter :page-script-files :page-stylesheet-files :page-class-initscripts :page-instance-initscripts - :page-indent - :page-xmloutput - :page-doc-type - :page-current-component - :page-content-type - :htclass-body + :page-current-component :htcomponent :htcomponent-page :htcomponent-body -; :setf-htcomponent-page - :htcomponent-attributes - :htcomponent-can-print :htcomponent-empty :htcomponent-client-id :htcomponent-script-files :htcomponent-stylesheet-files :htcomponent-class-initscripts :htcomponent-instance-initscript - :tag ;class for tags that accept body + :tag :tag-name - :tag-render-starttag - :tag-render-endtag + :tag-attributes :htbody - :page-body-init-scripts :htscript :htlink :hthead @@ -193,32 +176,23 @@ :var> ;; class modifiers :page-content - :page-render :generate-id :metacomponent :wcomponent - :wcomponent-parameters :wcomponent-informal-parameters :wcomponent-allow-informal-parametersp :wcomponent-template - :wcomponent-parameter-value :wcomponent-before-rewind :wcomponent-after-rewind :wcomponent-before-prerender :wcomponent-after-prerender :wcomponent-before-render :wcomponent-after-render - :make-component :cform :cform> :action-link :action-link> - :base-cinput :cinput - :cinput-reader - :cinput-writer - :cinput-accessor - :cinput-visit-object :cinput> :cselect :cselect> @@ -227,18 +201,12 @@ :submit-link :submit-link> :lisplet - :lisplet-realm :lisplet-pages - :lisplet-base-path - :lisplet-dispatch-method :lisplet-register-page-location :lisplet-register-function-location :lisplet-register-resource-location - :lisplet-protect - :lisplet-authentication-type - :lisplet-start-session - :lisplet-error-handlers - :lisplet-redirect-protected-resources-p + :lisplet-protect + :start-session ;; clawserver :clawserver :clawserver-register-lisplet @@ -255,8 +223,7 @@ :clawserver-input-chunking-p :clawserver-read-timeout :clawserver-write-timeout - :clawserver-login-config - :login + :clawserver-login-config #+(and :unix (not :win32)) :clawserver-setuid #+(and :unix (not :win32)) :clawserver-setgid #-:hunchentoot-no-ssl :clawserver-ssl-certificate-file @@ -266,8 +233,7 @@ :*id-and-static-id-description* :describe-component-behaviour :describe-html-attributes-from-class-slot-initargs - :clawserver-register-configuration - :claw-require-authorization + :clawserver-register-configuration :configuration :configuration-login :principal Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Sun Apr 27 12:15:22 2008 @@ -161,6 +161,9 @@ - TAG is the tag instance - PAGE the page instance")) +(defgeneric tag-attributes (tag) + (:documentation "Returns an alist of tag attributes")) + (defgeneric (setf htcomponent-page) (page htcomponent) (:documentation "Internal method to set the component owner page and to assign an unique id attribute when provided. @@ -170,20 +173,6 @@ (defgeneric (setf slot-initialization) (value wcomponent slot-initarg) (:documentation "Sets a slot by its :INITARG. It's used just after instance creation")) -(defgeneric wcomponent-parameter-value (wcomponent key) - (:documentation "Returns the value of a parameter passed to the wcomponent initialization -function (the one generated with DEFCOMPONENT) or :UNDEFINED if not passed. - - WCOMPONENT is the wcomponent instance - - KEY the parameter key to query")) - -(defgeneric wcomponent-check-parameters(wcomponent) - (:documentation "This internal method check if all :REQUIRED parameters are provided - - WCOMPONENT is the wcomponent instance")) - -(defgeneric wcomponent-parameters(wcomponent) - (:documentation "This method returns class formal parameters as an alist (formal parameters are the ones expected by the component) - - WCOMPONENT is the wcomponent instance")) - (defgeneric wcomponent-informal-parameters(wcomponent) (:documentation "This method returns class informal parameters as an alist (informal parameters are the ones not expected by the component, usually rendered as tag attributes withot any kind of evaluation) @@ -528,7 +517,6 @@ (member tag-name *empty-tags* :test #'string-equal)) ;;;--------------------METHODS implementation---------------------------------------------- - (defmethod (setf htcomponent-page) ((page page) (htcomponent htcomponent)) (let ((id (getf (htcomponent-attributes htcomponent) :id)) (static-id (getf (htcomponent-attributes htcomponent) :static-id)) @@ -779,6 +767,9 @@ (htcomponent-json-print-end-component htcomponent)))) ;;;========= TAG ===================================== +(defmethod tag-attributes ((tag tag)) + (htcomponent-attributes tag)) + (defmethod tag-render-attributes ((tag tag) (page page)) (when (htcomponent-attributes tag) (loop for (k v) on (htcomponent-attributes tag) by #'cddr @@ -992,11 +983,7 @@ ;;;========= WCOMPONENT =================================== (defclass wcomponent (htcomponent) - ((parameters :initarg :parameters - :accessor wcomponent-parameters - :type cons - :documentation "must be a plist or nil") - (reserved-parameters :initarg :reserved-parameters + ((reserved-parameters :initarg :reserved-parameters :accessor wcomponent-reserved-parameters :type cons :documentation "Parameters that may not be used in the constructor function") @@ -1036,8 +1023,6 @@ finally (return result)))) (setf (slot-value instance 'informal-parameters) informal-parameters))) -(defmethod wcomponent-check-parameters((comp wcomponent))) - (defmethod (setf slot-initialization) (value (wcomponent wcomponent) slot-initarg) (let* ((initarg (if (or (eq slot-initarg :static-id) (eq slot-initarg :id)) :client-id slot-initarg)) (new-value (if (eq slot-initarg :id) (generate-id value) value)) @@ -1065,7 +1050,6 @@ (remf parameters :id)) (loop for (initarg value) on parameters by #'cddr do (setf (slot-initialization instance initarg) value)) - (wcomponent-check-parameters instance) (setf (htcomponent-body instance) content) instance)) @@ -1076,13 +1060,6 @@ (let ((fbody (parse-htcomponent-function (flatten rest)))) (make-component component-name (first fbody) (second fbody)))) - -(defmethod wcomponent-parameter-value ((c wcomponent) key) - (let ((result (getf (htcomponent-attributes c) key :undefined))) - (if (eq result :undefined) - (getf (wcomponent-parameters c) key) - result))) - (defmethod htcomponent-rewind ((wcomponent wcomponent) (page page)) (let ((template (wcomponent-template wcomponent))) (wcomponent-before-rewind wcomponent page) Modified: trunk/main/claw-core/src/translators.lisp ============================================================================== --- trunk/main/claw-core/src/translators.lisp (original) +++ trunk/main/claw-core/src/translators.lisp Sun Apr 27 12:15:22 2008 @@ -280,7 +280,7 @@ (and (> day 0) (<= day (days-in-month month year)))) :component wcomponent :message (format nil (do-message "VALIDATOR-DATE" "Field ~a is not a valid date or wrong format: ~a") - (wcomponent-parameter-value wcomponent :label) + (label wcomponent) old-value)) (if (component-validation-errors wcomponent) old-value Modified: trunk/main/claw-core/src/validators.lisp ============================================================================== --- trunk/main/claw-core/src/validators.lisp (original) +++ trunk/main/claw-core/src/validators.lisp Sun Apr 27 12:15:22 2008 @@ -73,7 +73,7 @@ (when (stringp value) (validate (and value (string-not-equal value "")) :component component - :message (format nil (do-message "VALIDATOR-REQUIRED" "Field ~a may not be null.") (wcomponent-parameter-value component :label))))) + :message (format nil (do-message "VALIDATOR-REQUIRED" "Field ~a may not be null.") (label component))))) (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. @@ -90,13 +90,13 @@ (validate (>= value-len min-size) :component component :message (format nil (do-message "VALIDATOR-SIZE-MIN" "Size of ~a may not be less then ~a chars." ) - (wcomponent-parameter-value component :label) + (label component) min-size))) (when max-size (validate (<= value-len max-size) :component component :message (format nil (do-message "VALIDATOR-SIZE-MAX" "Size of ~a may not be more then ~a chars." ) - (wcomponent-parameter-value component :label) + (label component) max-size))))))) (defun validator-range (component value &key min max) @@ -110,7 +110,7 @@ (validate (>= value min) :component component :message (format nil (do-message "VALIDATOR-RANGE-MIN" "Field ~a is not greater then or equal to ~d") - (wcomponent-parameter-value component :label) + (label component) (if (typep min 'ratio) (coerce min 'float) min)))) @@ -118,7 +118,7 @@ (validate (<= value max) :component component :message (format nil (do-message "VALIDATOR-RANGE-MAX" "Field ~a is not less then or equal to ~d") - (wcomponent-parameter-value component :label) + (label component) (if (typep max 'ratio) (coerce max 'float) max))))))) @@ -131,7 +131,7 @@ (let ((test (numberp value))) (and (validate test :component component - :message (format nil (do-message "VALIDATOR-NUMBER" "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.") (label component))) (validator-range component value :min min :max max))))) (defun validator-integer (component value &key min max) @@ -142,7 +142,7 @@ (let ((test (integerp value))) (and (validate test :component component - :message (format nil (do-message "VALIDATOR-INTEGER" "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.") (label component))) (validator-range component value :min min :max max))))) @@ -156,7 +156,7 @@ If value is greater then the date passed to :MAX, a localizable message \"Field ~a is greater then ~a.\" is sent with key \"VALIDATOR-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." (unless (component-validation-errors component) - (let ((local-time-format '(:date "-" :month "-" :year));(translator-local-time-format (wcomponent-parameter-value component :translator))) + (let ((local-time-format '(:date "-" :month "-" :year)) (new-value (make-instance 'local-time :nsec (nsec-of value) :sec (sec-of value) @@ -181,13 +181,13 @@ (validate (local-time> new-value min) :component component :message (format nil (do-message "VALIDATOR-DATE-RANGE-MIN" "Field ~a is less then ~a.") - (wcomponent-parameter-value component :label) + (label component) (local-time-to-string min local-time-format)))) (when max (validate (local-time< new-value max) :component component :message (format nil (do-message "VALIDATOR-DATE-RANGE-MAX" "Field ~a is greater then ~a.") - (wcomponent-parameter-value component :label) + (label component) (local-time-to-string max local-time-format)))))))) @@ -207,10 +207,6 @@ (describe-html-attributes-from-class-slot-initargs class) (describe-component-behaviour class)))) -(defmethod wcomponent-parameters ((exception-monitor exception-monitor)) - (declare (ignore exception-monitor)) - (list :class nil)) - (defmethod wcomponent-template ((exception-monitor exception-monitor)) (let ((client-id (htcomponent-client-id exception-monitor)) (validation-errors (aux-request-value :validation-errors))) Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Sun Apr 27 12:15:22 2008 @@ -73,12 +73,8 @@ (defun test-configuration-do-login (request user password) (let ((session *session*)) (when (and (string-equal user "kiuma") - (string-equal password "password")) - (progn - ;;(unless session - ;; (setf session (lisplet-start-session))) - ;;(setf (session-value 'principal session) (make-instance 'principal :name user :roles '("user"))))))) - (setf (current-principal session) (make-instance 'principal :name user :roles '("user"))))))) + (string-equal password "password")) + (setf (current-principal session) (make-instance 'principal :name user :roles '("user")))))) @@ -216,7 +212,7 @@ (defmethod page-content ((o realm-page)) (when (null *session*) - (lisplet-start-session)) + (start-session)) (unless (session-value 'RND-NUMBER) (setf (session-value 'RND-NUMBER) (random 1000))) (site-template> :title "Realm test page"

1 0

[claw-cvs] r42 - in trunk/main/claw-core: . src tests
by achiumenti＠common-lisp.net 26 Apr '08

26 Apr '08

Author: achiumenti Date: Sat Apr 26 11:05:43 2008 New Revision: 42 Modified: trunk/main/claw-core/claw.asd trunk/main/claw-core/src/components.lisp trunk/main/claw-core/src/i18n.lisp trunk/main/claw-core/src/misc.lisp trunk/main/claw-core/src/packages.lisp trunk/main/claw-core/src/server.lisp trunk/main/claw-core/src/tags.lisp trunk/main/claw-core/src/translators.lisp trunk/main/claw-core/src/validators.lisp trunk/main/claw-core/tests/some-page.lisp trunk/main/claw-core/tests/test1.lisp Log: changed component initfunctions generation with MOP system instead of using macro. Finished API documentation Modified: trunk/main/claw-core/claw.asd ============================================================================== --- trunk/main/claw-core/claw.asd (original) +++ trunk/main/claw-core/claw.asd Sat Apr 26 11:05:43 2008 @@ -31,16 +31,16 @@ :name "claw" :author "Andrea Chiumenti" :description "Common Lisp Active Web.A famework to write web applications" - :depends-on (:hunchentoot :alexandria :cl-ppcre :cl-fad :local-time) + :depends-on (:closer-mop :hunchentoot :alexandria :cl-ppcre :cl-fad :local-time) :components ((:module src :components ((:file "packages") (:file "misc" :depends-on ("packages")) (:file "i18n" :depends-on ("packages")) (:file "locales" :depends-on ("i18n")) (:file "hunchentoot-overrides" :depends-on ("packages")) - (:file "tags" :depends-on ("misc")) - (:file "validators" :depends-on ("tags")) + (:file "tags" :depends-on ("misc")) + (:file "components" :depends-on ("tags")) + (:file "validators" :depends-on ("components")) (:file "translators" :depends-on ("validators")) - (:file "components" :depends-on ("tags" "validators")) (:file "lisplet" :depends-on ("components")) (:file "server" :depends-on ("lisplet")))))) Modified: trunk/main/claw-core/src/components.lisp ============================================================================== --- trunk/main/claw-core/src/components.lisp (original) +++ trunk/main/claw-core/src/components.lisp Sat Apr 26 11:05:43 2008 @@ -34,26 +34,66 @@ - OBJ the wcomponent instance - PAGE-OBJ the wcomponent owner page")) +(defgeneric component-id-and-value (cinput &key from-request-p) + (:documentation "Returns the form component \(such as <input> and <select>) client-id and the associated value. +When FROM-REQUEST-P is not null, the value is retrived from the http request by its name, from the associated reader or accessor when nil")) + +(defgeneric translator-encode (translator wcomponent) + (:documentation "Encodes the input component value, used when rendering the component (Encodes from type to string).")) + +(defgeneric translator-decode (translator wcomponent) + (:documentation "Decodes the input component value after a form submit (Decodes from string to type).")) + +(defclass translator () + () + (:documentation "a translator object encodes and decodes values passed to a html input component")) + +(defvar *simple-translator* nil + "*SIMPLE-TRANSLATOR* is the default translator for any CINPUT component. +Its encoder and decoder methods pass values unchanged") + +(defun component-validation-errors (component &optional (request *request*)) + "Resurns possible validation errors occurred during form rewinding bound to a specific component" + (let ((client-id (htcomponent-client-id component))) + (assoc client-id (validation-errors request) :test #'equal))) ;-------------------------------------------------------------------------------- -(defcomponent cform () () - (:documentation "This component render as a FORM tag class, but it is aware of +(defclass cform (wcomponent) + ((action :initarg :action + :accessor action + :documentation "Function performed after user submission") + (css-class :initarg :class + :reader css-class + :documentation "The html CLASS attribute")) + (:default-initargs :action nil :class nil) + (:metaclass metacomponent) + (:documentation "This component render as a FORM tag class, but it is aware of the request cycle and is able to fire an action on rewind")) +(let ((class (find-class 'cform))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~a~%~%~a" + "Function that instantiates a CFORM component and renders a html <form> tag." + *id-and-static-id-description* + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) + + (defmethod cform-rewinding-p ((cform cform) (page page)) (string= (htcomponent-client-id cform) (page-req-parameter page *rewind-parameter*))) -(defmethod wcomponent-parameters ((cform cform)) - (list :id :required - :class nil - :action nil)) - (defmethod wcomponent-template((cform cform)) (let ((client-id (htcomponent-client-id cform)) - (class (wcomponent-parameter-value cform :class))) + (class (css-class cform)) + (validation-errors (aux-request-value :validation-errors))) + (when validation-errors + (if (or (null class) (string= class "")) + (setf class "error") + (setf class (format nil "~a error" class)))) (form> :static-id client-id - :name client-id + :name client-id :class class (wcomponent-informal-parameters cform) (input> :name *rewind-parameter* @@ -66,20 +106,29 @@ (defmethod wcomponent-after-rewind ((obj cform) (pobj page)) (let ((validation-errors (aux-request-value :validation-errors)) - (action (wcomponent-parameter-value obj :action))) + (action (action obj))) (unless validation-errors (when (or action (cform-rewinding-p obj pobj)) - (funcall (fdefinition action) pobj)) + (funcall action pobj)) (setf (page-current-form pobj) nil)))) ;-------------------------------------------------------------------------------- -(defcomponent action-link (cform) () - (:documentation "This component behaves like a CFORM, firing it's associated action once clicked. +(defclass action-link (cform) () + (:metaclass metacomponent) + (:default-initargs :reserved-parameters (list :href)) + (:documentation "This component behaves like a CFORM, firing it's associated action once clicked. It renders as a normal link.")) -(defmethod wcomponent-reserved-parameters ((o action-link)) - '(:href)) +(let ((class (find-class 'action-link))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~a~a~%~%~a" + "Instantiates an ACTION-LINK that renders an <a> link that cals a page method." + *id-and-static-id-description* + (describe-html-attributes-from-class-slot-initargs (find-class 'cform)) + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) (defmethod wcomponent-template((o action-link)) (let ((client-id (htcomponent-client-id o))) @@ -91,35 +140,62 @@ (htcomponent-body o)))) ;--------------------------------------------------------------------------------------- - -(defcomponent cinput () - ((result-as-list :initarg :result-as-list - :accessor cinput-result-as-list)) - (:default-initargs :result-as-list nil) +(defclass base-cinput (wcomponent) + ((result-as-list-p :initarg :multiple + :accessor cinput-result-as-list-p + :documentation "When not nil the associated request parameter will ba a list") + (writer :initarg :writer + :reader cinput-writer + :documentation "Visit object slot writer symbol, used to write the input value to the visit object") + (reader :initarg :reader + :reader cinput-reader + :documentation "Visit object slot reader symbol, used to get the corresponding value from the visit object") + (accessor :initarg :accessor + :reader cinput-accessor + :documentation "Visit object slot accessor symbol. It can be used in place of the :READER and :WRITER parameters") + (label :initarg :label + :reader label + :documentation "The label is the description of the component. It's also be used when component validation fails.") + (translator :initarg :translator + :reader translator + :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.") + (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.") + (css-class :initarg :class + :reader css-class + :documentation "the html component class attribute")) + (:default-initargs :multiple nil :writer nil :reader nil :accessor nil :class nil + :label nil :translator *simple-translator* :validator nil :visit-object nil) + (:documentation "Class inherited from both CINPUT and CSELECT")) + +(defclass cinput (base-cinput) + ((input-type :initarg :type + :reader input-type + :documentation "The html <input> TYPE attribute. For submit type, use the CSUBMIT> function.")) + (:metaclass metacomponent) + (:default-initargs :reserved-parameters (list :value :name) :empty t) (:documentation "Request cycle aware component the renders as an INPUT tag class")) -(defmethod wcomponent-parameters ((cinput cinput)) - (list :id :required - :reader nil - :writer nil - :visit-object nil - :accessor nil - :validator-handler nil - :class nil - :label nil - :translator *simple-translator* - :validator nil - :type :required)) +(let ((class (find-class 'cinput))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~a~a~%~%~a" + "Function that instantiates a CINPUT component and renders a html <input> tag." + *id-and-static-id-description* + (describe-html-attributes-from-class-slot-initargs (find-class 'base-cinput)) + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) -(defmethod wcomponent-reserved-parameters ((cinput cinput)) - '(:value :name)) - -(defmethod wcomponent-template ((cinput cinput)) +(defmethod wcomponent-template ((cinput cinput)) (let ((client-id (htcomponent-client-id cinput)) - (type (wcomponent-parameter-value cinput :type)) - (class (wcomponent-parameter-value cinput :class)) - (translator (wcomponent-parameter-value cinput :translator)) - (value "")) + (type (input-type cinput)) + (translator (translator cinput)) + (value "") + (class (css-class cinput))) (when (component-validation-errors cinput) (if (or (null class) (string= class "")) (setf class "error") @@ -132,19 +208,20 @@ :value value (wcomponent-informal-parameters cinput)))) -(defmethod wcomponent-after-rewind ((cinput cinput) (page page)) - (let ((visit-object (wcomponent-parameter-value cinput :visit-object)) - (accessor (wcomponent-parameter-value cinput :accessor)) - (writer (wcomponent-parameter-value cinput :writer)) - (validator (wcomponent-parameter-value cinput :validator)) - (translator (wcomponent-parameter-value cinput :translator)) - (value)) +(defmethod wcomponent-after-rewind ((cinput base-cinput) (page page)) + (let ((visit-object (cinput-visit-object cinput)) + (accessor (cinput-accessor cinput)) + (writer (cinput-writer cinput)) + (validator (validator cinput)) + (translator (translator cinput)) + (value "")) (multiple-value-bind (client-id request-value) (component-id-and-value cinput) + (declare (ignore client-id)) (setf value (handler-case (translator-decode translator cinput) - (error () request-value))) + (error () request-value))) (unless (null value) (when validator (funcall validator value)) @@ -155,20 +232,46 @@ (funcall (fdefinition `(setf ,accessor)) value visit-object) (funcall (fdefinition writer) value visit-object))))))) +(defmethod component-id-and-value ((cinput base-cinput) &key (from-request-p t)) + (let ((client-id (htcomponent-client-id cinput)) + (page (htcomponent-page cinput)) + (visit-object (cinput-visit-object cinput)) + (accessor (cinput-accessor cinput)) + (reader (cinput-reader cinput)) + (result-as-list-p (cinput-result-as-list-p cinput)) + (value "")) + (when (null visit-object) + (setf visit-object (htcomponent-page cinput))) + (cond + (from-request-p (setf value (page-req-parameter page client-id result-as-list-p))) + ((and (null reader) accessor) (setf value (funcall (fdefinition accessor) visit-object))) + (t (setf value (funcall (fdefinition reader) visit-object)))) + (values client-id value))) + + ;--------------------------------------------------------------------------------------- -(defcomponent csubmit () () - (:documentation "This component render as an INPUT tag class ot type submit, but +(defclass csubmit (cform) + ((value :initarg :value + :reader csubmit-value + :documentation "The html VALUE attribute")) + (:metaclass metacomponent) + (:default-initargs :reserved-parameters (list :type :name) :empty t :action nil) + (:documentation "This component render as an INPUT tag class ot type submit, but can override the default CFORM action, using its own associated action")) -(defmethod wcomponent-parameters ((o csubmit)) - (list :id :required :value :required :action nil)) - -(defmethod wcomponent-reserved-parameters ((o csubmit)) - '(:type :name)) +(let ((class (find-class 'csubmit))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~a~a~%~%~a" + "Function that instantiates a CSUBMIT component and renders a html <input> tag of submit type." + *id-and-static-id-description* + (describe-html-attributes-from-class-slot-initargs (find-class 'cform)) + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) (defmethod wcomponent-template ((obj csubmit)) (let ((client-id (htcomponent-client-id obj)) - (value (wcomponent-parameter-value obj :value))) + (value (csubmit-value obj))) (input> :static-id client-id :type "submit" :name client-id @@ -176,18 +279,28 @@ (wcomponent-informal-parameters obj)))) (defmethod wcomponent-after-rewind ((obj csubmit) (pobj page)) - (let ((action (wcomponent-parameter-value obj :action)) + (let ((action (action obj)) (current-form (page-current-form pobj)) (submitted-p (page-req-parameter pobj (htcomponent-client-id obj)))) (unless (or (null current-form) (null submitted-p) (null action)) - (setf (getf (wcomponent-parameters current-form) :action) action)))) + (setf (action current-form) action)))) ;----------------------------------------------------------------------------- -(defcomponent submit-link (csubmit) () - (:documentation "This component renders as a normal link, but behaves like a CSUBMIT, +(defclass submit-link (csubmit) + () + (:metaclass metacomponent) + (:default-initargs :reserved-parameters (list :href) :empty nil) + (:documentation "This component renders as a normal link, but behaves like a CSUBMIT, so it can be used instead of CSUBMIT when needed")) -(defmethod wcomponent-reserved-parameters ((o submit-link)) - '(:href)) +(let ((class (find-class 'submit-link))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~a~a~%~%~a" + "Function that instantiates a SUBMIT-LINK component and renders a html <a> tag that can submit the form where it is contained." + *id-and-static-id-description* + (describe-html-attributes-from-class-slot-initargs (find-class 'cform)) + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) (defmethod wcomponent-template ((obj submit-link)) (let* ((id (htcomponent-client-id obj)) @@ -204,27 +317,33 @@ (htcomponent-body obj))))) ;-------------------------------------------------------------------------- - -(defcomponent cselect (cinput) () - (:default-initargs :result-as-list t) - (:documentation "This component renders as a normal SELECT tag class, +(defclass cselect (base-cinput) () + (:default-initargs :reserved-parameters (list :type :name) :empty nil) + (:metaclass metacomponent) + (:documentation "This component renders as a normal SELECT tag class, but it is request cycle aware.")) -(defmethod wcomponent-parameters :around ((obj cselect)) - (declare (ignore obj)) - (let ((params (call-next-method))) - (remf params :reader) - (remf params :type) - params)) - -(defmethod wcomponent-reserved-parameters ((obj cselect)) - (declare (ignore obj)) - '(:type :name)) +(let ((class (find-class 'cselect))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~a~a~%~%~a" + "Function that instantiates a CSELECT component and renders a html <select> tag." + *id-and-static-id-description* + (describe-html-attributes-from-class-slot-initargs (find-class 'base-cinput)) + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) (defmethod wcomponent-template ((obj cselect)) - (let ((client-id (htcomponent-client-id obj))) + (let ((client-id (htcomponent-client-id obj)) + (class (css-class obj))) + (when (component-validation-errors obj) + (if (or (null class) (string= class "")) + (setf class "error") + (setf class (format nil "~a error" class)))) (select> :static-id client-id :name client-id + :class class + :multiple (cinput-result-as-list-p obj) (wcomponent-informal-parameters obj) (htcomponent-body obj)))) Modified: trunk/main/claw-core/src/i18n.lisp ============================================================================== --- trunk/main/claw-core/src/i18n.lisp (original) +++ trunk/main/claw-core/src/i18n.lisp Sat Apr 26 11:05:43 2008 @@ -43,42 +43,55 @@ And other FIELD value will produce an error condition.")) -(defvar *locales* (make-hash-table :test 'equal)) +(defvar *locales* (make-hash-table :test 'equal) + "A hash table of locale key strings and lists of locale directives. +You should use locale access functions to get its internal values.") (defun number-format-grouping-separator (&optional (locale (user-locale))) + "Returns the character used as thousands grouping separator for numbers" (getf (getf (gethash locale *locales*) :number-format) :grouping-separator)) (defun number-format-decimal-separator (&optional (locale (user-locale))) + "Returns the character used as decimals separator for numbers" (getf (getf (gethash locale *locales*) :number-format) :decimal-separator)) (defun ampm (&optional (locale (user-locale))) + "Returns a list with the localized version of AM and PM for time" (getf (gethash locale *locales*) :ampm)) (defun months (&optional (locale (user-locale))) + "Returns a localized list of monthes in long form" (getf (gethash locale *locales*) :months)) (defun short-months (&optional (locale (user-locale))) + "Returns a localized list of monthes in short form" (getf (gethash locale *locales*) :short-months)) (defun first-day-of-the-week (&optional (locale (user-locale))) - (getf (gethash locale *locales*) :first-day-of-the-week)) + "Returns the first day position of the week for the given locale, being sunday on position 0 and saturday on position 6" + (1- (getf (gethash locale *locales*) :first-day-of-the-week))) (defun weekdays (&optional (locale (user-locale))) + "Returns a localized list of days of the week in long form" (getf (gethash locale *locales*) :weekdays)) (defun short-weekdays (&optional (locale (user-locale))) + "Returns a localized list of days of the week in short form" (getf (gethash locale *locales*) :short-weekdays)) (defun eras (&optional (locale (user-locale))) + "Returns a list with the localized version of BC and AD eras" (getf (gethash locale *locales*) :eras)) (defun local-time-add-year (local-time value) + "Add or remove years, expressed by the value parameter, to a local-time instance" (multiple-value-bind (ns ss mm hh day month year) (decode-local-time local-time) (encode-local-time ns ss mm hh day month (+ year value)))) (defun local-time-add-month (local-time value) + "Add or remove monthes, expressed by the value parameter, to a local-time instance. Correction on other local-time fields is performed if needed" (multiple-value-bind (d-month d-year) (floor (abs value) 12) (when (< value 0) @@ -91,6 +104,7 @@ (encode-local-time ns ss mm hh day month year)))))) (defun local-time-add-day (local-time value) + "Add or remove days, expressed by the value parameter, to a local-time instance. Correction on other local-time fields is performed if needed" (let* ((curr-day (day-of local-time)) (local-time-result (make-instance 'local-time :day curr-day @@ -101,6 +115,7 @@ local-time-result)) (defun local-time-add-hour (local-time value) + "Add or remove hours, expressed by the value parameter, to a local-time instance. Correction on other local-time fields is performed if needed" (multiple-value-bind (ns ss mm hh day month year) (decode-local-time local-time) (multiple-value-bind (d-hour d-day) @@ -114,6 +129,7 @@ (encode-local-time ns2 ss2 mm2 (+ hh d-hour) day2 month2 year2)))))) (defun local-time-add-min (local-time value) + "Add or remove minutes, expressed by the value parameter, to a local-time instance. Correction on other local-time fields is performed if needed" (multiple-value-bind (ns ss mm hh day month year) (decode-local-time local-time) (multiple-value-bind (d-min d-hour) @@ -127,6 +143,7 @@ (encode-local-time ns2 ss2 (+ mm d-min) hh2 day2 month2 year2)))))) (defun local-time-add-sec (local-time value) + "Add or remove seconds, expressed by the value parameter, to a local-time instance. Correction on other local-time fields is performed if needed" (multiple-value-bind (ns ss mm hh day month year) (decode-local-time local-time) (multiple-value-bind (d-sec d-min) @@ -140,6 +157,7 @@ (encode-local-time ns2 (+ ss d-sec) mm2 hh2 day2 month2 year2)))))) (defun local-time-add-nsec (local-time value) + "Add or remove nanoseconds, expressed by the value parameter, to a local-time instance. Correction on other local-time fields is performed if needed" (multiple-value-bind (ns ss mm hh day month year) (decode-local-time local-time) (multiple-value-bind (d-nsec d-sec) Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Sat Apr 26 11:05:43 2008 @@ -29,7 +29,8 @@ (in-package :claw) -(defvar *clawserver-base-path* nil) +(defvar *clawserver-base-path* nil + "This global variable is used to keep all lisplets \(claw web applications) under a common URL") (defvar *apache-http-port* 80 "Default apache http port when claw is running in mod_lisp mode") @@ -74,7 +75,7 @@ (setf result (push location-cons result)))) (defun lisplet-start-session () - "Starts a session boud to the current lisplet base path" + "Starts a session bound to the current lisplet base path" (start-session (format nil "~@[~a~]~a/" *clawserver-base-path* (lisplet-base-path (current-lisplet))))) @@ -132,7 +133,7 @@ (gethash (current-realm request) (clawserver-login-config (current-server request)))) (defun login (&optional (request *request*)) - "Perfoms a login action using the configuration object given for the request realm" + "Perfoms a login action using the configuration object given for the request realm (see CURRENT-REALM)" (configuration-login (current-config request))) (defun flatten (tree &optional result-list) @@ -152,6 +153,10 @@ (all-matches "MSIE" (string-upcase (cdr user-agent)))))) (defmacro with-message (key &optional (default "") locale) +"Returns a lambda function that can localize a message by its key. +The first message dispatching is made by the lisplet, then, if the message is not already vlorized the +computation is left to the current rendering page, then to the current rendering web component. +If the message is null after these passages the default value is used." (let ((current-lisplet (gensym)) (current-page (gensym)) (current-component (gensym)) @@ -186,9 +191,11 @@ ,default-val))))) (defun do-message (key &optional (default "") locale) + "This function call the lambda function returned by the WITH-MESSAGE macro." (funcall (with-message key default locale))) (defun user-locale (&optional (request *request*) (session *session*)) + "This function returns the user locale. If no locale was directly set, the browser default locale is used." (let ((locale (when session (session-value 'locale session)))) (unless locale @@ -201,8 +208,68 @@ locale)) (defun (setf user-locale) (locale &optional (session *session*)) + "This function forces the locale for the current user, binding it to the user session, +that is created if no session exists." (unless session (setf session (lisplet-start-session))) (setf (session-value 'locale session) locale)) - - + +(defun validation-errors (&optional (request *request*)) + "Resurns possible validation errors occurred during form rewinding" + (aux-request-value :validation-errors request)) + +(defclass metacomponent (standard-class) + () + (:documentation "This is the meta class the must be set for every WCOMPONENT. +It creates a function whose name is the WCOMPONENT class name plus the character '>'. +The function may then be called as any other claw tag function.")) + +(defmethod closer-mop:validate-superclass ((class metacomponent)(super standard-class)) + t) + + +(defun find-first-classdefault-initarg-value (initargs initarg) + "Returns the first class default init arg value matching matching the given INITARG" + (loop for current-initarg in initargs + do (when (eq (first current-initarg) initarg) + (return (second current-initarg))))) + +(defmethod initialize-instance :after ((class metacomponent) &key) + (let* ((name (class-name class)) + (builder-function (format nil "~a>" name)) + (symbolf (find-symbol builder-function))) + (unless symbolf + (setf symbolf (intern builder-function))) + (setf (fdefinition symbolf) #'(lambda(&rest rest) (build-component name rest))))) + +(defun describe-html-attributes-from-class-slot-initargs (class) + "Helper function that generates documentation for wcomponent init functions" + (let* ((class-slots (closer-mop:class-direct-slots class))) + (format nil "~{~%~a~}" + (remove-if #'null + (reverse (loop for slot in class-slots + collect (let ((slot-initarg (first (closer-mop:slot-definition-initargs slot)))) + (when slot-initarg + (format nil + "- :~a ~a" + slot-initarg + (documentation slot 't)))))))))) + +(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 +") + +(defun describe-component-behaviour (class) + "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" + (if (find-first-classdefault-initarg-value initargs :allow-informal-parameters) + "Yes" + "No") + (if (find-first-classdefault-initarg-value initargs :empty) + "No" + "Yes") + (if reserved-parameters + (format nil "~{:~a ~}" (eval reserved-parameters)) + "NONE")))) \ No newline at end of file Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Sat Apr 26 11:05:43 2008 @@ -33,8 +33,9 @@ (export 'HUNCHENTOOT::SESSION-REALM 'HUNCHENTOOT) (defpackage :claw - (:use :cl :hunchentoot :alexandria :cl-ppcre :cl-fad :local-time) + (:use :cl :closer-mop :hunchentoot :alexandria :cl-ppcre :cl-fad :local-time) (:shadow :flatten) + (:documentation "A comprehensive web application framework and server for the Common Lisp programming language") (:export :*html-4.01-strict* :*html-4.01-transitional* :*html-4.01-frameset* @@ -47,12 +48,7 @@ :*apache-http-port* :*apache-https-port* :*empty-tags* - ;:request-realm - :request-id-table-map - ;:dyna-id - :flatten :tag-emptyp - :tag-symbol-class :strings-to-jsarray :empty-string-p :build-tagf @@ -199,6 +195,7 @@ :page-content :page-render :generate-id + :metacomponent :wcomponent :wcomponent-parameters :wcomponent-informal-parameters @@ -212,12 +209,16 @@ :wcomponent-before-render :wcomponent-after-render :make-component - :defcomponent :cform :cform> :action-link :action-link> + :base-cinput :cinput + :cinput-reader + :cinput-writer + :cinput-accessor + :cinput-visit-object :cinput> :cselect :cselect> @@ -262,6 +263,9 @@ #-:hunchentoot-no-ssl :clawserver-ssl-privatekey-file #-:hunchentoot-no-ssl :clawserver-ssl-privatekey-password :msie-p + :*id-and-static-id-description* + :describe-component-behaviour + :describe-html-attributes-from-class-slot-initargs :clawserver-register-configuration :claw-require-authorization :configuration @@ -305,4 +309,4 @@ :validator-integer :validator-date-range :exception-monitor - :exception-monitor>)) + :exception-monitor>)) \ No newline at end of file Modified: trunk/main/claw-core/src/server.lisp ============================================================================== --- trunk/main/claw-core/src/server.lisp (original) +++ trunk/main/claw-core/src/server.lisp Sat Apr 26 11:05:43 2008 @@ -117,13 +117,17 @@ (:documentation "This is the page class used to render the http error messages.")) -(defcomponent error-page-template () - () - (:documentation "The template for the error-page")) - -(defmethod wcomponent-parameters ((error-page-template error-page-template)) - (list :title :required :error-code :required :style - " +(defclass error-page-template (wcomponent) + ((title :initarg :title + :reader title + :documentation "The page title") + (error-code :initarg :error-code + :reader error-code + :documentation "The http error code. For details consult http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html") + (style :initarg :style + :reader style + :documentation "The CSS <style> element, used to beautify the error page.")) + (:default-initargs :style " body { font-family: arial, elvetica; font-size: 7pt; @@ -142,12 +146,22 @@ margin: 0; margin-bottom: .5em; } -p.h2 {font-size: 1.5em;}")) +p.h2 {font-size: 1.5em;}" :empty t :allow-informal-parameters nil) + (:metaclass metacomponent) + (:documentation "The template for the error-page")) + +(let ((class (find-class 'error-page-template))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~%~%~a" + "Function that instantiates an ERROR-PAGE-TEMPLATE component and renders a html tenplate for CLAW generic error pages." + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) (defmethod wcomponent-template ((error-page-template error-page-template)) - (let ((error-code (wcomponent-parameter-value error-page-template ':error-code)) - (title (wcomponent-parameter-value error-page-template ':title)) - (style (wcomponent-parameter-value error-page-template ':style))) + (let ((error-code (error-code error-page-template)) + (title (title error-page-template)) + (style (style error-page-template))) (html> (head> (title> title) @@ -169,7 +183,6 @@ (span> :class "blue" "description") (gethash error-code hunchentoot::*http-reason-phrase-map*) - ;(htcomponent-body error-page-template) (hr> :noshade "noshade")) (p> :class "h2" "claw server")))))) @@ -467,36 +480,4 @@ (realm (current-realm request));(aux-request-value 'realm)) (login-config (gethash realm (clawserver-login-config server)))) (configuration-login login-config request))) - - -(defun start-clawserver (clawserver - &key (port 80) - address - (name (gensym)) - (mod-lisp-p nil) - (use-apache-log-p mod-lisp-p) - (input-chunking-p t) - (read-timeout *default-read-timeout*) - (write-timeout *default-write-timeout*) - #+(and :unix (not :win32)) setuid - #+(and :unix (not :win32)) setgid - #-:hunchentoot-no-ssl ssl-certificate-file - #-:hunchentoot-no-ssl (ssl-privatekey-file ssl-certificate-file) - #-:hunchentoot-no-ssl ssl-privatekey-password) - (start-server :port port - :address address - :dispatch-table (list #'(lambda (request) - (declare (ignorable request)) - (clawserver-dispatch-method clawserver))) - :name name - :mod-lisp-p mod-lisp-p - :use-apache-log-p use-apache-log-p - :input-chunking-p input-chunking-p - :read-timeout read-timeout - :write-timeout write-timeout - #+(and :unix (not :win32)) :setuid setuid - #+(and :unix (not :win32)) :setgid setgid - #-:hunchentoot-no-ssl :ssl-certificate-file ssl-certificate-file - #-:hunchentoot-no-ssl :ssl-privatekey-file ssl-privatekey-file - #-:hunchentoot-no-ssl :ssl-privatekey-password ssl-privatekey-password)) Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Sat Apr 26 11:05:43 2008 @@ -69,8 +69,8 @@ - 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. - - PAGE is the page instance that must be given")) + (: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.")) (defgeneric page-print-tabulation (page) (:documentation "This internal method is called during the rendering phase if tabulation is enabled. It writes the right amount @@ -167,6 +167,9 @@ - HTCOMPONENT is the tag 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")) + (defgeneric wcomponent-parameter-value (wcomponent key) (:documentation "Returns the value of a parameter passed to the wcomponent initialization function (the one generated with DEFCOMPONENT) or :UNDEFINED if not passed. @@ -214,6 +217,9 @@ - WCOMPONENT is the tag instance - PAGE the page instance")) +(defgeneric wcomponent-template (wcomponent) + (: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")) @@ -321,17 +327,26 @@ "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." - (setf (fdefinition (intern (format nil "~a>" (string-upcase tag-name)))) - #'(lambda (&rest rest) (build-tagf tag-name 'tag emptyp rest)))) + (let ((fsymbol (intern (format nil "~a>" (string-upcase tag-name))))) + (setf (fdefinition fsymbol) + #'(lambda (&rest rest) (build-tagf tag-name 'tag emptyp rest))) + (setf (documentation fsymbol 'function) (format nil "This function generates the ~a<~a> html tag" + (if emptyp + "empty " + "") + tag-name)))) ;;;---------------------------------------------------------------- (defclass message-dispatcher () - ()) + () + (:documentation "This is and interface for message dispatchers")) (defclass simple-message-dispatcher (message-dispatcher) ((locales :initform (make-hash-table :test #'equal) - :accessor simple-message-dispatcher-locales))) + :accessor simple-message-dispatcher-locales + :documentation "Hash table of locales strings and KEY/VALUE message pairs")) + (:documentation "A message disptcher that leave data unchanged during encoding and decoding phases.")) (defclass i18n-aware (message-dispatcher) ((message-dispatcher :initarg :message-dispatcher @@ -346,7 +361,9 @@ (lisplet :initarg :lisplet :reader page-lisplet :documentation "The lisplet that owns this page instance") (can-print :initform nil - :accessor page-can-print) + :accessor page-can-print + :documentation "Controls the printing process when a json request is dispatched. +Only components with a matching id and their contents can be printed") (script-files :initarg :script-files :accessor page-script-files :documentation "Holds component class scripts files injected by components during the request cycle") (stylesheet-files :initarg :stylesheet-files @@ -369,7 +386,8 @@ :accessor page-lasttag :documentation "Last rendered tag. Needed for page output rendering") (json-component-count :initarg :json-component-count :accessor page-json-component-count :documentation "Need to render the json object after an xhr call.") - (request-parameters :initarg :request-parameters) + (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.") (components-stack :initform nil :accessor page-components-stack :documentation "A stack of components enetered into rendering process.") @@ -456,24 +474,28 @@ (:documentation "Creates a component for rendering a <script> tag")) (defun script> (&rest rest) + "This function generates the <script> html tag" (build-tagf "script" 'htscript nil rest)) (defclass htlink (tag) () (:documentation "Creates a component for rendering a <link> tag")) (defun link> (&rest rest) + "This function generates the <link> html tag" (build-tagf "link" 'htlink t rest)) (defclass htbody (tag) () (:documentation "Creates a component for rendering a <body> tag")) (defun body> (&rest rest) + "This function generates the <body> html tag" (build-tagf "body" 'htbody nil rest)) (defclass hthead (tag) () (:documentation "Creates a component for rendering a <head> tag")) (defun head> (&rest rest) + "Renders a <head> tag" (build-tagf "head" 'hthead nil rest)) (mapcar #'(lambda (tag-name) (generate-tagf tag-name t)) @@ -505,14 +527,6 @@ "Returns if a tag defined by the string TAG-NAME is empty" (member tag-name *empty-tags* :test #'string-equal)) -(defun tag-symbol-class (tag-name) - "Returns the symbol class for a given TAG-NAME" - (let ((name (string-downcase tag-name))) - (cond ((string= name "script") 'htscript) - ((string= name "link") 'htlink) - ((string= name "body") 'htbody) - ((string= name "head") 'hthead) - (t 'tag)))) ;;;--------------------METHODS implementation---------------------------------------------- (defmethod (setf htcomponent-page) ((page page) (htcomponent htcomponent)) @@ -587,6 +601,7 @@ (page-format-raw page "~a~%" content-type))))) (defun json-validation-errors () + "Composes the error part for the json reply" (let ((validation-errors (aux-request-value :validation-errors))) (if validation-errors (strings-to-jsarray @@ -613,7 +628,6 @@ (page-init page) (when jsonp (page-format-raw page "{components:{")) - ;;(setf (page-can-print page) (null jsonp)) (htcomponent-render (page-content page) page) ;Here we need a fresh new body!!! (when jsonp (page-format-raw page "},classInjections:\"") @@ -680,8 +694,9 @@ (defmethod page-current-component ((page page)) (car (page-components-stack page))) -(defmethod current-component () - (let ((page (current-page))) +(defun current-component (&optional (request *request*)) + "Returns the component that is currently rendering" + (let ((page (current-page request))) (when page (car (page-components-stack page))))) ;;;========= HTCOMPONENT ============================ @@ -939,7 +954,7 @@ (defmethod htcomponent-render ((htbody htbody) (page page)) (let ((body-list (htcomponent-body htbody)) (previous-print-status (page-can-print page))) - (when (or (page-can-print page) previous-print-status) + (when (or (page-can-print page) previous-print-status) (setf (page-can-print page) (htcomponent-can-print htbody)) (htcomponent-json-print-start-component htbody)) (when (page-can-print page) @@ -960,8 +975,8 @@ (defmethod htbody-init-scripts-tag ((page page)) (let ((js (script> :type "text/javascript")) (js-start-directive (if (msie-p) - "window.attachEvent('onload', function(e) {" - "document.addEventListener('DOMContentLoaded', function(e) {")) + "window.attachEvent\('onload', function\(e) {" + "document.addEventListener\('DOMContentLoaded', function\(e) {")) (js-end-directive (if (msie-p) "});" "}, false);")) @@ -992,69 +1007,72 @@ (allow-informal-parameters :initarg :allow-informal-parameters :reader wcomponent-allow-informal-parametersp :allocation :class - :documentation "Determines if the component accepts informal parameters") - (template :initform nil - :accessor wcomponent-template - :type htcomponent - :documentation "The component template. What gives to each wcomponent its unique aspect and features")) + :documentation "Determines if the component accepts informal parameters")) (:default-initargs :informal-parameters nil :reserved-parameters nil :parameters nil :allow-informal-parameters t) (:documentation "Base class for creationg customized web components. Use this or one of its subclasses to make your own.")) -(defmethod wcomponent-check-parameters((comp wcomponent)) - (let ((id nil) - (static-id nil)) - (loop for (k v) on (htcomponent-attributes comp) by #'cddr - do (progn (when (and (eql v ':required) (not (eq k :id))) - (error (format nil - "Parameter ~a of class ~a is required" - k (class-name (class-of comp))))) - (when (eq k :id) - (setf id v)) - (when (eq k :static-id) - (setf static-id v)))) - (when (and (eq id :required) (null static-id)) - (error (format nil - "Parameter id of class ~a is required" - (class-name (class-of comp))))))) +(defmethod wcomponent-informal-parameters ((wcomponent wcomponent))) + +(defun slot-initarg-p (initarg class-precedence-list) + "Returns nil if a slot with that initarg isn't found into the list of classes passed" + (loop for class in class-precedence-list + do (let* ((direct-slots (closer-mop:class-direct-slots class)) + (result (loop for slot in direct-slots + do (when (eq (first (closer-mop:slot-definition-initargs slot)) initarg) + (return initarg))))) + (when result + (return result))))) + +(defmethod initialize-instance :after ((instance wcomponent) &rest rest) + (let* ((class-precedence-list (closer-mop:compute-class-precedence-list (class-of instance))) + (informal-parameters (loop for (k v) on rest by #'cddr + for result = () + do (unless (slot-initarg-p k class-precedence-list) + (push v result) + (push k result)) + finally (return result)))) + (setf (slot-value instance 'informal-parameters) informal-parameters))) + +(defmethod wcomponent-check-parameters((comp wcomponent))) +(defmethod (setf slot-initialization) (value (wcomponent wcomponent) slot-initarg) + (let* ((initarg (if (or (eq slot-initarg :static-id) (eq slot-initarg :id)) :client-id slot-initarg)) + (new-value (if (eq slot-initarg :id) (generate-id value) value)) + (slot-name (loop for slot-definition in (closer-mop:class-slots (class-of wcomponent)) + do (when (eq (car (last (closer-mop:slot-definition-initargs slot-definition))) initarg) + (return (closer-mop:slot-definition-name slot-definition)))))) + (if (find initarg (wcomponent-reserved-parameters wcomponent)) + (error (format nil "Parameter ~a is reserved" initarg)) + (if slot-name + (setf (slot-value wcomponent slot-name) new-value) + (if (null (wcomponent-allow-informal-parametersp wcomponent)) + (error (format nil + "Component ~a doesn't accept informal parameters" + slot-initarg)) + (setf (getf (wcomponent-informal-parameters wcomponent) initarg) new-value)))))) + + (defun make-component (name parameters content) + "This function instantiates a wcomponent by the passed NAME, separetes parameters into formal(the ones that are the +initarg of a slot, and informal parameters, that have their own slot in common. The CONTENT is the body content." (let ((instance (make-instance name)) (static-id (getf parameters :static-id))) (when static-id (remf parameters :id)) - (loop for (k v) on parameters by #'cddr - do (let ((keyword k)) - (when (eq keyword :static-id) - (setf keyword :id)) - (multiple-value-bind (inst-k inst-v inst-p) - (get-properties (wcomponent-parameters instance) (list keyword)) - (declare (ignore inst-v)) - (when (find inst-k (wcomponent-reserved-parameters instance)) - (error (format nil "Parameter ~a is reserved" inst-k))) - (if (null inst-p) - (if (null (wcomponent-allow-informal-parametersp instance)) - (error (format nil - "Component ~a doesn't accept informal parameters" - name)) - (setf (getf (wcomponent-informal-parameters instance) keyword) v)) - (progn - (when (and (eq keyword :id) (not (null static-id))) - (setf keyword :static-id)) - (setf (getf (htcomponent-attributes instance) keyword) v)))))) + (loop for (initarg value) on parameters by #'cddr + do (setf (slot-initialization instance initarg) value)) (wcomponent-check-parameters instance) - (let ((id (wcomponent-parameter-value instance :id)) - (static-id (wcomponent-parameter-value instance :static-id))) - (if (and (null static-id) id) - (setf (htcomponent-client-id instance) (generate-id id)) - (setf (htcomponent-client-id instance) static-id))) (setf (htcomponent-body instance) content) instance)) (defun build-component (component-name &rest rest) + "This function is the one that WCOMPONENT init functions call to intantiate their relative components. +The REST parameter is flattened and divided into a pair, where the first element is the alist of the component parameters, +while the second is the component body." (let ((fbody (parse-htcomponent-function (flatten rest)))) (make-component component-name (first fbody) (second fbody)))) @@ -1065,26 +1083,6 @@ (getf (wcomponent-parameters c) key) result))) -(defmacro defcomponent (name superclass-name slot-specifier &body class-option) - (let ((symbolf (intern (format nil "~a>" name)))) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (defclass ,name - ,@(if (null superclass-name) - (list '(wcomponent)) - (list - (let ((result)) - (dolist (parent superclass-name) - (when (subtypep parent 'wcomponent) - (setf result t))) - (if result - superclass-name - (append '(wcomponent) superclass-name))))) - ,@(if (null class-option) - (list slot-specifier) - (push slot-specifier class-option))) - (setf (fdefinition `,',symbolf) #'(lambda(&rest rest) (build-component ',name rest)))))) - - (defmethod htcomponent-rewind ((wcomponent wcomponent) (page page)) (let ((template (wcomponent-template wcomponent))) (wcomponent-before-rewind wcomponent page) @@ -1147,24 +1145,6 @@ (defmethod wcomponent-before-render ((wcomponent wcomponent) (page page))) (defmethod wcomponent-after-render ((wcomponent wcomponent) (page page))) -(defun component-id-and-value (component &key (from-request-p t) value-as-list-p) - (let ((client-id (htcomponent-client-id component)) - (page (htcomponent-page component)) - (visit-object (wcomponent-parameter-value component :visit-object)) - (accessor (wcomponent-parameter-value component :accessor)) - (reader (wcomponent-parameter-value component :reader)) - (result-as-list (cinput-result-as-list component)) - (value "")) - (when (null visit-object) - (setf visit-object (htcomponent-page component))) - (cond - (from-request-p (setf value (page-req-parameter page client-id value-as-list-p))) - ((and (null reader) accessor) (setf value (funcall (fdefinition accessor) visit-object))) - (t (setf value (funcall (fdefinition reader) visit-object)))) - (values client-id - (if result-as-list - (list value) - value)))) (defmethod message-dispatch ((message-dispatcher message-dispatcher) key locale) nil) Modified: trunk/main/claw-core/src/translators.lisp ============================================================================== --- trunk/main/claw-core/src/translators.lisp (original) +++ trunk/main/claw-core/src/translators.lisp Sat Apr 26 11:05:43 2008 @@ -29,21 +29,11 @@ (in-package :claw) -(defgeneric translator-encode (translator wcomponent) - (:documentation "Encodes the input component value, used when rendering the component (Encodes from type to string).")) - -(defgeneric translator-decode (translator wcomponent) - (:documentation "Decodes the input component value after a form submit (Decodes from string to type).")) - -(defclass translator () - () - (:documentation "a translator object encodes and decodes values passed to a html input component")) - -(defmethod translator-encode ((translator translator) (wcomponent wcomponent)) +(defmethod translator-encode ((translator translator) (wcomponent cinput)) (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))) + (visit-object (cinput-visit-object wcomponent)) + (accessor (cinput-accessor wcomponent)) + (reader (cinput-reader wcomponent))) (format nil "~a" (if (component-validation-errors wcomponent) (page-req-parameter page (htcomponent-client-id wcomponent) nil) (progn @@ -59,9 +49,7 @@ (declare (ignore client-id)) new-value)) -(defvar *simple-translator* (make-instance 'translator) - "*SIMPLE-TRANSLATOR* is the default translator for any CINPUT component. -Its encoder and decoder methods pass values unchanged") +(setf *simple-translator* (make-instance 'translator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -84,11 +72,11 @@ :always-show-signum nil) (:documentation "A translator object encodes and decodes integer values passed to a html input component")) -(defmethod translator-encode ((translator translator-integer) (wcomponent wcomponent)) +(defmethod translator-encode ((translator translator-integer) (wcomponent cinput)) (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)) + (visit-object (cinput-visit-object wcomponent)) + (accessor (cinput-accessor wcomponent)) + (reader (cinput-reader wcomponent)) (grouping-size (translator-grouping-size translator)) (thousand-separator (translator-thousand-separator translator)) (signum-directive (if (translator-always-show-signum translator) @@ -141,11 +129,11 @@ (:documentation "a translator object encodes and decodes integer values passed to a html input component")) -(defmethod translator-encode ((translator translator-number) (wcomponent wcomponent)) +(defmethod translator-encode ((translator translator-number) (wcomponent cinput)) (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)) + (visit-object (cinput-visit-object wcomponent)) + (accessor (cinput-accessor wcomponent)) + (reader (cinput-reader wcomponent)) (thousand-separator (translator-thousand-separator translator)) (grouping-size (translator-grouping-size translator)) (decimal-digits (translator-decimal-digits translator)) @@ -221,11 +209,11 @@ -(defmethod translator-encode ((translator translator-date) (wcomponent wcomponent)) +(defmethod translator-encode ((translator translator-date) (wcomponent cinput)) (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)) + (visit-object (cinput-visit-object wcomponent)) + (accessor (cinput-accessor wcomponent)) + (reader (cinput-reader wcomponent)) (local-time-format (translator-local-time-format translator)) (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) (if (component-validation-errors wcomponent) Modified: trunk/main/claw-core/src/validators.lisp ============================================================================== --- trunk/main/claw-core/src/validators.lisp (original) +++ trunk/main/claw-core/src/validators.lisp Sat Apr 26 11:05:43 2008 @@ -67,15 +67,6 @@ (unless test (add-exception client-id message)))) -(defun validation-errors (&optional (request *request*)) - "Resurns possible validation errors occurred during form rewinding" - (aux-request-value :validation-errors request)) - -(defun component-validation-errors (component &optional (request *request*)) - "Resurns possible validation errors occurred during form rewinding bound to a specific component" - (let ((client-id (htcomponent-client-id component))) - (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." @@ -202,9 +193,20 @@ ;; ------------------------------------------------------------------------------------ -(defcomponent exception-monitor () () +(defclass exception-monitor (wcomponent) () + (:metaclass metacomponent) + (:default-initargs :empty t) (:documentation "If from submission contains exceptions. It displays exception messages")) +(let ((class (find-class 'exception-monitor))) + (closer-mop:ensure-finalized class) + (setf (documentation (find-symbol (format nil "~a>" (class-name class))) 'function) + (format nil "Description: ~a~%Parameters:~%~a~a~%~%~a" + "If from submission contains exceptions. It displays exception messages with a <ul> list" + *id-and-static-id-description* + (describe-html-attributes-from-class-slot-initargs class) + (describe-component-behaviour class)))) + (defmethod wcomponent-parameters ((exception-monitor exception-monitor)) (declare (ignore exception-monitor)) (list :class nil)) @@ -213,9 +215,10 @@ (let ((client-id (htcomponent-client-id exception-monitor)) (validation-errors (aux-request-value :validation-errors))) (when validation-errors - (ul> :static-id client-id - (loop for component-exceptions in validation-errors - collect (loop for message in (cdr component-exceptions) - collect (li> message))))))) + (ul> :static-id client-id + (wcomponent-informal-parameters cform) + (loop for component-exceptions in validation-errors + collect (loop for message in (cdr component-exceptions) + collect (li> message))))))) ;;------------------------------------------------------------------------------------------- Modified: trunk/main/claw-core/tests/some-page.lisp ============================================================================== --- trunk/main/claw-core/tests/some-page.lisp (original) +++ trunk/main/claw-core/tests/some-page.lisp Sat Apr 26 11:05:43 2008 @@ -29,10 +29,9 @@ (in-package :claw-tests) -(defcomponent inspector () ()) - -(defmethod wcomponent-parameters ((inspector inspector)) - (list :id :required :ref-id :required)) +(defcomponent inspector () + ((ref-id :initarg :ref-id + :reader ref-id))) (defmethod wcomponent-template ((inspector inspector)) (div> :static-id (htcomponent-client-id inspector) @@ -42,7 +41,7 @@ (format nil "document.getElementById\('~a').onclick = function \() {alert\(document.getElementById\('~a').innerHTML);};" (htcomponent-client-id inspector) - (wcomponent-parameter-value inspector :ref-id))) + (ref-id inspector))) (defclass some-page (page) ()) Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Sat Apr 26 11:05:43 2008 @@ -106,16 +106,16 @@ ;;;--------------------template-------------------------------- -(defcomponent site-template () ()) - -(defmethod wcomponent-parameters ((o site-template)) - (list :title :required)) +(defclass site-template (wcomponent) + ((title :initarg :title + :reader title)) + (:metaclass metacomponent)) (defmethod wcomponent-template ((o site-template)) (html> (head> (title> - (wcomponent-parameter-value o :title)) + (title o)) (style> :type "text/css" "input.error { background-color: #FF9999; @@ -163,10 +163,9 @@ (li> (a> :href "unauth.html" "unauthorized page")))))) (lisplet-register-page-location *test-lisplet* 'index-page "index.html" :welcome-page-p t) -(defcomponent msie-p ()()) - -(defmethod wcomponent-parameters ((msie-p msie-p)) - (list :id :required)) +(defclass msie-p (wcomponent) + () + (:metaclass metacomponent)) (defmethod wcomponent-template ((msie-p msie-p)) (let ((id (htcomponent-client-id msie-p))) @@ -285,7 +284,7 @@ (let ((princp (current-principal))) (site-template> :title "a page title" (if (null princp) - (cform> :id "loginform" :method "post" :action 'login-page-login + (cform> :id "loginform" :method "post" :action #'login-page-login (table> (tr> (td> "Username") @@ -351,7 +350,7 @@ (:default-initargs :name "kiuma" :surname "surnk" :colors nil - :gender '("M") + :gender "M" :age 1800 :capital 500055/100 :birthday (now) @@ -362,7 +361,7 @@ (let ((user (form-page-user form-page)) (name (form-page-name form-page)) (surname (form-page-surname form-page)) - (gender (first (form-page-gender form-page))) + (gender (form-page-gender form-page)) (age (form-page-age form-page))) (setf (user-name user) name (user-surname user) surname @@ -374,7 +373,7 @@ (defmethod page-content ((o form-page)) (site-template> :title "a page title" - (cform> :id "testform" :method "post" :action 'form-page-update-user + (cform> :id "testform" :method "post" :action #'form-page-update-user (table> (tr> (td> "Name") @@ -399,10 +398,10 @@ (td> "Gender") (td> (cselect> :id "gender" - :writer 'setf-gender + :accessor 'form-page-gender (loop for gender in (list "M" "F") collect (option> :value gender - (when (string= gender (first (form-page-gender o))) + (when (string= gender (form-page-gender o)) '(:selected "selected")) (if (string= gender "M") "Male" @@ -437,7 +436,7 @@ :type "text" :label "Capital" :translator (make-instance 'translator-number - :decimal-digits 4 + :decimal-digits 2 :thousand-separator #\') :validator #'(lambda (value) (let ((component (page-current-component o))) @@ -450,13 +449,13 @@ (cselect> :id "colors" :multiple "true" :style "width:80px;height:120px;" - :accessor 'form-page-colors - (loop for color in (list "R" "G" "B") - collect (option> :value color - (when (member color (form-page-colors o) :test #'string=) - '(:selected "selected")) - (cond - ((string= color "R") "red") + :accessor 'form-page-colors + (loop for color in (list "R" "G" "B") + collect (option> :value color + (when (find color (form-page-colors o) :test #'string=) + '(:selected "selected")) + (cond + ((string= color "R") "red") ((string= color "G") "green") (t "blue"))))))) (tr>

1 0

[claw-cvs] r41 - trunk/main/claw-core/tests
by achiumenti＠common-lisp.net 15 Apr '08

15 Apr '08

Author: achiumenti Date: Tue Apr 15 13:49:16 2008 New Revision: 41 Added: trunk/main/claw-core/tests/some-page.lisp Log: writing tests for manual Added: trunk/main/claw-core/tests/some-page.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-core/tests/some-page.lisp Tue Apr 15 13:49:16 2008 @@ -0,0 +1,58 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: tests/test1.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-tests) + +(defcomponent inspector () ()) + +(defmethod wcomponent-parameters ((inspector inspector)) + (list :id :required :ref-id :required)) + +(defmethod wcomponent-template ((inspector inspector)) + (div> :static-id (htcomponent-client-id inspector) + (htcomponent-body inspector))) + +(defmethod htcomponent-instance-initscript ((inspector inspector)) + (format nil "document.getElementById\('~a').onclick = + function \() {alert\(document.getElementById\('~a').innerHTML);};" + (htcomponent-client-id inspector) + (wcomponent-parameter-value inspector :ref-id))) + +(defclass some-page (page) ()) + +(defmethod page-content ((some-page some-page)) + (let ((hidden-component-id (generate-id "hiddenComp")) + (rnd-value (prin1-to-string (random 10000)))) + (site-template> :title "this is the page title" + :class "foo" + (p> + (div> :static-id hidden-component-id :style "display: none;" rnd-value) + (inspector> :id "inspector" :ref-id hidden-component-id "Show value"))))) + +(lisplet-register-page-location *test-lisplet* 'some-page "some-page.html")

1 0

[claw-cvs] r40 - trunk/main/claw-core
by achiumenti＠common-lisp.net 15 Apr '08

15 Apr '08

Author: achiumenti Date: Tue Apr 15 13:48:56 2008 New Revision: 40 Modified: trunk/main/claw-core/claw-tests.asd Log: writing tests for manual Modified: trunk/main/claw-core/claw-tests.asd ============================================================================== --- trunk/main/claw-core/claw-tests.asd (original) +++ trunk/main/claw-core/claw-tests.asd Tue Apr 15 13:48:56 2008 @@ -34,5 +34,6 @@ :depends-on (:claw) :components ((:module tests :components ((:file "packages") - (:file "test1" :depends-on ("packages")))))) + (:file "test1" :depends-on ("packages")) + (:file "some-page" :depends-on ("packages"))))))

1 0

[claw-cvs] r39 - trunk/doc/chapters
by achiumenti＠common-lisp.net 15 Apr '08

15 Apr '08

Author: achiumenti Date: Tue Apr 15 13:48:02 2008 New Revision: 39 Modified: trunk/doc/chapters/writing-components.texinfo Log: updating user manual Modified: trunk/doc/chapters/writing-components.texinfo ============================================================================== --- trunk/doc/chapters/writing-components.texinfo (original) +++ trunk/doc/chapters/writing-components.texinfo Tue Apr 15 13:48:02 2008 @@ -44,8 +44,8 @@ object, and is meant to be used just like any other standard function tag. The overriding of the method @code{wocomponent-parameters} must return an associative list where, if the key value is @code{:REQUIRED}, -it means that is is mandatory for the constructor function. In our case study a call to @code{SITE-TEMPLATE>} must contains also the -keyword @code{:TITLE} followed by its value. If the @code{:TITLE} is not provided an error will be signaled during the component +it means that it is mandatory for the constructor function. In our case study, a call to @code{SITE-TEMPLATE>} must contains also the +keyword @code{:TITLE} followed by its value. If the @code{:TITLE} is not provided, an error is signaled during the component instantiation. The overriding of the method @code{wocomponent-template} is in charge for the graphic aspect of the component, as you can imagine. @@ -55,12 +55,12 @@ @code{wcomponent-parameter-value} is used to retrieve a parameter passed to the constructor function. @item @code{wcomponent-informal-parameters} renders as an associative list of all the parameters not directly declared with the method -@code{wocomponent-parameters}, but that are present in the constructor function. +@code{wocomponent-parameters}, but are present in the constructor function, such as may be a @code{:CLASS} attribute. @item -@code{htcomponent-body} renders the body of the component +@code{htcomponent-body} renders the content body of the component @end itemize -So a call to the constructor function of our new fresh component might have this shape: +So, a call to the constructor function of our new fresh component, might have this shape: @cartouche @lisp (site-template> :title "this is the page title" @@ -94,12 +94,13 @@ Ouch, this is nearly what we expected, but it seems there are two extraneous tags, do you see them? -They are the meta and the script tags. +They are the <meta> and the <script> tags. -The meta tag is inserted by the @code{HTHEAD} component, that we have instantiated with @code{HEAD>}. -The value of the content attribute, is taken from the @code{PAGE-CONTENT-TYPE} slot method, whose default is @code{HUNCHENTOOT:*DEFAULT-CONTENT-TYPE*}. +The <meta> tag is inserted by the @code{HTHEAD} component, that we have instantiated with @code{HEAD>}. +The value of the @code{content} attribute is taken from the @code{PAGE-CONTENT-TYPE} slot method of the @code{PAGE} class, whose default is @code{HUNCHENTOOT:*DEFAULT-CONTENT-TYPE*}. +It is recomended to have ti value set to @code{"text/html; charset=UTF-8"}. -The script tag is used when @value{claw} components want to inject their instance javascripts. +The <script> tag is used when @value{claw} components want to inject their instance javascripts. So, for example, we could create a component that, when clicked, it shows a js alert containing the html component of another component: @@ -111,12 +112,14 @@ (list :id :required :ref-id :required)) (defmethod wcomponent-template ((inspector inspector)) - (div> :static-id (htcomponent-client-id inspactor) - (htcomponent-body o))) + (div> :static-id (htcomponent-client-id inspector) + (htcomponent-body inspector))) (defmethod htcomponent-instance-initscript ((inspector inspector)) - (format nil "document.getElementById('~a').onclick = - function () @{alert(document.getElementById('~a').innerHTML);@};" + (format nil "document.getElementById\('~a').onclick = + function \() @{ + alert\(document.getElementById\('~a').innerHTML); + @};" (htcomponent-client-id inspector) (wcomponent-parameter-value inspector :ref-id))) @@ -129,11 +132,45 @@ @lisp (defmethod page-content ((some-page some-page)) (let ((hidden-component-id (generate-id "hidden")) - (rnd-value (prin1-to-string (random 10000))) + (rnd-value (prin1-to-string (random 10000)))) (site-template> :title "this is the page title" :class "foo" (p> - (div> :static-id hidden-component-id rnd-value) - (inspector> :id "inspector" "Show value")))))) + (div> :static-id hidden-component-id + :style "display: none;" rnd-value) + (inspector> :id "inspector" + :ref-id hidden-component-id "Show value"))))) @end lisp @end cartouche + +and will render as: +@cartouche +@example +@format +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" + "http://www.w3.org/TR/html4/strict.dtd"> +<html> + <head> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> + <title>this is the page title</title> + </head> + <body class="foo"> + <p> + <div id="hiddenComp" style="display: none;">2351</div> + <div id="inspector">Show value</div> + </p> + <script type="text/javascript"> +// + </script> + </body> +</html> +@end format +@end example +@end cartouche

1 0

[claw-cvs] r38 - in trunk: doc/chapters main/claw-core/src
by achiumenti＠common-lisp.net 15 Apr '08

15 Apr '08

Author: achiumenti Date: Tue Apr 15 01:02:25 2008 New Revision: 38 Modified: trunk/doc/chapters/writing-components.texinfo trunk/main/claw-core/src/hunchentoot-overrides.lisp Log: user manual update Modified: trunk/doc/chapters/writing-components.texinfo ============================================================================== --- trunk/doc/chapters/writing-components.texinfo (original) +++ trunk/doc/chapters/writing-components.texinfo Tue Apr 15 01:02:25 2008 @@ -63,7 +63,8 @@ So a call to the constructor function of our new fresh component might have this shape: @cartouche @lisp -(site-template> :title "this is the page title" :class "foo" +(site-template> :title "this is the page title" + :class "foo" (p> Hello world)) @end lisp @@ -94,4 +95,45 @@ Ouch, this is nearly what we expected, but it seems there are two extraneous tags, do you see them? They are the meta and the script tags. -...continue... + +The meta tag is inserted by the @code{HTHEAD} component, that we have instantiated with @code{HEAD>}. +The value of the content attribute, is taken from the @code{PAGE-CONTENT-TYPE} slot method, whose default is @code{HUNCHENTOOT:*DEFAULT-CONTENT-TYPE*}. + +The script tag is used when @value{claw} components want to inject their instance javascripts. +So, for example, we could create a component that, when clicked, it shows a js alert containing the html +component of another component: + +@cartouche +@lisp +(defcomponent inspector () ()) + +(defmethod wcomponent-parameters ((inspector inspector)) + (list :id :required :ref-id :required)) + +(defmethod wcomponent-template ((inspector inspector)) + (div> :static-id (htcomponent-client-id inspactor) + (htcomponent-body o))) + +(defmethod htcomponent-instance-initscript ((inspector inspector)) + (format nil "document.getElementById('~a').onclick = + function () @{alert(document.getElementById('~a').innerHTML);@};" + (htcomponent-client-id inspector) + (wcomponent-parameter-value inspector :ref-id))) + +@end lisp +@end cartouche + +Ok, now we can use our new inspector component inside our page: + +@cartouche +@lisp +(defmethod page-content ((some-page some-page)) + (let ((hidden-component-id (generate-id "hidden")) + (rnd-value (prin1-to-string (random 10000))) + (site-template> :title "this is the page title" + :class "foo" + (p> + (div> :static-id hidden-component-id rnd-value) + (inspector> :id "inspector" "Show value")))))) +@end lisp +@end cartouche Modified: trunk/main/claw-core/src/hunchentoot-overrides.lisp ============================================================================== --- trunk/main/claw-core/src/hunchentoot-overrides.lisp (original) +++ trunk/main/claw-core/src/hunchentoot-overrides.lisp Tue Apr 15 01:02:25 2008 @@ -171,10 +171,10 @@ realm))) (when *reply* (cond ((null session) - (log-message :notice "No session for session identifier '~A' (User-Agent: '~A', IP: '~A', REALM: '~A')" + (log-message :notice "No session for session identifier '~A' \(User-Agent: '~A', IP: '~A', REALM: '~A')" session-identifier user-agent remote-addr realm)) (t - (log-message :warning "Fake session identifier '~A' (User-Agent: '~A', IP: '~A', REALM: '~A')" + (log-message :warning "Fake session identifier '~A' \(User-Agent: '~A', IP: '~A', REALM: '~A')" session-identifier user-agent remote-addr realm)))) (when session (remove-session session))

1 0

[claw-cvs] r37 - in trunk/doc: . chapters
by achiumenti＠common-lisp.net 10 Apr '08

10 Apr '08

Author: achiumenti Date: Thu Apr 10 02:08:57 2008 New Revision: 37 Modified: trunk/doc/chapters/getting-started.texinfo trunk/doc/chapters/writing-components.texinfo trunk/doc/claw.texinfo Log: user manual update Modified: trunk/doc/chapters/getting-started.texinfo ============================================================================== --- trunk/doc/chapters/getting-started.texinfo (original) +++ trunk/doc/chapters/getting-started.texinfo Thu Apr 10 02:08:57 2008 @@ -1,97 +1,4 @@ @node Getting Started @comment node-name, next, previous, up -@chapter Getting started with @value{claw} +@chapter Getting started with @value{claw}, your first application -Now that you know how to write pages in @value{claw}, lets move to a further step: writing components. - -A real @value{claw} web application is made of a lisplet, several pages and resources, and, of course, many reusable -components that go into pages. - -Using reusable components, may dramatically improve your productivity. You can then create custom components libraries -that will give to your web application a crystal clear style, and speed up the creation of repetitive piece -of HTML code, as page templates for instance. - -So said, let's create our first @value{claw} component, a site template. -@cartouche -@lisp -(defcomponent site-template () ()) - -(defmethod wcomponent-parameters ((o site-template)) - (list :title :required :home-page "/claw/test/index.html")) - -(defmethod wcomponent-template ((o site-template)) - (html> - (head> - (title> - (wcomponent-parameter-value o :title))) - (body> - (wcomponent-informal-parameters o) - (div> - :style "background-color: #DBDFE0;padding: 3px;" - (a> :href (wcomponent-parameter-value o :home-page) "home")) - (htcomponent-body o)))) -@end lisp -@end cartouche - -Thought this is not the best template you can do, it's a nice starting point to explain how components are created -(and used). - -First let's analyze the @code{defcomponent} instruction: this macro has the same signature of the @code{defclass} macro, -except that it creates a class that is always a @code{WOCOMPONENT} subclass. - -@code{defcomponent} also creates a function whose symbol is -the name of the component plus the character '>', @code{SITE-TEMPLATE>} in the specific case, that instantiate the corresponding -object, and is meant to be used just like any other standard function tag. - -The overriding of the method @code{wocomponent-parameters} must return an associative list where, if the key value is @code{:REQUIRED}, -it means that is is mandatory for the constructor function. In our case study a call to @code{SITE-TEMPLATE>} must contains also the -keyword @code{:TITLE} followed by its value. If the @code{:TITLE} is not provided an error will be signaled during the component -instantiation. - -The overriding of the method @code{wocomponent-template} is in charge for the graphic aspect of the component, as you can imagine. -Inside this method we have used calls to other three very important component methods: -@itemize @minus -@item -@code{wcomponent-parameter-value} is used to retrieve a parameter passed to the constructor function. -@item -@code{wcomponent-informal-parameters} renders as an associative list of all the parameters not directly declared with the method -@code{wocomponent-parameters}, but that are present in the constructor function. -@item -@code{htcomponent-body} renders the body of the component -@end itemize - -So a call to the constructor function of our new fresh component might have this shape: -@cartouche -@lisp -(site-template> :title "this is the page title" :class "foo" - (p> - Hello world)) -@end lisp -@end cartouche - -and will render as -@cartouche -@example -@format -<html> - <head> - <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> - <title>this is the page title</title> - </head> - <body class="foo"> - <p>Hello world</p> - <script type="text/javascript"> -// - </script> - </body> -</html> -@end format -@end example -@end cartouche - -Ouch, this is nearly what we expected, but it seems there are two extraneous tags, do you see them? - -They are the meta and the script tags. -...continue... Modified: trunk/doc/chapters/writing-components.texinfo ============================================================================== --- trunk/doc/chapters/writing-components.texinfo (original) +++ trunk/doc/chapters/writing-components.texinfo Thu Apr 10 02:08:57 2008 @@ -1,3 +1,97 @@ @node writing components @comment node-name, next, previous, up @chapter Creating a web application by writing reusable components + +Now that you know how to write pages in @value{claw}, lets move to a further step: writing components. + +A real @value{claw} web application is made of a lisplet, several pages and resources, and, of course, many reusable +components that go into pages. + +Using reusable components, may dramatically improve your productivity. You can then create custom components libraries +that will give to your web application a crystal clear style, and speed up the creation of repetitive piece +of HTML code, as page templates for instance. + +So said, let's create our first @value{claw} component, a site template. +@cartouche +@lisp +(defcomponent site-template () ()) + +(defmethod wcomponent-parameters ((o site-template)) + (list :title :required :home-page "/claw/test/index.html")) + +(defmethod wcomponent-template ((o site-template)) + (html> + (head> + (title> + (wcomponent-parameter-value o :title))) + (body> + (wcomponent-informal-parameters o) + (div> + :style "background-color: #DBDFE0;padding: 3px;" + (a> :href (wcomponent-parameter-value o :home-page) "home")) + (htcomponent-body o)))) +@end lisp +@end cartouche + +Thought this is not the best template you can do, it's a nice starting point to explain how components are created +(and used). + +First let's analyze the @code{defcomponent} instruction: this macro has the same signature of the @code{defclass} macro, +except that it creates a class that is always a @code{WOCOMPONENT} subclass. + +@code{defcomponent} also creates a function whose symbol is +the name of the component plus the character '>', @code{SITE-TEMPLATE>} in the specific case, that instantiate the corresponding +object, and is meant to be used just like any other standard function tag. + +The overriding of the method @code{wocomponent-parameters} must return an associative list where, if the key value is @code{:REQUIRED}, +it means that is is mandatory for the constructor function. In our case study a call to @code{SITE-TEMPLATE>} must contains also the +keyword @code{:TITLE} followed by its value. If the @code{:TITLE} is not provided an error will be signaled during the component +instantiation. + +The overriding of the method @code{wocomponent-template} is in charge for the graphic aspect of the component, as you can imagine. +Inside this method we have used calls to other three very important component methods: +@itemize @minus +@item +@code{wcomponent-parameter-value} is used to retrieve a parameter passed to the constructor function. +@item +@code{wcomponent-informal-parameters} renders as an associative list of all the parameters not directly declared with the method +@code{wocomponent-parameters}, but that are present in the constructor function. +@item +@code{htcomponent-body} renders the body of the component +@end itemize + +So a call to the constructor function of our new fresh component might have this shape: +@cartouche +@lisp +(site-template> :title "this is the page title" :class "foo" + (p> + Hello world)) +@end lisp +@end cartouche + +and will render as +@cartouche +@example +@format +<html> + <head> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> + <title>this is the page title</title> + </head> + <body class="foo"> + <p>Hello world</p> + <script type="text/javascript"> +// + </script> + </body> +</html> +@end format +@end example +@end cartouche + +Ouch, this is nearly what we expected, but it seems there are two extraneous tags, do you see them? + +They are the meta and the script tags. +...continue... Modified: trunk/doc/claw.texinfo ============================================================================== --- trunk/doc/claw.texinfo (original) +++ trunk/doc/claw.texinfo Thu Apr 10 02:08:57 2008 @@ -48,13 +48,12 @@ * Server:: * Lisplets:: * Pages:: -* Getting Started:: -* i18n:: +* writing components:: * forms:: * validation:: -* writing components:: -* advanced components:: +* i18n:: * login access:: +* Getting Started:: * Advanced techniques:: * Function index:: @c * Starting and Stopping:: @@ -71,13 +70,12 @@ @include chapters/server.texinfo @include chapters/lisplets.texinfo @include chapters/pages.texinfo -@include chapters/getting-started.texinfo -@include chapters/i18n.texinfo +@include chapters/writing-components.texinfo @include chapters/forms.texinfo @include chapters/validation.texinfo -@include chapters/writing-components.texinfo -@include chapters/advanced-components.texinfo +@include chapters/i18n.texinfo @include chapters/access.texinfo +@include chapters/getting-started.texinfo @include chapters/advanced-techniques.texinfo @node Function index

1 0

[claw-cvs] r36 - trunk/doc/chapters
by achiumenti＠common-lisp.net 09 Apr '08

09 Apr '08

Author: achiumenti Date: Wed Apr 9 17:13:20 2008 New Revision: 36 Modified: trunk/doc/chapters/getting-started.texinfo Log: user manual update Modified: trunk/doc/chapters/getting-started.texinfo ============================================================================== --- trunk/doc/chapters/getting-started.texinfo (original) +++ trunk/doc/chapters/getting-started.texinfo Wed Apr 9 17:13:20 2008 @@ -23,12 +23,7 @@ (html> (head> (title> - (wcomponent-parameter-value o :title)) - (style> :type "text/css" -"input.error { - background-color: #FF9999; -} -")) + (wcomponent-parameter-value o :title))) (body> (wcomponent-informal-parameters o) (div> @@ -37,5 +32,66 @@ (htcomponent-body o)))) @end lisp @end cartouche + Thought this is not the best template you can do, it's a nice starting point to explain how components are created (and used). + +First let's analyze the @code{defcomponent} instruction: this macro has the same signature of the @code{defclass} macro, +except that it creates a class that is always a @code{WOCOMPONENT} subclass. + +@code{defcomponent} also creates a function whose symbol is +the name of the component plus the character '>', @code{SITE-TEMPLATE>} in the specific case, that instantiate the corresponding +object, and is meant to be used just like any other standard function tag. + +The overriding of the method @code{wocomponent-parameters} must return an associative list where, if the key value is @code{:REQUIRED}, +it means that is is mandatory for the constructor function. In our case study a call to @code{SITE-TEMPLATE>} must contains also the +keyword @code{:TITLE} followed by its value. If the @code{:TITLE} is not provided an error will be signaled during the component +instantiation. + +The overriding of the method @code{wocomponent-template} is in charge for the graphic aspect of the component, as you can imagine. +Inside this method we have used calls to other three very important component methods: +@itemize @minus +@item +@code{wcomponent-parameter-value} is used to retrieve a parameter passed to the constructor function. +@item +@code{wcomponent-informal-parameters} renders as an associative list of all the parameters not directly declared with the method +@code{wocomponent-parameters}, but that are present in the constructor function. +@item +@code{htcomponent-body} renders the body of the component +@end itemize + +So a call to the constructor function of our new fresh component might have this shape: +@cartouche +@lisp +(site-template> :title "this is the page title" :class "foo" + (p> + Hello world)) +@end lisp +@end cartouche + +and will render as +@cartouche +@example +@format +<html> + <head> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> + <title>this is the page title</title> + </head> + <body class="foo"> + <p>Hello world</p> + <script type="text/javascript"> +// + </script> + </body> +</html> +@end format +@end example +@end cartouche + +Ouch, this is nearly what we expected, but it seems there are two extraneous tags, do you see them? + +They are the meta and the script tags. +...continue...

1 0

[claw-cvs] r35 - trunk/doc
by achiumenti＠common-lisp.net 09 Apr '08

09 Apr '08

Author: achiumenti Date: Wed Apr 9 14:01:54 2008 New Revision: 35 Modified: trunk/doc/claw.texinfo Log: updating user manual Modified: trunk/doc/claw.texinfo ============================================================================== --- trunk/doc/claw.texinfo (original) +++ trunk/doc/claw.texinfo Wed Apr 9 14:01:54 2008 @@ -46,6 +46,16 @@ @menu * Introduction:: * Server:: +* Lisplets:: +* Pages:: +* Getting Started:: +* i18n:: +* forms:: +* validation:: +* writing components:: +* advanced components:: +* login access:: +* Advanced techniques:: * Function index:: @c * Starting and Stopping:: @c * Compiler:: @@ -59,6 +69,16 @@ @include chapters/intro.texinfo @include chapters/server.texinfo +@include chapters/lisplets.texinfo +@include chapters/pages.texinfo +@include chapters/getting-started.texinfo +@include chapters/i18n.texinfo +@include chapters/forms.texinfo +@include chapters/validation.texinfo +@include chapters/writing-components.texinfo +@include chapters/advanced-components.texinfo +@include chapters/access.texinfo +@include chapters/advanced-techniques.texinfo @node Function index @unnumbered Function index

1 0

[claw-cvs] r34 - trunk/doc/chapters
by achiumenti＠common-lisp.net 09 Apr '08

09 Apr '08

Author: achiumenti Date: Wed Apr 9 13:59:58 2008 New Revision: 34 Modified: trunk/doc/chapters/getting-started.texinfo trunk/doc/chapters/intro.texinfo trunk/doc/chapters/lisplets.texinfo trunk/doc/chapters/pages.texinfo trunk/doc/chapters/server.texinfo Log: updating user manual Modified: trunk/doc/chapters/getting-started.texinfo ============================================================================== --- trunk/doc/chapters/getting-started.texinfo (original) +++ trunk/doc/chapters/getting-started.texinfo Wed Apr 9 13:59:58 2008 @@ -1,3 +1,41 @@ @node Getting Started @comment node-name, next, previous, up @chapter Getting started with @value{claw} + +Now that you know how to write pages in @value{claw}, lets move to a further step: writing components. + +A real @value{claw} web application is made of a lisplet, several pages and resources, and, of course, many reusable +components that go into pages. + +Using reusable components, may dramatically improve your productivity. You can then create custom components libraries +that will give to your web application a crystal clear style, and speed up the creation of repetitive piece +of HTML code, as page templates for instance. + +So said, let's create our first @value{claw} component, a site template. +@cartouche +@lisp +(defcomponent site-template () ()) + +(defmethod wcomponent-parameters ((o site-template)) + (list :title :required :home-page "/claw/test/index.html")) + +(defmethod wcomponent-template ((o site-template)) + (html> + (head> + (title> + (wcomponent-parameter-value o :title)) + (style> :type "text/css" +"input.error { + background-color: #FF9999; +} +")) + (body> + (wcomponent-informal-parameters o) + (div> + :style "background-color: #DBDFE0;padding: 3px;" + (a> :href (wcomponent-parameter-value o :home-page) "home")) + (htcomponent-body o)))) +@end lisp +@end cartouche +Thought this is not the best template you can do, it's a nice starting point to explain how components are created +(and used). Modified: trunk/doc/chapters/intro.texinfo ============================================================================== --- trunk/doc/chapters/intro.texinfo (original) +++ trunk/doc/chapters/intro.texinfo Wed Apr 9 13:59:58 2008 @@ -10,13 +10,13 @@ @value{claw} is based on components, highly reusable building blocks the make easy and fast the creation of a web application. By using and creating new components, the developer can create robust and consistent web application with the minimal effort. -Each component may inject into a page ist own set of stylesheet and javasctipt files, and may come with its own class or instance javascript +Each component may inject into a page its own set of stylesheet and javascript files, and may come with its own class or instance javascript directives (a class directive is inserted only once into the page, while this is not true for an instance script). This leads to the creation of very sophisticated components with a very little effort. -@value{claw} comes with its own authentication systme that lets you create both basic and form based authentication systems. +@value{claw} comes with its own authentication system that lets you create both basic and form based authentication systems. -@value{claw} has the capability to force the page renderinig throught the protocol https of pages managing sensible data, using simple +@value{claw} has the capability to force the page rendering through the HTTPS protocol of pages managing sensible data, using simple directives. @value{claw} comes with its own extensible localization and validation system. @@ -34,13 +34,13 @@ When a user asks for a page the request is sent to the @code{CLAWSERVER} that dispatches the request to the registered lisplets. -Lisplets are web resource containers that hold web pages and other resource files, such as javascript, image, css, etc. files, or even funcions, under a common path. +Lisplets are web resource containers that hold web pages and other resource files, such as javascript, image, css, etc. files, or even functions, under a common path. When a matching lisplet is then found, it dispatches the request to a registered resource that can be a page or a file or even a function. If the request is sent for a file, this is then sent back to the browser if found. -If the request is sent for a page, usually mapped to a html url, the dispatcher calls the page rendering function to display the page as an html resource. +If the request is sent for a page, usually mapped to a html URL, the dispatcher calls the page rendering function to display the page as an html resource. If no resource is found a 404 message page, is sent to the user as feedback. Modified: trunk/doc/chapters/lisplets.texinfo ============================================================================== --- trunk/doc/chapters/lisplets.texinfo (original) +++ trunk/doc/chapters/lisplets.texinfo Wed Apr 9 13:59:58 2008 @@ -32,7 +32,7 @@ At this point you have defined a web application registered to the URL ``http://localhost:4242/test'' that @value{claw} will be able to serve. -All sessions and the authentication and authourization logic will be under the default realm ``claw'', +All sessions and the authentication and authorization logic will be under the default realm ``claw'', so if you register another lisplet into the server with the instruction: @cartouche @lisp @@ -71,7 +71,7 @@ @subsection Adding files and folders to a @code{LISPLET} -Suppose now you want to provide, thought your web application, a file present on jour hard disk, for example: +Suppose now you want to provide, thought your web application, a file present on your hard disk, for example: ``/opt/webresources/images/matrix.jpg''. This is made very simple with the following instructions @@ -84,9 +84,9 @@ @end cartouche The jpeg file will now be available when accessing ``http://localhost:4242/test/images/matrix.jpg''. -The last rgument specifies the mime-type, but it's optional. +The last argument specifies the mime-type, but it's optional. -If you want to regiter an entire folder, the process is very similar +If you want to register an entire folder, the process is very similar @cartouche @lisp (lisplet-register-resource-location *test-lisplet* @@ -100,10 +100,10 @@ @subsection Adding functions to a @code{LISPLET} -Registering a function gives you more flexybility then registering a static resource as a file or a directory but the complexity +Registering a function gives you more flexibility then registering a static resource as a file or a directory but the complexity relies into the function that you want to register. -For example, if you want to provide the same ``matrix.jpg'' file throught a function, you'll have to do something of the kind: +For example, if you want to provide the same ``matrix.jpg'' file through a function, you'll have to do something of the kind: @cartouche @lisp (lisplet-register-function-location *test-lisplet* @@ -118,7 +118,7 @@ "images/matrix2.jpg" ) @end lisp @end cartouche -Now the image will be availbe at the URL ``http://localhost:4242/test/images/matrix2.jpg''. +Now the image will be available at the URL ``http://localhost:4242/test/images/matrix2.jpg''. The method @code{lisplet-register-function-location} accepts two optional keys: @itemize @minus @@ -139,10 +139,22 @@ @cartouche @lisp (defclass empty-page (page) ()) -(lisplet-register-page-location *test-lisplet* 'empty-page "index.html" :welcome-page-p t) +(lisplet-register-page-location *test-lisplet* 'empty-page "index.html" + :welcome-page-p t) @end lisp @end cartouche This will provide an empty page at the URL ``http://localhost:4242/test/index.html'' and, since it is defined as a welcome page when you'll access the URL ``http://localhost:4242/test'' you will redirected to it. + +@section Sessions + +Sessions are common place where you sore stateful user data. Session handling is slightly different from the original one +implemented by @code{Hunchentoot}, so, to instantiate a session you have to use the method +@cartouche +@lisp +(lisplet-start-session) +@end lisp +@end cartouche +inside your code. Modified: trunk/doc/chapters/pages.texinfo ============================================================================== --- trunk/doc/chapters/pages.texinfo (original) +++ trunk/doc/chapters/pages.texinfo Wed Apr 9 13:59:58 2008 @@ -1,3 +1,158 @@ @node Pages @comment node-name, next, previous, up @chapter Web application pages + +@value{claw} applications are usually made of pages. + +A @code{PAGE} is a @code{CLOS} class that contains the rendering logic and is called +by the @code{LISPLET} when the URL matches the page resource mapping. + +@section Writing your first @value{claw} page + +You already know how to register a @code{PAGE} into a @code{LISPLET}, if not, visit the previous chapter; what +you miss, is how to put content into a page. + +@value{claw} comes with the full set of html tags plus some custom components that we'll see in the next sections. + +All html tag are rendered with functions whose names are the tag name plus the character >. Tag attributes are pairs +of symbols for attribute names and strings for their values. + +For example the function that render a DIV tag with class attribute ``foo'' is: +@cartouche +@lisp +(div> :class "foo") +@end lisp +@end cartouche + +Given this short intro we are now ready to write our first @value{claw} page: +@cartouche +@lisp +(defclass index-page (page) ()) +(defmethod page-content ((index-page index-page)) + (html> + (head> + (title> "First sample page")) + (body> + (h1> "Hello world")))) +(lisplet-register-page-location *test-lisplet* 'index-page "index.html" + :welcome-page-p t) +@end lisp +@end cartouche + +So, overriding the method @code{PAGE-CONTENT} for your new defined page gives you the possibility +to insert its content. As you can see the method definition is very similar to an HTML file, thought +more concise. + +@subsection The special tag attribute: @code{:ID} and @code{:STATIC-ID} + +@value{claw} pages try to keep ``ID'' tag attributes unique among the page. This is particularly useful +when you have to render tags that expose their id inside a loop. +To see what happens when this situation occurs see the following example: +@cartouche +@lisp +(defmethod page-content ((sample-page sample-page)) + (html> + (head> + (title> "First sample page")) + (body> + (loop for letter in (list "A" "B" "C" "D") + collect (div> :id "item" letter))))) +@end lisp +@end cartouche + +will produce the following HTML code +@cartouche +@example +@format +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" + "http://www.w3.org/TR/html4/strict.dtd"> +<html> + <head> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> + <title>First sample page</title> + </head> + <body> + <div id="item">A</div> + <div id="item_1">B</div> + <div id="item_2">C</div> + <div id="item_3">D</div> + <script type="text/javascript"> +// + </script> + </body> +</html> +@end format +@end example +@end cartouche + +When you want to prevent the default behaviour on id generation you have to provide the tag with the +attribute @code{:STATIC-ID}, that will render into HTML as the attribute @code{:ID}, but without the id +unique logic generation. + +An important method that is present in all tags and component is the @code{GENERATE-ID} that you +may use to obtain a unique id and put into components or tags with @code{:STATIC-ID}. + +Look at the following to see how it can work: +@cartouche +@lisp +(defmethod page-content ((sample-page sample-page)) + (html> + (head> + (title> "First sample page")) + (body> + (loop for letter in (list "A" "B" "C" "D") + for id = (generate-id "item") then (generate-id "item") + collect (div> (span> :static-id id letter) + (span> :onclick + (format nil "alert(document.getElementById('~a').innerHTML);" + id) + "click me")))))) +@end lisp +@end cartouche +that will produce the following HTML code: +@cartouche +@example +@format +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" + "http://www.w3.org/TR/html4/strict.dtd"> +<html> + <head> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> + <title>First sample page</title> + </head> + <body> + <div> + <span id="item">A</span> + <span onclick="alert(document.getElementById('item').innerHTML);"> + click me</span> + </div> + <div> + <span id="item_1">B</span> + <span onclick="alert(document.getElementById('item_1').innerHTML);"> + click me</span> + </div> + <div> + <span id="item_2">C</span> + <span onclick="alert(document.getElementById('item_2').innerHTML);"> + click me</span> + </div> + <div> + <span id="item_3">D</span> + <span onclick="alert(document.getElementById('item_3').innerHTML);"> + click me</span> + </div> + <script type="text/javascript"> +// + </script> + </body> +</html> +@end format +@end example +@end cartouche + +So, the outside tag generated id, is used in the onclick method of the span tags to reference the +previous tag. Modified: trunk/doc/chapters/server.texinfo ============================================================================== --- trunk/doc/chapters/server.texinfo (original) +++ trunk/doc/chapters/server.texinfo Wed Apr 9 13:59:58 2008 @@ -431,7 +431,8 @@ @cartouche @lisp -(defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4443 +(defparameter *clawserver* (make-instance 'clawserver :port 4242 + :sslport 4443 :ssl-certificate-file #P"/path/to/certificate/cacert.pem" :ssl-privatekey-file #P"/path/to/certificate/privkey.pem"))) (clawserver-start *clawserver*)

1 0