From achiumenti at common-lisp.net Tue Apr 1 16:11:58 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Tue, 1 Apr 2008 11:11:58 -0500 (EST) Subject: [claw-cvs] r25 - in trunk/main/claw-core: . src tests Message-ID: <20080401161158.746B57113E@common-lisp.net> Author: achiumenti Date: Tue Apr 1 11:11:57 2008 New Revision: 25 Added: trunk/main/claw-core/src/translators.lisp Modified: trunk/main/claw-core/claw.asd trunk/main/claw-core/src/packages.lisp trunk/main/claw-core/src/validators.lisp trunk/main/claw-core/tests/packages.lisp trunk/main/claw-core/tests/test1.lisp Log: added local-time integration with validator and translator Modified: trunk/main/claw-core/claw.asd ============================================================================== --- trunk/main/claw-core/claw.asd (original) +++ trunk/main/claw-core/claw.asd Tue Apr 1 11:11:57 2008 @@ -39,7 +39,8 @@ (:file "locales" :depends-on ("i18n")) (:file "hunchentoot-overrides" :depends-on ("packages")) (:file "tags" :depends-on ("misc")) - (:file "validators" :depends-on ("tags")) + (:file "validators" :depends-on ("tags")) + (: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/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Tue Apr 1 11:11:57 2008 @@ -288,6 +288,7 @@ :translator :translator-integer :translator-number + :translator-date :translator-encode :translator-decode :*simple-translator* @@ -299,6 +300,7 @@ :validator-size :validator-range :validator-number - :validator-integer + :validator-integer + :validator-date-range :exception-monitor :exception-monitor>)) Added: trunk/main/claw-core/src/translators.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-core/src/translators.lisp Tue Apr 1 11:11:57 2008 @@ -0,0 +1,300 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/components.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) + +(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)) + (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))) + (format nil "~a" (if (component-validation-errors wcomponent) + (page-req-parameter page (htcomponent-client-id wcomponent) nil) + (progn + (when (null visit-object) + (setf visit-object (htcomponent-page wcomponent))) + (if (and (null reader) accessor) + (funcall (fdefinition accessor) visit-object) + (funcall (fdefinition reader) visit-object))))))) + +(defmethod translator-decode ((translator translator) (wcomponent wcomponent)) + (multiple-value-bind (client-id new-value) + (component-id-and-value wcomponent) + (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") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;; Integer translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass translator-integer (translator) + ((thousand-separator :initarg :thousand-separator + :reader translator-thousand-separator + :documentation "If specified (as character), it is the thousands separator. Despite of +its name, grouping is done following the TRANSLATOR-GROUPING-SIZE, so it's not a real 'tousands' separator") + (always-show-signum :initarg :always-show-signum + :reader translator-always-show-signum + :documentation "When true the signum is used also for displaying positive numbers.") + (grouping-size :initarg :grouping-size + :reader translator-grouping-size + :documentation "Used only if TRANSLATOR-THOUSAND-SEPARATOR is defined. Default to 3")) + (:default-initargs :thousand-separator nil + :grouping-size 3 + :always-show-signum nil) + (:documentation "A translator object encodes and decodes integer values passed to a html input component")) + +(defmethod translator-encode ((translator translator-integer) (wcomponent wcomponent)) + (let* ((page (htcomponent-page wcomponent)) + (visit-object (wcomponent-parameter-value wcomponent :visit-object)) + (accessor (wcomponent-parameter-value wcomponent :accessor)) + (reader (wcomponent-parameter-value wcomponent :reader)) + (grouping-size (translator-grouping-size translator)) + (thousand-separator (translator-thousand-separator translator)) + (signum-directive (if (translator-always-show-signum translator) + "@" + "")) + (control-string (if thousand-separator + (format nil "~~~d,',v:~aD" grouping-size signum-directive) + (format nil "~~~ad" signum-directive))) + + (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) + (if (component-validation-errors wcomponent) + value + (progn + (when (null visit-object) + (setf visit-object (htcomponent-page wcomponent))) + (setf value (cond + ((and (null reader) accessor) (funcall (fdefinition accessor) visit-object)) + (t (funcall (fdefinition reader) visit-object)))) + (if thousand-separator + (string-trim " " (format nil control-string thousand-separator value)) + (format nil control-string value)))))) + +(defmethod translator-decode ((translator translator-integer) (wcomponent wcomponent)) + (let* ((thousand-separator (translator-thousand-separator translator))) + (multiple-value-bind (client-id new-value) + (component-id-and-value wcomponent) + (declare (ignore client-id)) + (if thousand-separator + (parse-integer (regex-replace-all (format nil "~a" thousand-separator) new-value "")) + (parse-integer new-value))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;Folating point number translator ;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass translator-number (translator-integer) + ((decimals-separator :initarg :decimals-separator + :reader translator-decimals-separator + :documentation "The decimal separator of the rendered number. Default to #\.") + (decimal-digits :initarg :decimal-digits + :reader translator-decimal-digits + :documentation "force the rendering of the value to a fixed number of decimal digits") + (coerce :initarg :coerce + :accessor translator-coerce + :documentation "Coerces the decoded input value to the given value type")) + (:default-initargs :decimals-separator #\. + ;:integer-digits nil + :decimal-digits nil + :coerce 'ratio) + (:documentation "a translator object encodes and decodes integer values passed to a html input component")) + + +(defmethod translator-encode ((translator translator-number) (wcomponent wcomponent)) + (let* ((page (htcomponent-page wcomponent)) + (visit-object (wcomponent-parameter-value wcomponent :visit-object)) + (accessor (wcomponent-parameter-value wcomponent :accessor)) + (reader (wcomponent-parameter-value wcomponent :reader)) + (thousand-separator (translator-thousand-separator translator)) + (grouping-size (translator-grouping-size translator)) + (decimal-digits (translator-decimal-digits translator)) + (decimals-separator (translator-decimals-separator translator)) + (signum-directive (if (translator-always-show-signum translator) + "@" + "")) + (integer-control-string (if thousand-separator + (format nil "~~~d,',v:~aD" grouping-size signum-directive) + (format nil "~~~ad" signum-directive))) + + (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) + (if (component-validation-errors wcomponent) + value + (progn + (when (null visit-object) + (setf visit-object (htcomponent-page wcomponent))) + (multiple-value-bind (int-value dec-value) + (floor (cond + ((and (null reader) accessor) (funcall (fdefinition accessor) visit-object)) + (t (funcall (fdefinition reader) visit-object)))) + (progn + (setf dec-value (coerce dec-value 'float)) + (format nil "~a~a" (if thousand-separator + (string-trim " " (format nil integer-control-string thousand-separator int-value)) + (format nil integer-control-string int-value)) + (cond + ((and (= 0.0 (coerce dec-value 'double-float)) decimal-digits) + (format nil "~a~a" decimals-separator (make-string decimal-digits :initial-element #\0))) + (decimal-digits + (let ((frac-part (subseq (format nil "~f" dec-value) 2))) + (if (> (length frac-part) decimal-digits) + (setf frac-part (subseq frac-part 0 decimal-digits)) + (setf frac-part (concatenate 'string frac-part (make-string (- decimal-digits (length frac-part)) :initial-element #\0)))) + (format nil "~a~a" decimals-separator frac-part))) + (t (format nil "~a~a" decimals-separator (subseq (format nil "~f" dec-value) 2))))))))))) + + +(defmethod translator-decode ((translator translator-number) (wcomponent wcomponent)) + (let* ((thousand-separator (translator-thousand-separator translator)) + (type (translator-coerce translator)) + (int-value) + (dec-value)) + (multiple-value-bind (client-id new-value) + (component-id-and-value wcomponent) + (declare (ignore client-id)) + (when thousand-separator + (setf new-value (regex-replace-all (format nil "~a" thousand-separator) new-value ""))) + (let ((decomposed-string (all-matches-as-strings "[0-9]+" new-value)) + (result)) + (setf int-value (parse-integer (concatenate 'string (first decomposed-string) (second decomposed-string))) + dec-value (expt 10 (length (second decomposed-string))) + result (/ int-value dec-value)) + (if (integerp result) + result + (coerce result type)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;; Dates translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass translator-date (translator) + ((local-time-format :initarg :local-time-format + :reader translator-local-time-format + :documentation "Sets the format of a date using a list where element are joined together and :DATE :MONTH and :YEAR are +expanded into day of the month for :DATE, month number for :MONTH and the year for :YEAR. The Default is the list '(:month \"/\" :date \"/\" :year)")) + (:default-initargs :local-time-format '(:month "/" :date "/" :year)) + (:documentation "A translator object encodes and decodes local-date object value passed to a html input component. +When decoding the input compoenent value string to a local-time instance +if the date is expressed in a wrong format or is not valid, a localizable message \"Field ~a is not a valid date or wrong format: ~a\" is sent with key \"VALIDATOR-DATE\". +The argument for the message will be the :label attribute of the COMPONENT and the input component string value.")) + + + +(defmethod translator-encode ((translator translator-date) (wcomponent wcomponent)) + (let* ((page (htcomponent-page wcomponent)) + (visit-object (wcomponent-parameter-value wcomponent :visit-object)) + (accessor (wcomponent-parameter-value wcomponent :accessor)) + (reader (wcomponent-parameter-value wcomponent :reader)) + (local-time-format (translator-local-time-format translator)) + (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) + (if (component-validation-errors wcomponent) + value + (progn + (when (null visit-object) + (setf visit-object (htcomponent-page wcomponent))) + (setf value (cond + ((and (null reader) accessor) (funcall (fdefinition accessor) visit-object)) + (t (funcall (fdefinition reader) visit-object)))) + (if (and value (not (stringp value))) + (progn + (local-time-to-string value + local-time-format)) + value))))) + +(defmethod translator-decode ((translator translator-date) (wcomponent wcomponent)) + (let ((date-format (translator-local-time-format translator)) + (sec 0) + (min 0) + (hour 0) + (day 0) + (month 0) + (year 0) + (old-value)) + (multiple-value-bind (client-id new-value) + (component-id-and-value wcomponent) + (declare (ignore client-id)) + (when (and new-value (string-not-equal new-value "")) + (setf old-value new-value) + (loop for element in date-format + do (if (stringp element) + (setf new-value (subseq new-value (length element))) + (ccase element + (:second (multiple-value-bind (value size) + (parse-integer new-value :junk-allowed t) + (setf new-value (subseq new-value size)) + (setf sec value))) + (:minute (multiple-value-bind (value size) + (parse-integer new-value :junk-allowed t) + (setf new-value (subseq new-value size)) + (setf min value))) + (:hour (multiple-value-bind (value size) + (parse-integer new-value :junk-allowed t) + (setf new-value (subseq new-value size)) + (setf hour value))) + (:date (multiple-value-bind (value size) + (parse-integer new-value :junk-allowed t) + (setf new-value (subseq new-value size)) + (setf day value))) + (:month (multiple-value-bind (value size) + (parse-integer new-value :junk-allowed t) + (setf new-value (subseq new-value size)) + (setf month value))) + (:year (multiple-value-bind (value size) + (parse-integer new-value :junk-allowed t) + (setf new-value (subseq new-value size)) + (setf year value)))))) + (validate (and (string-equal new-value "") + (>= sec 0) + (>= min 0) + (>= hour 0) + (and (> month 0) (<= month 12)) + (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) + old-value)) + (if (component-validation-errors wcomponent) + old-value + (encode-local-time 0 sec min hour day month year)))))) + Modified: trunk/main/claw-core/src/validators.lisp ============================================================================== --- trunk/main/claw-core/src/validators.lisp (original) +++ trunk/main/claw-core/src/validators.lisp Tue Apr 1 11:11:57 2008 @@ -29,259 +29,27 @@ (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 local-time-to-string (local-time format) + (:documentation "Writes a local-time instance the FORMAT list where element are joined together and :SECOND :MINUTE :HOUR :DATE :MONTH and :YEAR are +expanded into seconds for :SECOND, minutes for :MINUTE, hour of the day for :HOUR, day of the month for :DATE, month number for :MONTH and the year for :YEAR. +A format list may be for example '(:month \"/\" :date \"/\" :year)")) + +(defmethod local-time-to-string ((local-time local-time) format) + (multiple-value-bind (nsec sec min hour day month year) + (decode-local-time local-time) + (declare (ignore nsec)) + (loop for result = "" then (concatenate 'string result (if (stringp element) + element + (ccase element + (:second (format nil "~2,'0D" sec)) + (:minute (format nil "~2,'0D" min)) + (:hour (format nil "~2,'0D" hour)) + (:date (format nil "~2,'0D" day)) + (:month (format nil "~2,'0D" month)) + (:year (format nil "~4,'0D" year))))) + for element in format + finally (return result)))) -(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)) - (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))) - (format nil "~a" (if (component-validation-errors wcomponent) - (page-req-parameter page (htcomponent-client-id wcomponent) nil) - (progn - (when (null visit-object) - (setf visit-object (htcomponent-page wcomponent))) - (if (and (null reader) accessor) - (funcall (fdefinition accessor) visit-object) - (funcall (fdefinition reader) visit-object))))))) - -(defmethod translator-decode ((translator translator) (wcomponent wcomponent)) - (multiple-value-bind (client-id new-value) - (component-id-and-value wcomponent) - (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") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;; Integer translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defclass translator-integer (translator) - ((thousand-separator :initarg :thousand-separator - :reader translator-thousand-separator - :documentation "If specified (as character), it is the thousands separator. Despite of -its name, grouping is done following the TRANSLATOR-GROUPING-SIZE, so it's not a real 'tousands' separator") - (always-show-signum :initarg :always-show-signum - :reader translator-always-show-signum - :documentation "When true the signum is used also for displaying positive numbers.") - (grouping-size :initarg :grouping-size - :reader translator-grouping-size - :documentation "Used only if TRANSLATOR-THOUSAND-SEPARATOR is defined. Default to 3")) - (:default-initargs :thousand-separator nil - :grouping-size 3 - :always-show-signum nil) - (:documentation "A translator object encodes and decodes integer values passed to a html input component")) - -(defmethod translator-encode ((translator translator-integer) (wcomponent wcomponent)) - (let* ((page (htcomponent-page wcomponent)) - (visit-object (wcomponent-parameter-value wcomponent :visit-object)) - (accessor (wcomponent-parameter-value wcomponent :accessor)) - (reader (wcomponent-parameter-value wcomponent :reader)) - (grouping-size (translator-grouping-size translator)) - (thousand-separator (translator-thousand-separator translator)) - (signum-directive (if (translator-always-show-signum translator) - "@" - "")) - (control-string (if thousand-separator - (format nil "~~~d,' ,v:~aD" grouping-size signum-directive) - (format nil "~~~ad" signum-directive))) - - (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) - (if (component-validation-errors wcomponent) - value - (progn - (when (null visit-object) - (setf visit-object (htcomponent-page wcomponent))) - (setf value (cond - ((and (null reader) accessor) (funcall (fdefinition accessor) visit-object)) - (t (funcall (fdefinition reader) visit-object)))) - (if thousand-separator - (string-trim " " (format nil control-string thousand-separator value)) - (format nil control-string value)))))) - -(defmethod translator-decode ((translator translator-integer) (wcomponent wcomponent)) - (let* ((thousand-separator (translator-thousand-separator translator))) - (multiple-value-bind (client-id new-value) - (component-id-and-value wcomponent) - (declare (ignore client-id)) - (if thousand-separator - (parse-integer (regex-replace-all (format nil "~a" thousand-separator) new-value "")) - (parse-integer new-value))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;Folating point number translator ;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defclass translator-number (translator-integer) - ((decimals-separator :initarg :decimals-separator - :reader translator-decimals-separator - :documentation "The decimal separator of the rendered number. Default to #\.") - (decimal-digits :initarg :decimal-digits - :reader translator-decimal-digits - :documentation "force the rendering of the value to a fixed number of decimal digits") - (coerce :initarg :coerce - :accessor translator-coerce - :documentation "Coerces the decoded input value to the given value type")) - (:default-initargs :decimals-separator #\. - ;:integer-digits nil - :decimal-digits nil - :coerce 'ratio) - (:documentation "a translator object encodes and decodes integer values passed to a html input component")) - - -(defmethod translator-encode ((translator translator-number) (wcomponent wcomponent)) - (let* ((page (htcomponent-page wcomponent)) - (visit-object (wcomponent-parameter-value wcomponent :visit-object)) - (accessor (wcomponent-parameter-value wcomponent :accessor)) - (reader (wcomponent-parameter-value wcomponent :reader)) - (thousand-separator (translator-thousand-separator translator)) - (grouping-size (translator-grouping-size translator)) - (decimal-digits (translator-decimal-digits translator)) - (decimals-separator (translator-decimals-separator translator)) - (signum-directive (if (translator-always-show-signum translator) - "@" - "")) - (integer-control-string (if thousand-separator - (format nil "~~~d,' ,v:~aD" grouping-size signum-directive) - (format nil "~~~ad" signum-directive))) - - (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) - (if (component-validation-errors wcomponent) - value - (progn - (when (null visit-object) - (setf visit-object (htcomponent-page wcomponent))) - (multiple-value-bind (int-value dec-value) - (floor (cond - ((and (null reader) accessor) (funcall (fdefinition accessor) visit-object)) - (t (funcall (fdefinition reader) visit-object)))) - (progn - (setf dec-value (coerce dec-value 'float)) - (format nil "~a~a" (if thousand-separator - (string-trim " " (format nil integer-control-string thousand-separator int-value)) - (format nil integer-control-string int-value)) - (cond - ((and (= 0.0 (coerce dec-value 'double-float)) decimal-digits) - (format nil "~a~a" decimals-separator (make-string decimal-digits :initial-element #\0))) - (decimal-digits - (let ((frac-part (subseq (format nil "~f" dec-value) 2))) - (if (> (length frac-part) decimal-digits) - (setf frac-part (subseq frac-part 0 decimal-digits)) - (setf frac-part (concatenate 'string frac-part (make-string (- decimal-digits (length frac-part)) :initial-element #\0)))) - (format nil "~a~a" decimals-separator frac-part))) - (t (format nil "~a~a" decimals-separator (subseq (format nil "~f" dec-value) 2))))))))))) - - -(defmethod translator-decode ((translator translator-number) (wcomponent wcomponent)) - (let* ((thousand-separator (translator-thousand-separator translator)) - (type (translator-coerce translator)) - (int-value) - (dec-value)) - (multiple-value-bind (client-id new-value) - (component-id-and-value wcomponent) - (declare (ignore client-id)) - (when thousand-separator - (setf new-value (regex-replace-all (format nil "~a" thousand-separator) new-value ""))) - (let ((decomposed-string (all-matches-as-strings "[0-9]+" new-value)) - (result)) - (setf int-value (parse-integer (concatenate 'string (first decomposed-string) (second decomposed-string))) - dec-value (expt 10 (length (second decomposed-string))) - result (/ int-value dec-value)) - (if (integerp result) - result - (coerce result type)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;; Dates translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defclass translator-date (translator) - ((date-format :initarg :date-format - :reader translator-date-fromat - :documentation "Sets the format of a date using a list where element are joined together and :DATE :MONTH and :YEAR are -expanded into day of the month for :DATE, month number for :MONTH and the year for :YEAR. The Default is the list '(:month \"/\" :date \"/\" :year)")) - (:default-initargs :date-format '(:month "/" :date "/" :year)) - (:documentation "A translator object encodes and decodes local-date object value passed to a html input component")) - - -#| -(defmethod translator-encode ((translator translator-number) (wcomponent wcomponent)) - (let* ((page (htcomponent-page wcomponent)) - (visit-object (wcomponent-parameter-value wcomponent :visit-object)) - (accessor (wcomponent-parameter-value wcomponent :accessor)) - (reader (wcomponent-parameter-value wcomponent :reader)) - (thousand-separator (translator-thousand-separator translator)) - (grouping-size (translator-grouping-size translator)) - (decimal-digits (translator-decimal-digits translator)) - (decimals-separator (translator-decimals-separator translator)) - (signum-directive (if (translator-always-show-signum translator) - "@" - "")) - (integer-control-string (if thousand-separator - (format nil "~~~d,' ,v:~aD" grouping-size signum-directive) - (format nil "~~~ad" signum-directive))) - - (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) - (if (component-validation-errors wcomponent) - value - (progn - (when (null visit-object) - (setf visit-object (htcomponent-page wcomponent))) - (multiple-value-bind (int-value dec-value) - (floor (cond - ((and (null reader) accessor) (funcall (fdefinition accessor) visit-object)) - (t (funcall (fdefinition reader) visit-object)))) - (progn - (setf dec-value (coerce dec-value 'float)) - (format nil "~a~a" (if thousand-separator - (string-trim " " (format nil integer-control-string thousand-separator int-value)) - (format nil integer-control-string int-value)) - (cond - ((and (= 0.0 (coerce dec-value 'double-float)) decimal-digits) - (format nil "~a~a" decimals-separator (make-string decimal-digits :initial-element #\0))) - (decimal-digits - (let ((frac-part (subseq (format nil "~f" dec-value) 2))) - (if (> (length frac-part) decimal-digits) - (setf frac-part (subseq frac-part 0 decimal-digits)) - (setf frac-part (concatenate 'string frac-part (make-string (- decimal-digits (length frac-part)) :initial-element #\0)))) - (format nil "~a~a" decimals-separator frac-part))) - (t (format nil "~a~a" decimals-separator (subseq (format nil "~f" dec-value) 2))))))))))) - - -(defmethod translator-decode ((translator translator-number) (wcomponent wcomponent)) - (let* ((thousand-separator (translator-thousand-separator translator)) - (type (translator-coerce translator)) - (int-value) - (dec-value)) - (multiple-value-bind (client-id new-value) - (component-id-and-value wcomponent) - (declare (ignore client-id)) - (when thousand-separator - (setf new-value (regex-replace-all (format nil "~a" thousand-separator) new-value ""))) - (let ((decomposed-string (all-matches-as-strings "[0-9]+" new-value)) - (result)) - (setf int-value (parse-integer (concatenate 'string (first decomposed-string) (second decomposed-string))) - dec-value (expt 10 (length (second decomposed-string))) - result (/ int-value dec-value)) - (if (integerp result) - result - (coerce result type)))))) -|# -;;---------------------------------------------------------------------------------------- (defun add-exception (id reason) "Adds an exception for the given input component identified by its ID with the message expressed by REASON" (let* ((validation-errors (aux-request-value :validation-errors)) @@ -326,7 +94,7 @@ (when value (setf value (format nil "~a" value)) (setf value-len (length value)) - (or (= value-len 0) + (and (= value-len 0) (when min-size (validate (>= value-len min-size) :component component @@ -347,7 +115,7 @@ If greater then :MIN, a localizable message \"Field ~a is not greater then or equal to ~d.\" is sent with key \"VALIDATOR-RANGE-MAX\". The argument for the message will be the :label attribute of the COMPONENT and the :MAX value." (when value - (or (when min + (and (when min (validate (>= value min) :component component :message (format nil (do-message "VALIDATOR-RANGE-MIN" "Field ~a is not greater then or equal to ~d") @@ -370,7 +138,7 @@ The argument for the message will be the :label attribute of the COMPONENT." (when value (let ((test (numberp value))) - (or (validate test + (and (validate test :component component :message (format nil (do-message "VALIDATOR-NUMBER" "Field ~a is not a valid number.") (wcomponent-parameter-value component :label))) (validator-range component value :min min :max max))))) @@ -381,12 +149,58 @@ The argument for the message will be the :label attribute of the COMPONENT." (when value (let ((test (integerp value))) - (or (validate test + (and (validate test :component component :message (format nil (do-message "VALIDATOR-INTEGER" "Field ~a is not a valid integer.") (wcomponent-parameter-value component :label))) (validator-range component value :min min :max max))))) +(defun validator-date-range (component value &key min max (use-date-p t) use-time-p) + "Checks if the input field VALUE is a date between min and max. +If :USE-DATE-P is not nil and :USE-TIME-P is nil, validation is made without considering the time part of local-time. +If :USE-DATE-P nil and :USE-TIME-P is not nil, validation is made without considering the date part of local-time. +If :USE-DATE-P and :USE-TIME-P are both not nil or nil, validation is made considering the date and time part of local-time. +If value is less then the date passed to :MIN, a localizable message \"Field ~a is less then ~a.\" is sent with key \"VALIDATOR-DATE-RANGE-MIN\". +The argument for the message will be the :label attribute of the COMPONENT and the value passed to :MIN parsed with the :LOCAL-TIME-FORMAT keyword. +If value is greater then the date passed to :MAX, a localizable message \"Field ~a is greater then ~a.\" is sent with key \"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))) + (new-value (make-instance 'local-time + :nsec (nsec-of value) + :sec (sec-of value) + :day (day-of value) + :timezone (timezone-of value)))) + (when (and use-date-p (not use-time-p)) + (setf (local-time:nsec-of new-value) 0 + (local-time:sec-of new-value) 0) + (when min + (setf (local-time:nsec-of min) 0 + (local-time:sec-of min) 0)) + (when max + (setf (local-time:nsec-of max) 0 + (local-time:sec-of max) 0))) + (when (and (not use-date-p) use-time-p) + (setf (local-time:day-of new-value) 0) + (when min + (setf (local-time:day-of min) 0)) + (when max + (setf (local-time:day-of max) 0))) + (and (when min + (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) + (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) + (local-time-to-string max local-time-format)))))))) + + + ;; ------------------------------------------------------------------------------------ (defcomponent exception-monitor () () (:documentation "If from submission contains exceptions. It displays exception messages")) Modified: trunk/main/claw-core/tests/packages.lisp ============================================================================== --- trunk/main/claw-core/tests/packages.lisp (original) +++ trunk/main/claw-core/tests/packages.lisp Tue Apr 1 11:11:57 2008 @@ -30,6 +30,6 @@ (in-package :cl-user) (defpackage :claw-tests - (:use :cl :claw :hunchentoot) + (:use :cl :claw :hunchentoot :local-time) (:export :claw-tst-start :claw-tst-stop)) \ No newline at end of file Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Tue Apr 1 11:11:57 2008 @@ -328,13 +328,17 @@ (age :initarg :age :accessor form-page-age) (capital :initarg :capital - :accessor form-page-capital)) + :accessor form-page-capital) + (birthday :initarg :birthday + :accessor form-page-birthday)) + (:default-initargs :name "kiuma" :surname "surnk" :colors nil :gender '("M") :age 1800 :capital 500055/100 + :birthday (now) :message-dispatcher *lisplet-messages* :user (make-instance 'user))) @@ -400,6 +404,17 @@ (validator-integer component value :min 1 :max 2000))) :accessor 'form-page-age)"*")) (tr> + (td> "Bithday") + (td> + (cinput> :id "bday" + :type "text" + :label "Birthday" + :translator (make-instance 'translator-date :local-time-format '(:date "-" :month "-" :year)) + :validator #'(lambda (value) + (let ((component (page-current-component o))) + (validator-date-range component value :min (local-time:encode-local-time 0 0 0 0 31 12 1900)))) + :accessor 'form-page-birthday)"(dd-mm-yyyy)")) + (tr> (td> "Capital") (td> (cinput> :id "capital" From achiumenti at common-lisp.net Wed Apr 2 07:15:27 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 2 Apr 2008 02:15:27 -0500 (EST) Subject: [claw-cvs] r26 - trunk/doc/chapters Message-ID: <20080402071527.E59117432B@common-lisp.net> Author: achiumenti Date: Wed Apr 2 02:15:27 2008 New Revision: 26 Modified: trunk/doc/chapters/intro.texinfo Log: documentation update Modified: trunk/doc/chapters/intro.texinfo ============================================================================== --- trunk/doc/chapters/intro.texinfo (original) +++ trunk/doc/chapters/intro.texinfo Wed Apr 2 02:15:27 2008 @@ -25,9 +25,9 @@ Lisplets are web resource containers that hold web pages and other resource files, such as javascript, image, css, etc. files, 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. +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 pack to the browser if found. +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. From achiumenti at common-lisp.net Wed Apr 9 09:26:03 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 05:26:03 -0400 (EDT) Subject: [claw-cvs] r27 - in trunk/main/claw-core: src tests Message-ID: <20080409092603.07C581F009@common-lisp.net> Author: achiumenti Date: Wed Apr 9 05:26:01 2008 New Revision: 27 Modified: trunk/main/claw-core/src/misc.lisp trunk/main/claw-core/src/packages.lisp trunk/main/claw-core/src/tags.lisp trunk/main/claw-core/tests/test1.lisp Log: corrected json requests and init script injection that will be evaluate on document load Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Wed Apr 9 05:26:01 2008 @@ -144,6 +144,13 @@ (t (push element result)))) (nreverse result))) +(defun msie-p (&optional (request *request*)) + "Returns nil when the calling browser is not the evil of MSIE" + (let* ((header-props (headers-in request)) + (user-agent (find :USER-AGENT header-props :test #'(lambda (member value) (eq member (car value)))))) + (when user-agent + (all-matches "MSIE" (string-upcase (cdr user-agent)))))) + (defmacro with-message (key &optional (default "") locale) (let ((current-lisplet (gensym)) (current-page (gensym)) Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Wed Apr 9 05:26:01 2008 @@ -46,6 +46,7 @@ :*clawserver-base-path* :*apache-http-port* :*apache-https-port* + :*empty-tags* ;:request-realm :request-id-table-map ;:dyna-id @@ -260,6 +261,7 @@ #-:hunchentoot-no-ssl :clawserver-ssl-certificate-file #-:hunchentoot-no-ssl :clawserver-ssl-privatekey-file #-:hunchentoot-no-ssl :clawserver-ssl-privatekey-password + :msie-p :clawserver-register-configuration :claw-require-authorization :configuration Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Wed Apr 9 05:26:01 2008 @@ -585,6 +585,16 @@ (page-format-raw page "~%" encoding)) (when content-type (page-format-raw page "~a~%" content-type))))) + +(defun json-validation-errors () + (let ((validation-errors (aux-request-value :validation-errors))) + (if validation-errors + (strings-to-jsarray + (loop for component-exceptions in validation-errors + collect (format "{~a:~a}"(car component-exceptions) + (strings-to-jsarray (loop for message in (cdr component-exceptions) + collect (prin1-to-string message)))))) + "null"))) (defmethod page-render ((page page)) (let ((body (page-content page)) @@ -603,7 +613,7 @@ (page-init page) (when jsonp (page-format-raw page "{components:{")) - (setf (page-can-print page) t) + ;;(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:\"") @@ -615,7 +625,9 @@ (let ((init-scripts (htbody-init-scripts-tag page))) (when init-scripts (htcomponent-render init-scripts page))) - (page-format-raw page "\"}")))))) + (page-format-raw page "\",errors:") + (page-format-raw page (json-validation-errors)) + (page-format-raw page "}")))))) (defmethod page-body-init-scripts ((page page)) (let ((js-body "")) @@ -651,14 +663,17 @@ (setf (htcomponent-body current-js) class-init-scripts) (push current-js tag-list))) (dolist (js-file (page-script-files page)) - (let ((current-js (script> :type "text/javascript" :src ""))) - (setf (getf (htcomponent-attributes current-js) :src) js-file) - (push current-js tag-list))) - + (if (typep js-file 'htcomponent) + (push js-file tag-list) + (let ((current-js (script> :type "text/javascript" :src ""))) + (setf (getf (htcomponent-attributes current-js) :src) js-file) + (push current-js tag-list)))) (dolist (css-file (page-stylesheet-files page)) - (let ((current-css (link> :rel "stylesheet" :type "text/css" :href ""))) - (setf (getf (htcomponent-attributes current-css) :href) css-file) - (push current-css tag-list))) + (if (typep css-file 'htcomponent) + (push css-file tag-list) + (let ((current-css (link> :rel "stylesheet" :type "text/css" :href ""))) + (setf (getf (htcomponent-attributes current-css) :href) css-file) + (push current-css tag-list)))) tag-list)) @@ -681,7 +696,7 @@ (let* ((page (htcomponent-page htcomponent)) (jsonp (page-json-id-list page)) (id (htcomponent-client-id htcomponent))) - (when (or jsonp + (when (and jsonp (member id jsonp :test #'string-equal)) (when (> (page-json-component-count page) 0) (page-format page ",")) @@ -692,7 +707,7 @@ (let* ((page (htcomponent-page htcomponent)) (jsonp (page-json-id-list page)) (id (htcomponent-client-id htcomponent))) - (when (or jsonp + (when (and jsonp (member id jsonp :test #'string-equal)) (page-format-raw page "\"")))) @@ -943,9 +958,21 @@ (htcomponent-json-print-end-component htbody)))) (defmethod htbody-init-scripts-tag ((page page)) - (let ((js (script> :type "text/javascript"))) - (setf (htcomponent-page js) page) - (setf (htcomponent-body js) (page-body-init-scripts page)) + (let ((js (script> :type "text/javascript")) + (js-start-directive (if (msie-p) + "window.attachEvent('onload', function(e) {" + "document.addEventListener('DOMContentLoaded', function(e) {")) + (js-end-directive (if (msie-p) + "});" + "}, false);")) + (page-body-init-scripts (page-body-init-scripts page))) + (setf (htcomponent-page js) page + (htcomponent-body js) (when page-body-init-scripts + (if (listp page-body-init-scripts) + (append (list js-start-directive) + page-body-init-scripts + (list js-end-directive)) + (list js-start-directive page-body-init-scripts js-end-directive)))) js)) ;;;========= WCOMPONENT =================================== Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Wed Apr 9 05:26:01 2008 @@ -163,6 +163,23 @@ (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)) + +(defmethod wcomponent-template ((msie-p msie-p)) + (let ((id (htcomponent-client-id msie-p))) + (p> :static-id id))) + +(defmethod htcomponent-instance-initscript ((msie-p msie-p)) + (let ((id (htcomponent-client-id msie-p))) + (format nil "document.getElementById('~a').innerHTML = '~a';" + id + (if (msie-p) + "The browser is MSIE" + "The browser is not MSIE")))) + (defclass info-page (page) ()) (defmethod page-content ((o info-page)) @@ -174,7 +191,8 @@ (loop for key-val in header-props collect (tr> (td> (format nil "~a" (car key-val)) - (td> (format nil "~a" (cdr key-val))))))))))) + (td> (format nil "~a" (cdr key-val)))))))) + (msie-p> :id "msie")))) (lisplet-register-page-location *test-lisplet* 'info-page "info.html") From achiumenti at common-lisp.net Wed Apr 9 12:24:29 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 08:24:29 -0400 (EDT) Subject: [claw-cvs] r28 - trunk/main/claw-core/src Message-ID: <20080409122429.0B79956220@common-lisp.net> Author: achiumenti Date: Wed Apr 9 08:24:28 2008 New Revision: 28 Modified: trunk/main/claw-core/src/misc.lisp Log: Corrected the registering lisplet function Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Wed Apr 9 08:24:28 2008 @@ -71,7 +71,7 @@ "Isert a new cons into a list of cons, or replace the one that has the same location registered (its car)." (let ((result (remove-by-location (car location-cons) cons-list))) - (setf result (push location-cons cons-list)))) + (setf result (push location-cons result)))) (defun lisplet-start-session () "Starts a session boud to the current lisplet base path" From achiumenti at common-lisp.net Wed Apr 9 13:16:34 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 09:16:34 -0400 (EDT) Subject: [claw-cvs] r29 - trunk/doc/chapters Message-ID: <20080409131634.9AD62111CD@common-lisp.net> Author: achiumenti Date: Wed Apr 9 09:16:31 2008 New Revision: 29 Added: trunk/doc/chapters/access.texinfo trunk/doc/chapters/advanced-components.texinfo trunk/doc/chapters/advanced-techniques.texinfo trunk/doc/chapters/forms.texinfo trunk/doc/chapters/getting-started.texinfo trunk/doc/chapters/i18n.texinfo trunk/doc/chapters/lisplets.texinfo trunk/doc/chapters/pages.texinfo trunk/doc/chapters/validation.texinfo trunk/doc/chapters/writing-components.texinfo Log: updating user manual Added: trunk/doc/chapters/access.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/access.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node login access + at comment node-name, next, previous, up + at chapter Access validation and authorization Added: trunk/doc/chapters/advanced-components.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/advanced-components.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node advanced components + at comment node-name, next, previous, up + at chapter Writing advanced components Added: trunk/doc/chapters/advanced-techniques.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/advanced-techniques.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node Advanced techniques + at comment node-name, next, previous, up + at chapter Advanced techniques Added: trunk/doc/chapters/forms.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/forms.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node forms + at comment node-name, next, previous, up + at chapter @value{claw} forms and form components Added: trunk/doc/chapters/getting-started.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/getting-started.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node Getting Started + at comment node-name, next, previous, up + at chapter Getting started with @value{claw} Added: trunk/doc/chapters/i18n.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/i18n.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node i18n + at comment node-name, next, previous, up + at chapter Internationalization of our application Added: trunk/doc/chapters/lisplets.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/lisplets.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,148 @@ + at node Lisplets + at comment node-name, next, previous, up + at chapter Lisplets + +Lisplets are @code{CLOS} objects that extend the functionalities of @code{CLAWSERVER}, dispatching requests that +come from this last one. + +Lisplets are so, the place where you put your web applications developed with @value{claw}. + +Lisplets return to the requesting user, pages, functions and resources mapped into them. + +Each Lisplet contains its own dispatch table and realm so that applications are not mixed together. + + at section Registering a lisplet into the server, crating a web application + +To create a web application you have to instantiate a @code{LISPLET} and then register it into the server. + at cartouche + at lisp +(defvar *clawserver* (make-instance 'clawserver :port 4242)) + +(defvar *test-lisplet* (make-instance 'lisplet :base-path "/test")) +(clawserver-register-lisplet *clawserver* *test-lisplet*) + +;;; you can now start the server +;;; with: +;;; (clawserver-start *clawserver*) +;;; and +;;; (clawserver-stop *clawserver*) + at end lisp + at end cartouche + +At this point you have defined a web application registered to the URL ``http://localhost:4242/test'' that + at value{claw} will be able to serve. + +All sessions and the authentication and authourization logic will be under the default realm ``claw'', +so if you register another lisplet into the server with the instruction: + at cartouche + at lisp +(defvar *test-lisplet2* (make-instance 'lisplet :base-path "/test2")) +(clawserver-register-lisplet *clawserver* *test-lisplet2*) + at end lisp + at end cartouche +any user session will be shared among @code{*test-lisplet*} and @code{*test-lisplet2*} and if a user is logged into +``/test'' application, he will be logged into ``/test2'' application too. + +To avoid this behaviour, you need to define a different realm for each of the two lisplet as the following example does: + at cartouche + at lisp +(defvar *clawserver* (make-instance 'clawserver :port 4242)) + +(defvar *test-lisplet* (make-instance 'lisplet :realm "test" + :base-path "/test")) +(clawserver-register-lisplet *clawserver* *test-lisplet*) + +(defvar *test-lisplet2* (make-instance 'lisplet :realm "test2" + :base-path "/test2")) +(clawserver-register-lisplet *clawserver* *test-lisplet2*) + at end lisp + at end cartouche + +The two lisplets will now have different realms, so a user session in @code{*test-lisplet*} will be +different from the one in @code{*test-lisplet2*}. So for the authentication and authorization module. +The same is for a user logged into the first application, he will not be automatically logged into the +other now. + + at section Adding resources into a @code{LISPLET} + +Lisplets alone don't do anything more then providing some error pages when something goes wrong. +To make a @code{LISPLET} a web application, you have to fill it with some application resource, and this +may be done in several ways. + + at 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: +``/opt/webresources/images/matrix.jpg''. + +This is made very simple with the following instructions + at cartouche + at lisp +(lisplet-register-resource-location *test-lisplet* + #P"/opt/webresources/images/matrix.jpg" + "images/matrix.jpg" "image/jpeg") + at end lisp + at 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. + +If you want to regiter an entire folder, the process is very similar + at cartouche + at lisp +(lisplet-register-resource-location *test-lisplet* + #P"/opt/webresources/images/" + "images2/") + at end lisp + at end cartouche + +Now you'll be able to access the same resource following the URL +``http://localhost:4242/test/images2/matrix.jpg'', easy, isn't it? + + at 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 +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: + at cartouche + at lisp +(lisplet-register-function-location *test-lisplet* + #'(lambda () + (let ((path #P"/opt/webresources/images/matrix.jpg")) + (setf (content-type) (mime-type path)) + (with-open-file (in path :element-type 'flex:octet) + (let ((image-data (make-array (file-length in) + :element-type 'flex:octet))) + (read-sequence image-data in) + image-data)))) + "images/matrix2.jpg" ) + at end lisp + at end cartouche +Now the image will be availbe at the URL ``http://localhost:4242/test/images/matrix2.jpg''. + +The method @code{lisplet-register-function-location} accepts two optional keys: + at itemize @minus + at item + at code{:WELCOME-PAGE-P} that +will redirect you to the registered location when you'll access your application with the URL +``http://localhost:4242/test'' + at item + at code{:LOGIN-PAGE-P} that will redirect an unregistered user to the resource when he tries to access +a protected resource to perform the login with a form based authentication. + at end itemize + + at subsection Adding pages to a @code{LISPLET} + +Pages are one of the key objects of @value{claw}, since they are sophisticated collectors of web components. +Pages are described in the next chapter, meanwhile to register a page that is a @code{CLOS} object, the procedure +is very similar to when you register a function. + at cartouche + at lisp +(defclass empty-page (page) ()) +(lisplet-register-page-location *test-lisplet* 'empty-page "index.html" :welcome-page-p t) + at end lisp + at 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. Added: trunk/doc/chapters/pages.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/pages.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node Pages + at comment node-name, next, previous, up + at chapter Web application pages Added: trunk/doc/chapters/validation.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/validation.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node validation + at comment node-name, next, previous, up + at chapter Input validation and field translations Added: trunk/doc/chapters/writing-components.texinfo ============================================================================== --- (empty file) +++ trunk/doc/chapters/writing-components.texinfo Wed Apr 9 09:16:31 2008 @@ -0,0 +1,3 @@ + at node writing components + at comment node-name, next, previous, up + at chapter Creating a web application by writing reusable components From achiumenti at common-lisp.net Wed Apr 9 13:17:03 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 09:17:03 -0400 (EDT) Subject: [claw-cvs] r30 - trunk/doc/chapters Message-ID: <20080409131703.510413001C@common-lisp.net> Author: achiumenti Date: Wed Apr 9 09:17:03 2008 New Revision: 30 Modified: trunk/doc/chapters/server.texinfo Log: updating user manual Modified: trunk/doc/chapters/server.texinfo ============================================================================== --- trunk/doc/chapters/server.texinfo (original) +++ trunk/doc/chapters/server.texinfo Wed Apr 9 09:17:03 2008 @@ -440,3 +440,15 @@ @value{claw} is now up and you can browse it with your browser using address http://www.yourcompany.com:4242 and http://www.yourcompany.com:4443. Of course you will have only a 404 response page! + + at subsection Making all applications to work under a common path + +You have the possibility to define a common path to mapp all @value{claw} applications registered into the server, +defining the global variable @code{*CLAWSERVER-BASE-PATH*}. This way, if you have two applcations mapped for example to +``/applicationA'' and ``/applicationB'', setting that variable to the common path ``/yourcompany'' with the instruction + at cartouche + at lisp +(setf *clawserver-base-path* "/yourcompany") + at end lisp + at end cartouche +you will have the two applications now mapped to ``/yourcompany/applicationA'' and ``/yourcompany/applicationB''. From achiumenti at common-lisp.net Wed Apr 9 13:17:29 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 09:17:29 -0400 (EDT) Subject: [claw-cvs] r31 - trunk/doc/chapters Message-ID: <20080409131729.341903001C@common-lisp.net> Author: achiumenti Date: Wed Apr 9 09:17:29 2008 New Revision: 31 Modified: trunk/doc/chapters/intro.texinfo Log: updating user manual Modified: trunk/doc/chapters/intro.texinfo ============================================================================== --- trunk/doc/chapters/intro.texinfo (original) +++ trunk/doc/chapters/intro.texinfo Wed Apr 9 09:17:29 2008 @@ -10,6 +10,17 @@ @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 +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. + + at value{claw} comes with its own authentication systme that lets you create both basic and form based authentication systems. + + at value{claw} has the capability to force the page renderinig throught the protocol https of pages managing sensible data, using simple +directives. + + at value{claw} comes with its own extensible localization and validation system. + The main aim of @value{claw} is @cite{`divide et impera'}, that means that dividing problems into small problems let programmers work on different part of an application, creating ad hoc components for both generic and specific tasks. @@ -21,9 +32,9 @@ @subsection The request cycle -When a user asks for a page the request is sent to the woserver that dispatches the request to the registered lisplets. +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, 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 funcions, 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. From achiumenti at common-lisp.net Wed Apr 9 13:17:57 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 09:17:57 -0400 (EDT) Subject: [claw-cvs] r32 - in trunk/main/claw-core: src tests Message-ID: <20080409131757.87F723001C@common-lisp.net> Author: achiumenti Date: Wed Apr 9 09:17:57 2008 New Revision: 32 Modified: trunk/main/claw-core/src/tags.lisp trunk/main/claw-core/tests/test1.lisp Log: updating user manual Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Wed Apr 9 09:17:57 2008 @@ -1014,7 +1014,7 @@ (when (eq k :id) (setf id v)) (when (eq k :static-id) - (setf static-id v)))) + (setf static-id v)))) (when (and (eq id :required) (null static-id)) (error (format nil "Parameter id of class ~a is required" Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Wed Apr 9 09:17:57 2008 @@ -55,12 +55,12 @@ ));:message-dispatcher *lisplet-messages*)) (defvar *test-lisplet2*) -(setf *test-lisplet2* (make-instance 'lisplet :realm "test2" :base-path "/test2" - ));:message-dispatcher *lisplet-messages*)) +(setf *test-lisplet2* (make-instance 'lisplet :realm "test2" + :base-path "/test2")) ;;(defparameter *clawserver* (make-instance 'clawserver :port 4242)) -(defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445 +(defvar *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445 :mod-lisp-p nil :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem")) @@ -205,14 +205,12 @@ (lisplet-register-function-location *test-lisplet* #'(lambda () (let ((path (test-image-file))) - (progn - (setf (content-type) (mime-type path)) - (load-time-value - (with-open-file (in (test-image-file) :element-type 'flex:octet) - (let ((image-data (make-array (file-length in) - :element-type 'flex:octet))) - (read-sequence image-data in) - image-data)))))) + (setf (content-type) (mime-type path)) + (with-open-file (in path :element-type 'flex:octet) + (let ((image-data (make-array (file-length in) + :element-type 'flex:octet))) + (read-sequence image-data in) + image-data)))) "images/matrix2.jpg" ) ;;;--------------------realm test page-------------------------------- (defclass realm-page (page) ()) From achiumenti at common-lisp.net Wed Apr 9 17:59:03 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 13:59:03 -0400 (EDT) Subject: [claw-cvs] r33 - trunk/main/claw-core/tests Message-ID: <20080409175903.08B247C04D@common-lisp.net> Author: achiumenti Date: Wed Apr 9 13:59:03 2008 New Revision: 33 Modified: trunk/main/claw-core/tests/test1.lisp Log: clutter removing Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Wed Apr 9 13:59:03 2008 @@ -115,7 +115,7 @@ (html> (head> (title> - (wcomponent-parameter-value o ':title)) + (wcomponent-parameter-value o :title)) (style> :type "text/css" "input.error { background-color: #FF9999; From achiumenti at common-lisp.net Wed Apr 9 17:59:58 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 13:59:58 -0400 (EDT) Subject: [claw-cvs] r34 - trunk/doc/chapters Message-ID: <20080409175958.8C76C7C04F@common-lisp.net> 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. + at cartouche + at 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)))) + at end lisp + at 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. - at value{claw} comes with its own authentication systme that lets you create both basic and form based authentication systems. + at value{claw} comes with its own authentication system that lets you create both basic and form based authentication systems. - at value{claw} has the capability to force the page renderinig throught the protocol https of pages managing sensible data, using simple + at 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. + + at 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 + at cartouche + at lisp +(lisplet-start-session) + at end lisp + at 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 + + at 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. + + at 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. + + at 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: + at cartouche + at lisp +(div> :class "foo") + at end lisp + at end cartouche + +Given this short intro we are now ready to write our first @value{claw} page: + at cartouche + at 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) + at end lisp + at 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. + + at subsection The special tag attribute: @code{:ID} and @code{:STATIC-ID} + + at 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: + at cartouche + at 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))))) + at end lisp + at end cartouche + +will produce the following HTML code + at cartouche + at example + at format + + + + + First sample page + + +
A
+
B
+
C
+
D
+ + + + at end format + at end example + at 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: + at cartouche + at 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")))))) + at end lisp + at end cartouche +that will produce the following HTML code: + at cartouche + at example + at format + + + + + First sample page + + +
+ A + + click me +
+
+ B + + click me +
+
+ C + + click me +
+
+ D + + click me +
+ + + + at end format + at end example + at 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*) From achiumenti at common-lisp.net Wed Apr 9 18:01:54 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 14:01:54 -0400 (EDT) Subject: [claw-cvs] r35 - trunk/doc Message-ID: <20080409180154.C07E175165@common-lisp.net> 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 + at include chapters/lisplets.texinfo + at include chapters/pages.texinfo + at include chapters/getting-started.texinfo + at include chapters/i18n.texinfo + at include chapters/forms.texinfo + at include chapters/validation.texinfo + at include chapters/writing-components.texinfo + at include chapters/advanced-components.texinfo + at include chapters/access.texinfo + at include chapters/advanced-techniques.texinfo @node Function index @unnumbered Function index From achiumenti at common-lisp.net Wed Apr 9 21:13:20 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Wed, 9 Apr 2008 17:13:20 -0400 (EDT) Subject: [claw-cvs] r36 - trunk/doc/chapters Message-ID: <20080409211320.9ECA915070@common-lisp.net> 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. + + at 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: + at itemize @minus + at item + at code{wcomponent-parameter-value} is used to retrieve a parameter passed to the constructor function. + at item + at code{wcomponent-informal-parameters} renders as an associative list of all the parameters not directly declared with the method + at code{wocomponent-parameters}, but that are present in the constructor function. + at item + at code{htcomponent-body} renders the body of the component + at end itemize + +So a call to the constructor function of our new fresh component might have this shape: + at cartouche + at lisp +(site-template> :title "this is the page title" :class "foo" + (p> + Hello world)) + at end lisp + at end cartouche + +and will render as + at cartouche + at example + at format + + + + this is the page title + + +

Hello world

+ + + + at end format + at end example + at 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... From achiumenti at common-lisp.net Thu Apr 10 06:09:03 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Thu, 10 Apr 2008 02:09:03 -0400 (EDT) Subject: [claw-cvs] r37 - in trunk/doc: . chapters Message-ID: <20080410060903.73142340CD@common-lisp.net> 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 - at chapter Getting started with @value{claw} + at 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. - at cartouche - at 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)))) - at end lisp - at 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. - - at 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: - at itemize @minus - at item - at code{wcomponent-parameter-value} is used to retrieve a parameter passed to the constructor function. - at item - at code{wcomponent-informal-parameters} renders as an associative list of all the parameters not directly declared with the method - at code{wocomponent-parameters}, but that are present in the constructor function. - at item - at code{htcomponent-body} renders the body of the component - at end itemize - -So a call to the constructor function of our new fresh component might have this shape: - at cartouche - at lisp -(site-template> :title "this is the page title" :class "foo" - (p> - Hello world)) - at end lisp - at end cartouche - -and will render as - at cartouche - at example - at format - - - - this is the page title - - -

Hello world

- - - - at end format - at end example - at 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. + at cartouche + at 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)))) + at end lisp + at 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. + + at 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: + at itemize @minus + at item + at code{wcomponent-parameter-value} is used to retrieve a parameter passed to the constructor function. + at item + at code{wcomponent-informal-parameters} renders as an associative list of all the parameters not directly declared with the method + at code{wocomponent-parameters}, but that are present in the constructor function. + at item + at code{htcomponent-body} renders the body of the component + at end itemize + +So a call to the constructor function of our new fresh component might have this shape: + at cartouche + at lisp +(site-template> :title "this is the page title" :class "foo" + (p> + Hello world)) + at end lisp + at end cartouche + +and will render as + at cartouche + at example + at format + + + + this is the page title + + +

Hello world

+ + + + at end format + at end example + at 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 - at include chapters/getting-started.texinfo - at include chapters/i18n.texinfo + at include chapters/writing-components.texinfo @include chapters/forms.texinfo @include chapters/validation.texinfo - at include chapters/writing-components.texinfo - at include chapters/advanced-components.texinfo + at include chapters/i18n.texinfo @include chapters/access.texinfo + at include chapters/getting-started.texinfo @include chapters/advanced-techniques.texinfo @node Function index From achiumenti at common-lisp.net Tue Apr 15 05:02:28 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Tue, 15 Apr 2008 01:02:28 -0400 (EDT) Subject: [claw-cvs] r38 - in trunk: doc/chapters main/claw-core/src Message-ID: <20080415050228.D4D5B2802C@common-lisp.net> 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: + + at cartouche + at 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))) + + at end lisp + at end cartouche + +Ok, now we can use our new inspector component inside our page: + + at cartouche + at 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")))))) + at end lisp + at 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)) From achiumenti at common-lisp.net Tue Apr 15 17:48:02 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Tue, 15 Apr 2008 13:48:02 -0400 (EDT) Subject: [claw-cvs] r39 - trunk/doc/chapters Message-ID: <20080415174802.F182D5D166@common-lisp.net> 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 - at code{wocomponent-parameters}, but that are present in the constructor function. + at code{wocomponent-parameters}, but are present in the constructor function, such as may be a @code{:CLASS} attribute. @item - at code{htcomponent-body} renders the body of the component + at 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 and the + + + at end format + at end example + at end cartouche From achiumenti at common-lisp.net Tue Apr 15 17:48:56 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Tue, 15 Apr 2008 13:48:56 -0400 (EDT) Subject: [claw-cvs] r40 - trunk/main/claw-core Message-ID: <20080415174856.D16C95D2AC@common-lisp.net> 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")))))) From achiumenti at common-lisp.net Tue Apr 15 17:49:17 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Tue, 15 Apr 2008 13:49:17 -0400 (EDT) Subject: [claw-cvs] r41 - trunk/main/claw-core/tests Message-ID: <20080415174917.03B4A5D175@common-lisp.net> 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") From achiumenti at common-lisp.net Sat Apr 26 15:05:45 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Sat, 26 Apr 2008 11:05:45 -0400 (EDT) Subject: [claw-cvs] r42 - in trunk/main/claw-core: . src tests Message-ID: <20080426150545.50DFF3001B@common-lisp.net> 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 and 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 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 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 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