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

[claw-cvs] r165 - trunk/doc/chapters
by Andrea Chiumenti 22 Dec '08

22 Dec '08

Author: achiumenti Date: Mon Dec 22 10:19:18 2008 New Revision: 165 Log: documentation spellcheck Modified: trunk/doc/chapters/claw-html.texinfo trunk/doc/chapters/server.texinfo Modified: trunk/doc/chapters/claw-html.texinfo ============================================================================== --- trunk/doc/chapters/claw-html.texinfo (original) +++ trunk/doc/chapters/claw-html.texinfo Mon Dec 22 10:19:18 2008 @@ -298,7 +298,7 @@ @end smalllisp @sp 2 -So now that the site template component is ready for our simple example you can now use it into your previous page; do change +So now that the site template component is ready for our simple example you can now use it with your previous page; do change the page-content method definition in the @code{src/index.lisp} file: @sp 2 Modified: trunk/doc/chapters/server.texinfo ============================================================================== --- trunk/doc/chapters/server.texinfo (original) +++ trunk/doc/chapters/server.texinfo Mon Dec 22 10:19:18 2008 @@ -322,7 +322,7 @@ @end smalllisp @sp 2 -A difference from a local and a system wide resource is that @code{REGISTER-LIBRARY-RESOURCE} registers the resource at the application server level +One difference from a local and a system wide resource is that @code{REGISTER-LIBRARY-RESOURCE} registers the resource at the application server level and not at the lisplet level. This implies that the resource in your example is available at the following url @indicateurl{http://localhost:4242/claw/tempdir/hunchentoot.log} to clarify.

1 0

[claw-cvs] r164 - in trunk: doc/chapters main/claw-as/src main/claw-demo/src/backend main/claw-demo/src/frontend main/connectors/claw-hunchentoot-connector/src
by Andrea Chiumenti 22 Dec '08

22 Dec '08

Author: achiumenti Date: Mon Dec 22 10:04:53 2008 New Revision: 164 Log: clawserver -> claw-server Modified: trunk/doc/chapters/claw-html.texinfo trunk/doc/chapters/server.texinfo trunk/main/claw-as/src/auth.lisp trunk/main/claw-as/src/lisplet.lisp trunk/main/claw-as/src/logger.lisp trunk/main/claw-as/src/misc.lisp trunk/main/claw-as/src/packages.lisp trunk/main/claw-as/src/server.lisp trunk/main/claw-as/src/session-manager.lisp trunk/main/claw-demo/src/backend/dao.lisp trunk/main/claw-demo/src/frontend/main.lisp trunk/main/connectors/claw-hunchentoot-connector/src/hunchentoot.lisp Modified: trunk/doc/chapters/claw-html.texinfo ============================================================================== --- trunk/doc/chapters/claw-html.texinfo (original) +++ trunk/doc/chapters/claw-html.texinfo Mon Dec 22 10:04:53 2008 @@ -99,13 +99,13 @@ (defvar *ht-log-manager* (make-instance 'hunchentoot-logger)) -(defvar *the-server* (make-instance 'clawserver +(defvar *the-server* (make-instance 'claw-server :connector *ht-connector* :log-manager *ht-log-manager* :session-manager *sm* :base-path "/claw")) -(clawserver-register-lisplet *the-server* *fs-lisplet*) +(claw-server-register-lisplet *the-server* *fs-lisplet*) (defclass demo-configuration (configuration) ((users :reader users @@ -124,7 +124,7 @@ :name user :roles (third maybe-principal)))))) -(clawserver-register-configuration +(claw-server-register-configuration *the-server* *fs-realm* (make-instance 'demo-configuration)) ;;registering lisplet static resources @@ -135,10 +135,10 @@ "docroot/")) (defun clhtml-sample1-start () - (clawserver-start *the-server*)) + (claw-server-start *the-server*)) (defun clhtml-sample1-stop () - (clawserver-stop *the-server*)) + (claw-server-stop *the-server*)) @end smalllisp @sp 2 Modified: trunk/doc/chapters/server.texinfo ============================================================================== --- trunk/doc/chapters/server.texinfo (original) +++ trunk/doc/chapters/server.texinfo Mon Dec 22 10:04:53 2008 @@ -16,7 +16,7 @@ dispatch HTTP and HTTPS request and log messages through @code{CONNECTOR} and @code{LOGGER} implementations that are @code{CLAW-SERVICE} implementations. -A minimal server configuration needs an connector, a @code{SESSION-MANAGER} (another @code{CLAW-SERVICE} that handles users sessions) and a log manager to logs server messages. +A minimal server configuration needs an connector, a @code{SESSION-MANAGER} (another @code{CLAW-SERVICE} that handles user sessions) and a log manager to logs server messages. Currently @value{claw} application server uses a connector to Hunchentoot (see: @url{http://www.weitz.de/hunchentoot/, unchentoot}), a wonderful as powerful web server written in Common Lisp. @@ -47,7 +47,7 @@ @end smalllisp @sp 2 -You then have to instantiate a session manager service that will handle users sessions. +You then have to instantiate a session manager service that will handle user sessions. @sp 2 @smalllisp @@ -59,7 +59,7 @@ @sp 2 @smalllisp -(defvar *demo-server* (make-instance 'clawserver +(defvar *demo-server* (make-instance 'claw-server :connector *ht-connector* :log-manager *ht-log-manager* :session-manager *sm* @@ -75,7 +75,7 @@ @sp 2 @smalllisp -(clawserver-start *demo-server*) +(claw-server-start *demo-server*) @end smalllisp @sp 2 @@ -87,7 +87,7 @@ @sp 2 @smalllisp -(clawserver-stop *demo-server*) +(claw-server-stop *demo-server*) @end smalllisp @sp 2 @@ -96,7 +96,7 @@ @value{claw} has the notion of lisplets, components similar to java servlets, but written in Common Lisp. As the name suggests, a lisplet is defined by the @code{LISPLET} class. A lisplet is an envelop for your application, so -@code{CLAWSERVER}, being an application server, may hold more then one web application, each sharing or protecting its realm with +@code{claw-server}, being an application server, may hold more then one web application, each sharing or protecting its realm with other web applications. This means that an application may or may not share user sessions among the others, configuring its own realm. A lisplet contains all the resources (dynamic pages, static files, and services) that your application may need. @@ -104,7 +104,7 @@ Registering a @code{LISPLET} into the application server is very easy, in fact you only need to instantiate a LISPLET object with its proper realm defined, and tell the server to register it. The default realm for a lisplet is @code{"claw"}, if not defined differently during its creation; when two or more lisplets share the same realm, -they will share users sessions too. +they will share user sessions too. @sp 2 @smalllisp @@ -181,7 +181,7 @@ @sp 2 @smalllisp -(clawserver-register-lisplet *demo-server* *sample-lisplet*) +(claw-server-register-lisplet *demo-server* *sample-lisplet*) @end smalllisp @sp 2 @@ -211,7 +211,7 @@ (defvar *sm* (make-instance 'default-session-manager)) -(defvar *demo-server* (make-instance 'clawserver +(defvar *demo-server* (make-instance 'claw-server :connector *ht-connector* :log-manager *ht-log-manager* :session-manager *sm* @@ -249,9 +249,9 @@ </html>") "info.do") -(clawserver-register-lisplet *demo-server* *sample-lisplet*) +(claw-server-register-lisplet *demo-server* *sample-lisplet*) -(clawserver-start *demo-server*) +(claw-server-start *demo-server*) @end smalllisp @sp 2 @@ -275,8 +275,7 @@ Now you can see the server log file pointing you browser to the following url @indicateurl{http://localhost:4242/claw/demo/docroot/hunchentoot.log}. -Notice that you can add and remove resources to a lisplet while this is already running, that it's a great feature that may speed up project development and also let you to create -dynamic sites like @url{http://en.wikipedia.org/wiki/Content_management_system, CMS}. +Note that you can add and remove resources to a running lisplet, which speeds up project development and is particularly suited to dynamic sites like a @url{http://en.wikipedia.org/wiki/Content_management_system, CMS}. You could also register the single ``/tmp/hunchentoot.log'' file into your lisplet, this would protect other resources making them inaccessible by the users of you application. @@ -369,13 +368,13 @@ @sp 2 @smalllisp -(clawserver-register-configuration *demo-server* "demo" (make-instance 'demo-configuration)) +(claw-server-register-configuration *demo-server* "demo" (make-instance 'demo-configuration)) @end smalllisp @sp 2 For your example, the @code{*SAMPLE-LISPLET*} lisplet instance has been registered into the @code{"demo"} realm. This means that authentication is performed for a configuration that matches the same realm. For this reason the code -above sets the second parameter of the @code{CLAWSERVER-REGISTER-CONFIGURATION} to @code{"demo"}. +above sets the second parameter of the @code{claw-server-REGISTER-CONFIGURATION} to @code{"demo"}. The @code{*claw-current-lisplet*} is a locally scoped variable that the application server sets while it's performing the request dispatching. @@ -448,7 +447,7 @@ (defvar *sm* (make-instance 'default-session-manager)) -(defvar *demo-server* (make-instance 'clawserver +(defvar *demo-server* (make-instance 'claw-server :connector *ht-connector* :log-manager *ht-log-manager* :session-manager *sm* @@ -487,9 +486,9 @@ </html>") "info.do") -(clawserver-register-lisplet *demo-server* *sample-lisplet*) +(claw-server-register-lisplet *demo-server* *sample-lisplet*) -(clawserver-start *demo-server*) +(claw-server-start *demo-server*) (lisplet-register-resource-location *sample-lisplet* #P"/tmp/" @@ -525,7 +524,7 @@ :name user :roles (third maybe-principal))))))) -(clawserver-register-configuration *demo-server* "demo" (make-instance 'demo-configuration)) +(claw-server-register-configuration *demo-server* "demo" (make-instance 'demo-configuration)) (lisplet-register-function-location *sample-lisplet* @@ -622,7 +621,7 @@ (defvar *sm* (make-instance 'default-session-manager)) -(defvar *demo-server* (make-instance 'clawserver +(defvar *demo-server* (make-instance 'claw-server :connector *ht-connector* :log-manager *ht-log-manager* :session-manager *sm* @@ -661,9 +660,9 @@ </html>") "info.do") -(clawserver-register-lisplet *demo-server* *sample-lisplet*) +(claw-server-register-lisplet *demo-server* *sample-lisplet*) -(clawserver-start *demo-server*) +(claw-server-start *demo-server*) (lisplet-register-resource-location *sample-lisplet* #P"/tmp/" @@ -699,7 +698,7 @@ :name user :roles (third maybe-principal))))))) -(clawserver-register-configuration *demo-server* "demo" (make-instance 'demo-configuration)) +(claw-server-register-configuration *demo-server* "demo" (make-instance 'demo-configuration)) (lisplet-register-function-location *sample-lisplet* Modified: trunk/main/claw-as/src/auth.lisp ============================================================================== --- trunk/main/claw-as/src/auth.lisp (original) +++ trunk/main/claw-as/src/auth.lisp Mon Dec 22 10:04:53 2008 @@ -56,6 +56,6 @@ (defun login () "Performs user authentication for the reaml where the request has been created" - (let* ((login-config (gethash *claw-current-realm* (clawserver-login-config *clawserver*)))) + (let* ((login-config (gethash *claw-current-realm* (claw-server-login-config *claw-server*)))) (when (and login-config (null (current-principal))) (setf (current-principal) (configuration-login login-config))))) \ No newline at end of file Modified: trunk/main/claw-as/src/lisplet.lisp ============================================================================== --- trunk/main/claw-as/src/lisplet.lisp (original) +++ trunk/main/claw-as/src/lisplet.lisp Mon Dec 22 10:04:53 2008 @@ -29,14 +29,14 @@ (in-package :claw-as) -(defgeneric clawserver-register-lisplet (clawserver lisplet) +(defgeneric claw-server-register-lisplet (claw-server lisplet) (:documentation "This method registers a lisplet for request dispatching -- CLAWSERVER the CLAWSERVER instance +- claw-server the claw-server instance - LISPLET the LISPLET instance")) -(defgeneric clawserver-unregister-lisplet (clawserver lisplet) +(defgeneric claw-server-unregister-lisplet (claw-server lisplet) (:documentation "This method unregisters a lisplet from request dispatching -- CLAWSERVER the CLAWSERVER instance +- claw-server the claw-server instance - LISPLET the LISPLET instance")) (defgeneric lisplet-register-function-location (lisplet function location &key welcome-page-p login-page-p) @@ -119,22 +119,22 @@ :login-page nil :realm "claw" :redirect-protected-resources-p nil) - (:documentation "A lisplet is a container for resources provided trhough the clawserver. + (:documentation "A lisplet is a container for resources provided trhough the claw-server. It is similar, for purposes, to a JAVA servlet")) -(defmethod clawserver-register-lisplet ((clawserver clawserver) (lisplet lisplet)) - (let ((lisplets (clawserver-lisplets clawserver)) +(defmethod claw-server-register-lisplet ((claw-server claw-server) (lisplet lisplet)) + (let ((lisplets (claw-server-lisplets claw-server)) (location (lisplet-base-path lisplet))) (unless (string= "/" (subseq location 0 1)) (setf location (concatenate 'string "/" location))) - (setf (lisplet-server-address lisplet) (clawserver-address clawserver) - (clawserver-lisplets clawserver) (sort-by-location (pushnew-location + (setf (lisplet-server-address lisplet) (claw-server-address claw-server) + (claw-server-lisplets claw-server) (sort-by-location (pushnew-location (cons location lisplet) lisplets))))) -(defmethod clawserver-unregister-lisplet ((clawserver clawserver) (lisplet lisplet)) - (let ((lisplets (clawserver-lisplets clawserver)) +(defmethod claw-server-unregister-lisplet ((claw-server claw-server) (lisplet lisplet)) + (let ((lisplets (claw-server-lisplets claw-server)) (location (lisplet-base-path lisplet))) (unless (string= "/" (subseq location 0 1)) (setf location (concatenate 'string "/" location))) @@ -143,7 +143,7 @@ (defmethod build-lisplet-location ((lisplet lisplet)) "Constructs a full path prepending the lisplet base path to the given location" - (format nil "~a~a" (clawserver-base-path *clawserver*) (lisplet-base-path lisplet))) + (format nil "~a~a" (claw-server-base-path *claw-server*) (lisplet-base-path lisplet))) (defmethod lisplet-authentication-type ((lisplet lisplet)) (if (lisplet-login-page lisplet) @@ -172,7 +172,7 @@ #'(lambda () (let ((resource-full-path (merge-pathnames (uri-to-pathname (subseq (claw-script-name) - (+ (length (clawserver-base-path *clawserver*)) + (+ (length (claw-server-base-path *claw-server*)) (length (lisplet-base-path lisplet)) (length location) ))) resource-path))) @@ -204,15 +204,15 @@ (when (= (claw-return-code) +http-ok+) (if (and welcome-page (or (string= uri base-path) (string= uri (concatenate 'string base-path "/")))) (let* ((protocol (if (= (claw-server-port) - (connector-port (clawserver-connector *clawserver*))) + (connector-port (claw-server-connector *claw-server*))) :http :https)) (port (if (equal protocol :http) (if (claw-proxified-p) - (clawserver-proxy-http-port *clawserver*) + (claw-server-proxy-http-port *claw-server*) (claw-server-port)) (if (claw-proxified-p) - (clawserver-proxy-https-port *clawserver*) + (claw-server-proxy-https-port *claw-server*) (claw-server-port))))) (claw-redirect (format nil "~a~a" uri (if (ends-with-subseq "/" uri) (subseq welcome-page 1) @@ -230,10 +230,10 @@ (defun redirect-to-https (&optional uri) "Redirects a request sent through http using https" - (let* ((connector (clawserver-connector *clawserver*)) + (let* ((connector (claw-server-connector *claw-server*)) (path (or uri (claw-request-uri))) (sslport (and (connector-sslport connector) (if (claw-proxified-p) - (clawserver-proxy-https-port *clawserver*) + (claw-server-proxy-https-port *claw-server*) (connector-sslport connector))))) (claw-redirect path :host (claw-host-name) :port (or sslport (connector-port connector)) :protocol (if sslport @@ -241,7 +241,7 @@ :http)))) (defmethod lisplet-check-authorization ((lisplet lisplet)) - (let* ((connector (clawserver-connector *clawserver*)) + (let* ((connector (claw-server-connector *claw-server*)) (uri (claw-script-name)) (base-path (build-lisplet-location lisplet)) (protected-resources (lisplet-protected-resources lisplet)) Modified: trunk/main/claw-as/src/logger.lisp ============================================================================== --- trunk/main/claw-as/src/logger.lisp (original) +++ trunk/main/claw-as/src/logger.lisp Mon Dec 22 10:04:53 2008 @@ -46,7 +46,7 @@ "Logs a message. log-level should be one of the keywords :EMERG, :ALERT, :CRIT, :ERROR, :WARNING, :NOTICE, :INFO, or :DEBUG which correspond to the various Apache log levels. Form the rest this method behaves like the FORMAT function." - (apply #'logger-log (clawserver-log-manager *clawserver*) + (apply #'logger-log (claw-server-log-manager *claw-server*) level control-string args)) \ No newline at end of file Modified: trunk/main/claw-as/src/misc.lisp ============================================================================== --- trunk/main/claw-as/src/misc.lisp (original) +++ trunk/main/claw-as/src/misc.lisp Mon Dec 22 10:04:53 2008 @@ -34,11 +34,11 @@ (eval-when (:compile-toplevel :execute :load-toplevel) - (defvar *clawserver* nil - "The current serving CLAWSERVER instance") + (defvar *claw-server* nil + "The current serving claw-server instance") (defvar *session-manager* nil - "The SESSION-MANAGER used by the *CLAWSERVER*") + "The SESSION-MANAGER used by the *claw-server*") (defvar *apache-http-port* 80 "Default apache http port when claw is running in mod_lisp mode, or behind mod_proxy") @@ -151,202 +151,202 @@ ;;-------------------------------------------------------------------------------------------- (defun claw-request-method () - "Wrapper function around CLAWSERVER-REQUEST-METHOD. + "Wrapper function around claw-server-REQUEST-METHOD. Returns :GET or POST. respectively." - (clawserver-request-method *clawserver*)) + (claw-server-request-method *claw-server*)) (defun claw-script-name () - "Wrapper function around CLAWSERVER-SCRIPT-NAME. + "Wrapper function around claw-server-SCRIPT-NAME. Returns the file name \(or path) component of the URI for request \(before the question mark)," - (clawserver-script-name *clawserver*)) + (claw-server-script-name *claw-server*)) (defun claw-request-uri () - "Wrapper function around CLAWSERVER-REQUEST-URI. + "Wrapper function around claw-server-REQUEST-URI. Returns the URI for request." - (clawserver-request-uri *clawserver*)) + (claw-server-request-uri *claw-server*)) (defun claw-query-string () - "Wrapper function around CLAWSERVER-QUERY-STRING. + "Wrapper function around claw-server-QUERY-STRING. Returns the query component of the URI for request \(the part behing the question mark)" - (clawserver-query-string *clawserver*)) + (claw-server-query-string *claw-server*)) (defun claw-get-parameter (name) - "Wrapper function around CLAWSERVER-GET-PARAMETER. + "Wrapper function around claw-server-GET-PARAMETER. Returns the value of the GET parameter as a string \(or nil), identified by NAME \(a string too)" - (clawserver-get-parameter *clawserver* name)) + (claw-server-get-parameter *claw-server* name)) (defun claw-get-parameters () - "Wrapper function around CLAWSERVER-GET-PARAMETERS. + "Wrapper function around claw-server-GET-PARAMETERS. Returns an alist of all GET parameters." - (clawserver-get-parameters *clawserver*)) + (claw-server-get-parameters *claw-server*)) (defun claw-post-parameter (name) - "Wrapper function around CLAWSERVER-POST-PARAMETER. + "Wrapper function around claw-server-POST-PARAMETER. Returns the value of the POST parameter as a string \(or nil), identified by NAME \(a string too)" - (clawserver-post-parameter *clawserver* name)) + (claw-server-post-parameter *claw-server* name)) (defun claw-post-parameters () - "Wrapper function around CLAWSERVER-POST-PARAMETERS. + "Wrapper function around claw-server-POST-PARAMETERS. Returns an alist of all POST parameters." - (clawserver-post-parameters *clawserver*)) + (claw-server-post-parameters *claw-server*)) (defun claw-parameter (name) - "Wrapper function around CLAWSERVER-PARAMETER. + "Wrapper function around claw-server-PARAMETER. Returns the value of the GET or POST parameter as a string \(or nil), identified by NAME \(a string too)" - (clawserver-parameter *clawserver* name)) + (claw-server-parameter *claw-server* name)) (defun claw-header-in (symbol) - "Wrapper function around CLAWSERVER-HEADER-IN. + "Wrapper function around claw-server-HEADER-IN. Returns the incoming header named by the keyword SYMBOL, as a string." - (clawserver-header-in *clawserver* symbol)) + (claw-server-header-in *claw-server* symbol)) (defun claw-headers-in () - "Wrapper function around CLAWSERVER-HEADERS-IN." - (clawserver-headers-in *clawserver*)) + "Wrapper function around claw-server-HEADERS-IN." + (claw-server-headers-in *claw-server*)) (defun claw-authorization () - "Wrapper function around CLAWSERVER-AUTHORIZATION. + "Wrapper function around claw-server-AUTHORIZATION. Returns as two values the user and password \(if any) from the incoming Authorization http header." - (clawserver-authorization *clawserver*)) + (claw-server-authorization *claw-server*)) (defun claw-remote-addr () - "Wrapper function around CLAWSERVER-REMOTE-ADDR. + "Wrapper function around claw-server-REMOTE-ADDR. Returns the IP address \(as a string) of the client which sent the request." - (clawserver-remote-addr *clawserver*)) + (claw-server-remote-addr *claw-server*)) (defun claw-remote-port () - "Wrapper function around CLAWSERVER-REMOTE-PORT. + "Wrapper function around claw-server-REMOTE-PORT. Returns the IP port \(as a number) of the client which sent the request." - (clawserver-remote-port *clawserver*)) + (claw-server-remote-port *claw-server*)) (defun claw-real-remote-addr () - "Wrapper function around CLAWSERVER-REAL-REMOTE-ADDR see it for more info." - (clawserver-real-remote-addr *clawserver*)) + "Wrapper function around claw-server-REAL-REMOTE-ADDR see it for more info." + (claw-server-real-remote-addr *claw-server*)) (defun claw-server-addr () - "Wrapper function around CLAWSERVER-SERVER-ADDR. + "Wrapper function around claw-server-SERVER-ADDR. Returns the IP address \(as a string) where the request came in." - (clawserver-server-addr *clawserver*)) + (claw-server-server-addr *claw-server*)) (defun claw-server-port () - "Wrapper function around CLAWSERVER-SERVER-PORT. + "Wrapper function around claw-server-SERVER-PORT. Returns the IP port \(as a number) where the request came in." - (clawserver-server-port *clawserver*)) + (claw-server-server-port *claw-server*)) (defun claw-user-agent () - "Wrapper function around CLAWSERVER-USER-AGENT. + "Wrapper function around claw-server-USER-AGENT. Returns the value of the incoming User-Agent http header." - (clawserver-user-agent *clawserver*)) + (claw-server-user-agent *claw-server*)) (defun claw-referer () - "Wrapper function around CLAWSERVER-REFERER see it for more info." - (clawserver-referer *clawserver*)) + "Wrapper function around claw-server-REFERER see it for more info." + (claw-server-referer *claw-server*)) (defun claw-cookie-in (name) - "Wrapper function around CLAWSERVER-COOKIE-IN. + "Wrapper function around claw-server-COOKIE-IN. Returns the value \(a CLAW-COOKIE instance or nil) of the incoming cookie named by the string NAME." - (clawserver-cookie-in *clawserver* name)) + (claw-server-cookie-in *claw-server* name)) (defun claw-cookies-in () - "Wrapper function around CLAWSERVER-COOKIES-IN. + "Wrapper function around claw-server-COOKIES-IN. Returns the value \(as CLAW-COOKIE instance) of the incoming cookies." - (clawserver-cookies-in *clawserver*)) + (claw-server-cookies-in *claw-server*)) (defun claw-aux-request-value (symbol) - "Wrapper function around CLAWSERVER-AUX-REQUEST-VALUE. + "Wrapper function around claw-server-AUX-REQUEST-VALUE. Returns values VALUE, PRESENTP. This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request. present-p is true if such data was found, otherwise NIL" - (clawserver-aux-request-value *clawserver* symbol)) + (claw-server-aux-request-value *claw-server* symbol)) (defun (setf claw-aux-request-value) (value symbol) - "Wrapper function around (SETF CLAWSERVER-AUX-REQUEST-VALUE). + "Wrapper function around (SETF claw-server-AUX-REQUEST-VALUE). This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request." - (setf (clawserver-aux-request-value *clawserver* symbol) value)) + (setf (claw-server-aux-request-value *claw-server* symbol) value)) (defun claw-delete-aux-request-value (symbol) - "Wrapper function around CLAWSERVER-DELETE-AUX-REQUEST-VALUE. + "Wrapper function around claw-server-DELETE-AUX-REQUEST-VALUE. Completely removes any data associated with the symbol symbol from the REQUEST object request." - (clawserver-delete-aux-request-value *clawserver* symbol)) + (claw-server-delete-aux-request-value *claw-server* symbol)) (defun claw-content-type () "Returns the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\")." - (clawserver-content-type *clawserver*)) + (claw-server-content-type *claw-server*)) (defun (setf claw-content-type) (value) "Sets the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\")." - (setf (clawserver-content-type *clawserver*) value)) + (setf (claw-server-content-type *claw-server*) value)) (defun claw-content-length () "Returns the outgoing Content-Length http header" - (clawserver-content-length *clawserver*)) + (claw-server-content-length *claw-server*)) (defun (setf claw-content-length) (value) "Sets the outgoing Content-Length http header" - (setf (clawserver-content-length *clawserver*) value)) + (setf (claw-server-content-length *claw-server*) value)) ;;--------------------------- (defun claw-header-out (symbol) - "Wrapper function around CLAWSERVER-HEADER-OUT. + "Wrapper function around claw-server-HEADER-OUT. Returns the outgoing http header named by the keyword name if there is one, otherwise NIL." - (clawserver-header-out *clawserver* symbol)) + (claw-server-header-out *claw-server* symbol)) (defun (setf claw-header-out) (value symbol) - "Wrapper function around \(SETF CLAWSERVER-HEADER-OUT). + "Wrapper function around \(SETF claw-server-HEADER-OUT). SETF of HEADER-OUT changes the current value of the header named name \(name parameter must be a symbol). If no header named name exists it is created." - (setf (clawserver-header-out *clawserver* symbol) value)) + (setf (claw-server-header-out *claw-server* symbol) value)) (defun claw-headers-out () - "Wrapper function around CLAWSERVER-HEADERS-OUT. + "Wrapper function around claw-server-HEADERS-OUT. Returns an alist of all outgoing http parameters \(except for Set-Cookie, Content-Length, and Content-Type)." - (clawserver-headers-out *clawserver*)) + (claw-server-headers-out *claw-server*)) (defun claw-cookie-out (name) - "Wrapper function around CLAWSERVER-COOKIE-OUT. + "Wrapper function around claw-server-COOKIE-OUT. Returns the outgoing cookie named by the string name \(or NIL if there ain't no cookie with this name)." - (clawserver-cookie-out *clawserver* name)) + (claw-server-cookie-out *claw-server* name)) (defun (setf claw-cookie-out) (cookie-instance name) - "Wrapper function around \(SETF CLAWSERVER-COOKIE-OUT). + "Wrapper function around \(SETF claw-server-COOKIE-OUT). Creates a CLAW-COOKIE object from the parameters provided to this function and adds it to the outgoing cookies of the REPLY object reply." - (setf (clawserver-cookie-out *clawserver* name) cookie-instance)) + (setf (claw-server-cookie-out *claw-server* name) cookie-instance)) (defun claw-cookies-out () - "Wrapper function around CLAWSERVER-COOKIES-OUT. + "Wrapper function around claw-server-COOKIES-OUT. Returns the outgoing cookie named by the string name \(or NIL if there ain't no cookie with this name)." - (clawserver-cookies-out *clawserver*)) + (claw-server-cookies-out *claw-server*)) (defun claw-return-code () - "Wrapper function around CLAWSERVER-COOKIES-OUT. + "Wrapper function around claw-server-COOKIES-OUT. Returns the http return code of the reply. The return code of each REPLY object is initially set to 200 \(OK)" - (clawserver-return-code *clawserver*)) + (claw-server-return-code *claw-server*)) (defun (setf claw-return-code) (value) - "Wrapper function around \(SETF CLAWSERVER-COOKIES-OUT). + "Wrapper function around \(SETF claw-server-COOKIES-OUT). Sets the http return code of the reply." - (setf (clawserver-return-code *clawserver*) value)) + (setf (claw-server-return-code *claw-server*) value)) (defun claw-reply-external-format-encoding () - "Wrapper function around CLAWSERVER-REPLY-EXTERNAL-FORMAT-ENCODING. + "Wrapper function around claw-server-REPLY-EXTERNAL-FORMAT-ENCODING. Returns the symbol of the reply charset encoding \(Such as UTF-8)." - (clawserver-reply-external-format-encoding *clawserver*)) + (claw-server-reply-external-format-encoding *claw-server*)) (defun (setf claw-reply-external-format-encoding) (value) - "Wrapper function around (SETF CLAWSERVER-REPLY-EXTERNAL-FORMAT-ENCODING). + "Wrapper function around (SETF claw-server-REPLY-EXTERNAL-FORMAT-ENCODING). Sets the symbol of the reply charset encoding \(Such as UTF-8)." - (setf (clawserver-reply-external-format-encoding *clawserver*) value)) + (setf (claw-server-reply-external-format-encoding *claw-server*) value)) (defun claw-writer () - "Wrapper function around CLAWSERVER-WRITER. + "Wrapper function around claw-server-WRITER. Returns the output stream writer to generate replies. It's default to *standard-output*" - (clawserver-writer *clawserver*)) + (claw-server-writer *claw-server*)) (defun claw-redirect (target &key host port protocol add-session-id code) - "Wrapper function around CLAWSERVER-REDIRECT. + "Wrapper function around claw-server-REDIRECT. Sends back appropriate headers to redirect the client to target \(a string)." - (clawserver-redirect *clawserver* target + (claw-server-redirect *claw-server* target :host (or host (claw-host-name)) :port port :protocol protocol @@ -355,18 +355,18 @@ (defun claw-session-value (symbol) "Wrapper function around SESSION-MANAGER-SESSION-VALUE. Returns the value identified by SYMBOL, bounded to the user session." - (session-manager-session-value (clawserver-session-manager *clawserver*) symbol)) + (session-manager-session-value (claw-server-session-manager *claw-server*) symbol)) (defun (setf claw-session-value) (value symbol) "Wrapper function around (SETF SESSION-MANAGER-SESSION-VALUE). Sets or modifies the value identified by SYMBOL, bounded to the user session" - (setf (session-manager-session-value (clawserver-session-manager *clawserver*) symbol) value)) + (setf (session-manager-session-value (claw-server-session-manager *claw-server*) symbol) value)) (defun claw-delete-session-value (symbol) "Wrapper function around SESSION-MANAGER-DELETE-SESSION-VALUE. Deletes the value identified by SYMBOL, bounded to the user session. This is different from setting the value to null." - (session-manager-delete-session-value (clawserver-session-manager *clawserver*) symbol)) + (session-manager-delete-session-value (claw-server-session-manager *claw-server*) symbol)) ;;-------------------------------------------------------------------------------------------- ;;---------------------------------------- WRAPPERS --------------------------------------END ;;-------------------------------------------------------------------------------------------- @@ -399,14 +399,14 @@ (defun claw-start-session (&key max-time domain) "Starts a session bound to the current lisplet base path" - (session-manager-start-session (clawserver-session-manager *clawserver*) + (session-manager-start-session (claw-server-session-manager *claw-server*) :path (format nil "~a/" *root-path*) :max-time max-time :domain domain)) (defun claw-remove-session () "Disposes user session if present" - (session-manager-remove-session (clawserver-session-manager *clawserver*))) + (session-manager-remove-session (claw-server-session-manager *claw-server*))) (defun current-principal () "Returns the principal(user) that logged into the application" @@ -427,7 +427,7 @@ (defun current-config () "Returns the current configuration object for the realm of the request" - (gethash *claw-current-realm* (clawserver-login-config *clawserver*))) + (gethash *claw-current-realm* (claw-server-login-config *claw-server*))) (defun flatten (tree &optional result-list) "Traverses the tree in order, collecting even non-null leaves into a list." @@ -459,7 +459,7 @@ (deftype unsigned-byte-8 () '(unsigned-byte 8)) -(defun claw-handle-static-file (path &optional content-type (server *clawserver*)) +(defun claw-handle-static-file (path &optional content-type (server *claw-server*)) "A function which acts like a Hunchentoot handler for the file denoted by PATH. Send a content type header corresponding to CONTENT-TYPE or \(if that is NIL) tries to determine the content @@ -483,7 +483,7 @@ :if-does-not-exist nil) (setf (claw-header-out "Last-Modified") (rfc-1123-date time) (claw-content-length) (file-length file)) - (let ((out (clawserver-writer server))) + (let ((out (claw-server-writer server))) (loop with buf = (make-array +buffer-length+ :element-type 'unsigned-byte-8) for pos = (read-sequence buf file) until (zerop pos) @@ -496,7 +496,7 @@ (setf (claw-header-out "Last-Modified") (rfc-1123-date last-modified))) (setf (claw-content-length) (length content) (claw-content-type) content-type) - (let ((out (clawserver-writer *clawserver*))) + (let ((out (claw-server-writer *claw-server*))) (write-sequence content out) (finish-output out)) content)) @@ -512,7 +512,7 @@ #'(lambda () (let ((resource-full-path (merge-pathnames (uri-to-pathname (subseq (claw-script-name) - (+ (length (clawserver-base-path *clawserver*)) + (+ (length (claw-server-base-path *claw-server*)) (length location)))) resource-path))) (claw-handle-static-file resource-full-path content-type))) @@ -559,7 +559,7 @@ (defun claw-host-protocol () "Return :HTTP or :HTTPS depending on the header HOST parameter" (let ((port (parse-integer (second (split-sequence #\: (claw-header-in 'host))))) - (connector (clawserver-connector *clawserver*))) + (connector (claw-server-connector *claw-server*))) (if (= port (connector-port connector)) :http :https))) Modified: trunk/main/claw-as/src/packages.lisp ============================================================================== --- trunk/main/claw-as/src/packages.lisp (original) +++ trunk/main/claw-as/src/packages.lisp Mon Dec 22 10:04:53 2008 @@ -35,11 +35,11 @@ (:shadow :flatten) (:import-from :cl-fad :directory-pathname-p) (:documentation "A comprehensive web application framework and server for the Common Lisp programming language") - (:export #:*clawserver-base-path* + (:export #:*claw-server-base-path* #:*apache-http-port* #:*apache-https-port* #:*claw-default-server-address* - #:*clawserver* + #:*claw-server* #:*session-manager* #:*claw-current-lisplet* #:*claw-current-realm* @@ -163,20 +163,20 @@ #:claw-service-start #:claw-service-stop #:claw-service-running-p - ;; clawserver - #:clawserver - #:clawserver-start - #:clawserver-stop - - #:clawserver-dispatch-method - #:clawserver-log-manager - #:clawserver-add-service - #:clawserver-base-path - #:clawserver-register-lisplet - #:clawserver-unregister-lisplet - #:clawserver-login-config + ;; claw-server + #:claw-server + #:claw-server-start + #:claw-server-stop + + #:claw-server-dispatch-method + #:claw-server-log-manager + #:claw-server-add-service + #:claw-server-base-path + #:claw-server-register-lisplet + #:claw-server-unregister-lisplet + #:claw-server-login-config - #:clawserver-register-configuration + #:claw-server-register-configuration #:configuration #:configuration-login Modified: trunk/main/claw-as/src/server.lisp ============================================================================== --- trunk/main/claw-as/src/server.lisp (original) +++ trunk/main/claw-as/src/server.lisp Mon Dec 22 10:04:53 2008 @@ -30,37 +30,37 @@ (in-package :claw-as) ;;------------------------------------------------------------------------------------------ -(defgeneric error-renderer (clawserver &key error-code) +(defgeneric error-renderer (claw-server &key error-code) (:documentation "Method for rendering http errors. This method should be overridden.")) -(defgeneric clawserver-host (clawserver) +(defgeneric claw-server-host (claw-server) (:documentation " Returns the value of the incoming Host http header. \(This corresponds to the environment variable HTTP_HOST in CGI scripts.)")) -(defgeneric clawserver-request-method (clawserver) +(defgeneric claw-server-request-method (claw-server) (:documentation "Returns the request method as a keyword, i.e. something like :POST. \(This corresponds to the environment variable REQUEST_METHOD in CGI scripts.)")) -(defgeneric clawserver-request-uri (clawserver) +(defgeneric claw-server-request-uri (claw-server) (:documentation "Returns the URI for request. Note that this not the full URI but only the part behind the scheme and authority components, so that if the user has typed http://user:password@www.domain.com/xxx/frob.html?foo=bar into his browser, this function will return \"/xxx/frob.html?foo=bar\". \(This corresponds to the environment variable REQUEST_URI in CGI scripts.")) -(defgeneric clawserver-script-name (connector) +(defgeneric claw-server-script-name (connector) (:documentation "Returns the file name \(or path) component of the URI for request, i.e. the part of the string returned by REQUEST-URI in front of the first question mark \(if any). \(This corresponds to the environment variable SCRIPT_NAME in CGI scripts.)")) -(defgeneric clawserver-query-string (clawserver) +(defgeneric claw-server-query-string (claw-server) (:documentation "Returns the query component of the URI for request, i.e. the part of the string returned by REQUEST-URI behind the first question mark \(if any). -\(This corresponds to the environment variable QUERY_STRING in CGI scripts.) See also CLAWSERVER-GET-PARAMETER and CLAWSERVER-GET-PARAMETERS.")) +\(This corresponds to the environment variable QUERY_STRING in CGI scripts.) See also claw-server-GET-PARAMETER and claw-server-GET-PARAMETERS.")) -(defgeneric clawserver-get-parameter (clawserver name) +(defgeneric claw-server-get-parameter (claw-server name) (:documentation "Returns the value of the GET parameter \(as provided via the request URI) named by the string name as a string \(or NIL if there ain't no GET parameter with this name). -Note that only the first value will be returned if the client provided more than one GET parameter with the name name. See also CLAWSERVER-GET-PARAMETERS")) +Note that only the first value will be returned if the client provided more than one GET parameter with the name name. See also claw-server-GET-PARAMETERS")) -(defgeneric clawserver-get-parameters (clawserver) +(defgeneric claw-server-get-parameters (claw-server) (:documentation "Returns an alist of all GET parameters \(as provided via the request URI). The car of each element of this list is the parameter's name while the cdr is its value \(as a string). -The elements of this list are in the same order as they were within the request URI. See also CLAWSERVER-GET-PARAMETER.")) +The elements of this list are in the same order as they were within the request URI. See also claw-server-GET-PARAMETER.")) -(defgeneric clawserver-post-parameter (clawserver name) +(defgeneric claw-server-post-parameter (claw-server name) (:documentation "Returns the value of the POST parameter \(as provided in the request's body) named by the string name. Note that only the first value will be returned if the client provided more than one POST parameter with the name name. This value will usually be a string \(or NIL if there ain't no POST parameter with this name). @@ -71,242 +71,242 @@ where path is a pathname denoting the place were the uploaded file was stored, file-name \(a string) is the file name sent by the browser, and content-type \(also a string) is the content type sent by the browser. The file denoted by path will be deleted after the request has been handled - you have to move or copy it somewhere else if you want to keep it.")) -(defgeneric clawserver-post-parameters (clawserver) +(defgeneric claw-server-post-parameters (claw-server) (:documentation "Returns an alist of all POST parameters (as provided via the request's body). The car of each element of this list is the parameter's name while the cdr is its value. The elements of this list are in the same order as they were within the request's body. -See also CLAWSERVER-POST-PARAMETER.")) +See also claw-server-POST-PARAMETER.")) -(defgeneric clawserver-parameter (clawserver name) +(defgeneric claw-server-parameter (claw-server name) (:documentation "Returns the value of the GET or POST parameter named by the string name as a string \(or NIL if there ain't no parameter with this name). -If both a GET and a POST parameter with the name name exist, the GET parameter will be returned. See also CLAWSERVER-GET-PARAMETER and CLAWSERVER-POST-PARAMETER.")) +If both a GET and a POST parameter with the name name exist, the GET parameter will be returned. See also claw-server-GET-PARAMETER and claw-server-POST-PARAMETER.")) -(defgeneric clawserver-header-in (clawserver name) +(defgeneric claw-server-header-in (claw-server name) (:documentation "Returns the incoming header named by the keyword name as a string \(or NIL if there ain't no header with this name). Note that this queries the headers sent to Hunchentoot by the client or by mod_lisp. In the latter case this may not only include the incoming http headers but also some headers sent by mod_lisp. -For backwards compatibility, name can also be a string which is matched case-insensitively. See also CLAWSERVER-HEADERS-IN.")) +For backwards compatibility, name can also be a string which is matched case-insensitively. See also claw-server-HEADERS-IN.")) -(defgeneric clawserver-headers-in (clawserver) +(defgeneric claw-server-headers-in (claw-server) (:documentation "Returns an alist of all incoming headers. The car of each element of this list is the headers's name \(a Lisp keyword) while the cdr is its value (as a string). -There's no guarantee about the order of this list. See also CLAWSERVER-HEADER-IN and the remark about incoming headers there.")) +There's no guarantee about the order of this list. See also claw-server-HEADER-IN and the remark about incoming headers there.")) -(defgeneric clawserver-authorization (clawserver) +(defgeneric claw-server-authorization (claw-server) (:documentation "Returns as two values the user and password \(if any) from the incoming Authorization http header. Returns NIL if there is no such header.")) -(defgeneric clawserver-remote-addr (clawserver) - (:documentation "Returns the IP address \(as a string) of the client which sent the request. \(This corresponds to the environment variable REMOTE_ADDR in CGI scripts.) See also CLAWSERVER-REAL-REMOTE-ADDR.")) +(defgeneric claw-server-remote-addr (claw-server) + (:documentation "Returns the IP address \(as a string) of the client which sent the request. \(This corresponds to the environment variable REMOTE_ADDR in CGI scripts.) See also claw-server-REAL-REMOTE-ADDR.")) -(defgeneric clawserver-remote-port (clawserver) +(defgeneric claw-server-remote-port (claw-server) (:documentation "Returns the IP port (as a number) of the client which sent the request.")) -(defgeneric clawserver-real-remote-addr (clawserver) +(defgeneric claw-server-real-remote-addr (claw-server) (:documentation "Returns the value of the incoming X-Forwarded-For http header as the second value in the form of a list of IP addresses and the first element of this list as the first value if this header exists. -Otherwise returns the value of CLAWSERVER-REMOTE-ADDR as the only value.")) +Otherwise returns the value of claw-server-REMOTE-ADDR as the only value.")) -(defgeneric clawserver-server-addr (clawserver) +(defgeneric claw-server-server-addr (claw-server) (:documentation "Returns the IP address \(as a string) where the request came in. \(This corresponds to the environment variable SERVER_ADDR in CGI scripts.)")) -(defgeneric clawserver-server-port (clawserver) +(defgeneric claw-server-server-port (claw-server) (:documentation "Returns the IP port \(as a number) where the request came in.")) -(defgeneric clawserver-server-protocol (clawserver) +(defgeneric claw-server-server-protocol (claw-server) (:documentation "Returns the version of the http protocol which is used by the client as a Lisp keyword - this is usually either :HTTP/1.0 or :HTTP/1.1. \(This corresponds to the environment variable SERVER_PROTOCOL in CGI scripts.")) -(defgeneric clawserver-user-agent (clawserver) +(defgeneric claw-server-user-agent (claw-server) (:documentation "Returns the value of the incoming User-Agent http header. \(This corresponds to the environment variable HTTP_USER_AGENT in CGI scripts.)")) -(defgeneric clawserver-referer (clawserver) +(defgeneric claw-server-referer (claw-server) (:documentation "Returns the value of the incoming Referer \(sic!) http header. \(This corresponds to the environment variable HTTP_REFERER in CGI scripts.)")) -(defgeneric clawserver-cookie-in (clawserver name) +(defgeneric claw-server-cookie-in (claw-server name) (:documentation "Returns the value of the incoming cookie named by the string name \(or NIL if there ain't no cookie with this name). -See also CLAWSERVER-COOKIES-IN")) +See also claw-server-COOKIES-IN")) -(defgeneric clawserver-cookies-in (clawserver) +(defgeneric claw-server-cookies-in (claw-server) (:documentation "Returns an alist of all incoming cookies. -The car of each element of this list is the cookie's name while the cdr is the cookie's value. See also CLAWSERVER-COOKIE-IN")) +The car of each element of this list is the cookie's name while the cdr is the cookie's value. See also claw-server-COOKIE-IN")) -(defgeneric clawserver-aux-request-value (clawserver symbol) +(defgeneric claw-server-aux-request-value (claw-server symbol) (:documentation "This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request. present-p is true if such data was found, otherwise NIL")) -(defgeneric (setf clawserver-aux-request-value) (value clawserver symbol) +(defgeneric (setf claw-server-aux-request-value) (value claw-server symbol) (:documentation "This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request. present-p is true if such data was found, otherwise NIL")) -(defgeneric clawserver-delete-aux-request-value (clawserver symbol) +(defgeneric claw-server-delete-aux-request-value (claw-server symbol) (:documentation "Completely removes any data associated with the symbol symbol from the REQUEST object request. Note that this is different from using AUX-REQUEST-VALUE to set the data to NIL")) -(defgeneric clawserver-header-out (clawserver name) +(defgeneric claw-server-header-out (claw-server name) (:documentation "Returns the outgoing http header named by the keyword name if there is one, otherwise NIL \(name parameter must be a symbol). Note that the headers Set-Cookie, Content-Length, and Content-Type cannot be queried by HEADER-OUT. -See also CLAWSERVER-HEADERS-OUT, CLAWSERVER-CONTENT-TYPE, CLAWSERVER-CONTENT-LENGTH, CLAWSERVER-COOKIES-OUT, and CLAWSERVER-COOKIE-OUT")) +See also claw-server-HEADERS-OUT, claw-server-CONTENT-TYPE, claw-server-CONTENT-LENGTH, claw-server-COOKIES-OUT, and claw-server-COOKIE-OUT")) -(defgeneric (setf clawserver-header-out) (value clawserver name) +(defgeneric (setf claw-server-header-out) (value claw-server name) (:documentation "SETF of HEADER-OUT changes the current value of the header named name \(name parameter must be a symbol). If no header named name exists it is created. Note that the headers Set-Cookie, Content-Length, and Content-Type must not be set by SETF of HEADER-OUT. Also, there are a couple of \"technical\" headers like Connection or Transfer-Encoding that you're not supposed to set yourself. -See also CLAWSERVER-HEADERS-OUT, CLAWSERVER-CONTENT-TYPE, CLAWSERVER-CONTENT-LENGTH, CLAWSERVER-COOKIES-OUT, and CLAWSERVER-COOKIE-OUT")) +See also claw-server-HEADERS-OUT, claw-server-CONTENT-TYPE, claw-server-CONTENT-LENGTH, claw-server-COOKIES-OUT, and claw-server-COOKIE-OUT")) -(defgeneric clawserver-headers-out (clawserver) +(defgeneric claw-server-headers-out (claw-server) (:documentation "Returns an alist of all outgoing http parameters \(except for Set-Cookie, Content-Length, and Content-Type). The car of each element of this list is the headers's name while the cdr is its value. -This alist should not be manipulated directly, use SETF of CLAWSERVER-HEADER-OUT instead")) +This alist should not be manipulated directly, use SETF of claw-server-HEADER-OUT instead")) -(defgeneric clawserver-cookie-out (clawserver name) +(defgeneric claw-server-cookie-out (claw-server name) (:documentation "Returns the outgoing cookie named by the string name \(or NIL if there ain't no cookie with this name). -See also CLAWSERVER-COOKIES-OUT and the CLAW-COOKIE class definition.")) +See also claw-server-COOKIES-OUT and the CLAW-COOKIE class definition.")) -(defgeneric (setf clawserver-cookie-out) (cookie-instance clawserver name) +(defgeneric (setf claw-server-cookie-out) (cookie-instance claw-server name) (:documentation "Creates a CLAW-COOKIE object from the parameters provided to this function and adds it to the outgoing cookies of the REPLY object reply. If a cookie with the same name \(case-sensitive) already exists, it is replaced. The default for value is the empty string.")) -(defgeneric clawserver-cookies-out (clawserver) +(defgeneric claw-server-cookies-out (claw-server) (:documentation "Returns the outgoing cookie named by the string name \(or NIL if there ain't no cookie with this name). -See also CLAWSERVER-COOKIES-OUT and the CLAW-COOKIE class definition.")) +See also claw-server-COOKIES-OUT and the CLAW-COOKIE class definition.")) -(defgeneric clawserver-return-code (clawserver) - (:documentation "CLAWSERVER-RETURN-CODE returns the http return code of the reply. The return code of each REPLY object is initially set to 200 \(OK)")) +(defgeneric claw-server-return-code (claw-server) + (:documentation "claw-server-RETURN-CODE returns the http return code of the reply. The return code of each REPLY object is initially set to 200 \(OK)")) -(defgeneric (setf clawserver-return-code) (value clawserver) - (:documentation "Setf CLAWSERVER-RETURN-CODE sets the http return code of the reply.")) +(defgeneric (setf claw-server-return-code) (value claw-server) + (:documentation "Setf claw-server-RETURN-CODE sets the http return code of the reply.")) -(defgeneric clawserver-content-type (clawserver) - (:documentation "CLAWSERVER-CONTENT-TYPE returns the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\").")) +(defgeneric claw-server-content-type (claw-server) + (:documentation "claw-server-CONTENT-TYPE returns the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\").")) -(defgeneric (setf clawserver-content-type) (value clawserver) - (:documentation "SETF CLAWSERVER-CONTENT-TYPE sets the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\").")) +(defgeneric (setf claw-server-content-type) (value claw-server) + (:documentation "SETF claw-server-CONTENT-TYPE sets the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\").")) -(defgeneric clawserver-content-length (clawserver) +(defgeneric claw-server-content-length (claw-server) (:documentation "Returns the outgoing Content-Length http header")) -(defgeneric (setf clawserver-content-length) (value clawserver) +(defgeneric (setf claw-server-content-length) (value claw-server) (:documentation "Sets the outgoing Content-Length http header")) -(defgeneric clawserver-reply-external-format-encoding (clawserver) - (:documentation "CLAWSERVER-REPLY-EXTERNAL-FORMAT-ENCODING returns the symbol of the reply charset encoding \(Such as UTF-8).")) +(defgeneric claw-server-reply-external-format-encoding (claw-server) + (:documentation "claw-server-REPLY-EXTERNAL-FORMAT-ENCODING returns the symbol of the reply charset encoding \(Such as UTF-8).")) -(defgeneric (setf clawserver-reply-external-format-encoding) (value clawserver) - (:documentation "SETF CLAWSERVER-REPLY-EXTERNAL-FORMAT-ENCODING sets the symbol of the reply charset encoding \(Such as UTF-8).")) +(defgeneric (setf claw-server-reply-external-format-encoding) (value claw-server) + (:documentation "SETF claw-server-REPLY-EXTERNAL-FORMAT-ENCODING sets the symbol of the reply charset encoding \(Such as UTF-8).")) -(defgeneric clawserver-writer (clawserver) +(defgeneric claw-server-writer (claw-server) (:documentation "Returns the output stream writer to generate replies. It's default to *standard-output*")) -(defgeneric clawserver-redirect (clawserver target &key host port protocol add-session-id code) +(defgeneric claw-server-redirect (claw-server target &key host port protocol add-session-id code) (:documentation "Sends back appropriate headers to redirect the client to target \(a string). If target is a full URL starting with a scheme, host, port, and protocol are ignored. Otherwise, target should denote the path part of a URL, protocol must be one of the keywords :HTTP or :HTTPS, and the URL to redirect to will be constructed from host, port, protocol, and target. If code is a 3xx redirection code, it will be sent as status code. -In case of NIL, a 302 status code will be sent to the client. If host is not provided, the current host \(see CLAWSERVER-HOST) will be used. +In case of NIL, a 302 status code will be sent to the client. If host is not provided, the current host \(see claw-server-HOST) will be used. If protocol is the keyword :HTTPS, the client will be redirected to a https URL, if it's :HTTP it'll be sent to a http URL. If both host and protocol aren't provided, then the value of protocol will match the current request.")) ;;------------------------------------------------------------------------------------------ -(defgeneric clawserver-dispatch-request (clawserver) +(defgeneric claw-server-dispatch-request (claw-server) (:documentation "Dispatches http requests through registered dispatchers")) -(defgeneric clawserver-dispatch-method (clawserver) - (:documentation "Uses CLAWSERVER-DISPATCH-REQUEST to perform dispatching")) +(defgeneric claw-server-dispatch-method (claw-server) + (:documentation "Uses claw-server-DISPATCH-REQUEST to perform dispatching")) -(defgeneric clawserver-start (clawserver) +(defgeneric claw-server-start (claw-server) (:documentation "Starts the server")) -(defgeneric clawserver-stop (clawserver) +(defgeneric claw-server-stop (claw-server) (:documentation "Stops the server")) -(defgeneric (setf clawserver-port) (port clawserver) +(defgeneric (setf claw-server-port) (port claw-server) (:documentation "Sets the claw server http port. When server is started an error will be signaled.")) -(defgeneric (setf clawserver-sslport) (sslport clawserver) +(defgeneric (setf claw-server-sslport) (sslport claw-server) (:documentation "Sets the claw server https port. When server is started an error will be signaled.")) -(defgeneric clawserver-address (clawserver) +(defgeneric claw-server-address (claw-server) (:documentation "Binds the claw server to a specific address. When server is started an error will be signaled.")) ;;----------------------------------------------------------------------------------------------- -(defgeneric (setf clawserver-read-timeout) (read-timeout clawserver) +(defgeneric (setf claw-server-read-timeout) (read-timeout claw-server) (:documentation "Sets the read timeout in seconds. When server is started an error will be signaled.")) -(defgeneric (setf clawserver-write-timeout) (write-timeout clawserver) +(defgeneric (setf claw-server-write-timeout) (write-timeout claw-server) (:documentation "Sets the write timeout in seconds. When server is started an error will be signaled.")) -(defgeneric clawserver-add-service (clawserver service) - (:documentation "Registers a service for the given CLAWSERVER object with the given SERVICE name. -A service may be added if the CLAWSERVER object is not running.")) +(defgeneric claw-server-add-service (claw-server service) + (:documentation "Registers a service for the given claw-server object with the given SERVICE name. +A service may be added if the claw-server object is not running.")) ;;------------------------------------------------------------ -(defgeneric clawserver-register-configuration(clawserver realm configuration) +(defgeneric claw-server-register-configuration(claw-server realm configuration) (:documentation "Registers a configuration object for the given realm into the server. The configuration will perform the authentication logic.")) -(defclass clawserver () +(defclass claw-server () ((base-path :initarg :base-path - :accessor clawserver-base-path + :accessor claw-server-base-path :documentation "This slot is used to keep all server resources under a common URL") (proxy-http-port :initarg :proxy-http-port - :accessor clawserver-proxy-http-port + :accessor claw-server-proxy-http-port :documentation "The port eventually used to proxify http requests") (proxy-https-port :initarg :proxy-https-port - :accessor clawserver-proxy-https-port + :accessor claw-server-proxy-https-port :documentation "The port eventually used to proxify https requests") (reverse-proxy-path :initarg :reverse-proxy-path - :accessor clawserver-reverse-proxy-path + :accessor claw-server-reverse-proxy-path :documentation "When request is sent via proxy, use this value to build absolute paths") (connector :initarg :connector - :accessor clawserver-connector + :accessor claw-server-connector :documentation "Reads or sets the server connector that dispatches requests and processes replies from the remote host.") (log-manager :initarg :log-manager - :accessor clawserver-log-manager + :accessor claw-server-log-manager :documentation "Required log meanager used to log application messages when no lisplet one is provided") (session-manager :initarg :session-manager - :accessor clawserver-session-manager + :accessor claw-server-session-manager :documentation "Accessor for the session manager. See the definition of the SESSION-MANAGER class.") (services :initarg :services - :accessor clawserver-services + :accessor claw-server-services :documentation "A hash map of services handled by the current server") (login-config :initform (make-hash-table :test 'equal) - :accessor clawserver-login-config + :accessor claw-server-login-config :documentation "An hash table holding a pair of realm, expressed as string, and a function. The function should take two arguments (login and password), and return a principal instance if the login call succeeds.") (lisplets :initform nil - :accessor clawserver-lisplets + :accessor claw-server-lisplets :documentation "A collection of cons where the car is an url location where a lisplet is registered and the cdr is the lisplet")) (:default-initargs :base-path "" :proxy-http-port *apache-http-port* :proxy-https-port *apache-https-port* :reverse-proxy-path nil :services (make-hash-table)) - (:documentation "CLAWSERVER is built around huncentoot and has the + (:documentation "claw-server is built around huncentoot and has the instructions for lisplet dispatching, so use this class to start and stop 3hunchentoot server.")) ;;;-------------------------- WRITERS ---------------------------------------- -(defmethod clawserver-add-service ((server clawserver) (service claw-service)) - (setf (gethash (claw-service-name service) (clawserver-services server)) service)) +(defmethod claw-server-add-service ((server claw-server) (service claw-service)) + (setf (gethash (claw-service-name service) (claw-server-services server)) service)) ;;;-------------------------- METHODS ---------------------------------------- -(defmethod clawserver-register-configuration ((clawserver clawserver) realm (configuration configuration)) - (setf (gethash realm (clawserver-login-config clawserver)) configuration)) +(defmethod claw-server-register-configuration ((claw-server claw-server) realm (configuration configuration)) + (setf (gethash realm (claw-server-login-config claw-server)) configuration)) -(defmethod clawserver-dispatch-request ((clawserver clawserver)) - (let* ((*clawserver* clawserver) - (*session-manager* (clawserver-session-manager clawserver)) - (connector (clawserver-connector clawserver)) - (base-path (clawserver-base-path clawserver)) - (lisplets (clawserver-lisplets clawserver)) +(defmethod claw-server-dispatch-request ((claw-server claw-server)) + (let* ((*claw-server* claw-server) + (*session-manager* (claw-server-session-manager claw-server)) + (connector (claw-server-connector claw-server)) + (base-path (claw-server-base-path claw-server)) + (lisplets (claw-server-lisplets claw-server)) (script-name (connector-script-name connector)) (*server-path* (or (when (claw-proxified-p) - (clawserver-reverse-proxy-path clawserver)) - (clawserver-base-path clawserver))) + (claw-server-reverse-proxy-path claw-server)) + (claw-server-base-path claw-server))) (rel-script-name) (rel-script-name-libs) (http-result nil)) @@ -347,7 +347,7 @@ (when error-handler (funcall error-handler))) (with-output-to-string (*standard-output*) - (error-renderer clawserver :error-code (or + (error-renderer claw-server :error-code (or (let ((return-code (claw-return-code))) (if (= return-code +http-ok+) nil @@ -355,19 +355,19 @@ +http-not-found+))))) )) (error (cond) - (logger-log (clawserver-log-manager clawserver) :error "~a" cond) - (with-output-to-string (*standard-output*) (error-renderer clawserver :error-code +http-internal-server-error+)))))) + (logger-log (claw-server-log-manager claw-server) :error "~a" cond) + (with-output-to-string (*standard-output*) (error-renderer claw-server :error-code +http-internal-server-error+)))))) -(defmethod clawserver-dispatch-method ((clawserver clawserver)) - #'(lambda () (clawserver-dispatch-request clawserver))) +(defmethod claw-server-dispatch-method ((claw-server claw-server)) + #'(lambda () (claw-server-dispatch-request claw-server))) -(defmethod clawserver-start ((clawserver clawserver)) - (let ((*clawserver* clawserver) - (log-manager (clawserver-log-manager clawserver)) - (connector (clawserver-connector clawserver)) - (sm (clawserver-session-manager clawserver)) - (lisplets (clawserver-lisplets clawserver))) +(defmethod claw-server-start ((claw-server claw-server)) + (let ((*claw-server* claw-server) + (log-manager (claw-server-log-manager claw-server)) + (connector (claw-server-connector claw-server)) + (sm (claw-server-session-manager claw-server)) + (lisplets (claw-server-lisplets claw-server))) (unless (claw-service-running-p log-manager) (claw-service-start log-manager)) (unless (claw-service-running-p connector) @@ -379,12 +379,12 @@ for lisplet = (cdr lisplet-cons) do (claw-service-start lisplet))))) -(defmethod clawserver-stop ((clawserver clawserver)) - (let ((*clawserver* clawserver) - (log-manager (clawserver-log-manager clawserver)) - (connector (clawserver-connector clawserver)) - (sm (clawserver-session-manager clawserver)) - (lisplets (clawserver-lisplets clawserver))) +(defmethod claw-server-stop ((claw-server claw-server)) + (let ((*claw-server* claw-server) + (log-manager (claw-server-log-manager claw-server)) + (connector (claw-server-connector claw-server)) + (sm (claw-server-session-manager claw-server)) + (lisplets (claw-server-lisplets claw-server))) (when lisplets (loop for lisplet-cons in lisplets for url = (car lisplet-cons) @@ -400,138 +400,138 @@ ;;------------------------------------------------------------------------------------------------------- -(defmethod clawserver-host ((clawserver clawserver)) - (connector-host (clawserver-connector clawserver))) +(defmethod claw-server-host ((claw-server claw-server)) + (connector-host (claw-server-connector claw-server))) -(defmethod clawserver-request-method ((clawserver clawserver)) - (connector-request-method (clawserver-connector clawserver))) +(defmethod claw-server-request-method ((claw-server claw-server)) + (connector-request-method (claw-server-connector claw-server))) -(defmethod clawserver-request-uri ((clawserver clawserver)) - (connector-request-uri (clawserver-connector clawserver))) +(defmethod claw-server-request-uri ((claw-server claw-server)) + (connector-request-uri (claw-server-connector claw-server))) -(defmethod clawserver-query-string ((clawserver clawserver)) - (connector-query-string (clawserver-connector clawserver))) +(defmethod claw-server-query-string ((claw-server claw-server)) + (connector-query-string (claw-server-connector claw-server))) -(defmethod clawserver-get-parameter ((clawserver clawserver) name) - (connector-get-parameter (clawserver-connector clawserver) name)) +(defmethod claw-server-get-parameter ((claw-server claw-server) name) + (connector-get-parameter (claw-server-connector claw-server) name)) -(defmethod clawserver-get-parameters ((clawserver clawserver)) - (connector-get-parameters (clawserver-connector clawserver))) +(defmethod claw-server-get-parameters ((claw-server claw-server)) + (connector-get-parameters (claw-server-connector claw-server))) -(defmethod clawserver-post-parameter ((clawserver clawserver) name) - (connector-post-parameter (clawserver-connector clawserver) name)) +(defmethod claw-server-post-parameter ((claw-server claw-server) name) + (connector-post-parameter (claw-server-connector claw-server) name)) -(defmethod clawserver-post-parameters ((clawserver clawserver)) - (connector-post-parameters (clawserver-connector clawserver))) +(defmethod claw-server-post-parameters ((claw-server claw-server)) + (connector-post-parameters (claw-server-connector claw-server))) -(defmethod clawserver-parameter ((clawserver clawserver) name) - (connector-parameter (clawserver-connector clawserver) name)) +(defmethod claw-server-parameter ((claw-server claw-server) name) + (connector-parameter (claw-server-connector claw-server) name)) -(defmethod clawserver-header-in ((clawserver clawserver) name) - (connector-header-in (clawserver-connector clawserver) name)) +(defmethod claw-server-header-in ((claw-server claw-server) name) + (connector-header-in (claw-server-connector claw-server) name)) -(defmethod clawserver-headers-in ((clawserver clawserver)) - (connector-headers-in (clawserver-connector clawserver))) +(defmethod claw-server-headers-in ((claw-server claw-server)) + (connector-headers-in (claw-server-connector claw-server))) -(defmethod clawserver-authorization ((clawserver clawserver)) - (connector-authorization (clawserver-connector clawserver))) +(defmethod claw-server-authorization ((claw-server claw-server)) + (connector-authorization (claw-server-connector claw-server))) -(defmethod clawserver-remote-addr ((clawserver clawserver)) - (connector-remote-addr (clawserver-connector clawserver))) +(defmethod claw-server-remote-addr ((claw-server claw-server)) + (connector-remote-addr (claw-server-connector claw-server))) -(defmethod clawserver-remote-port ((clawserver clawserver)) - (connector-remote-port (clawserver-connector clawserver))) +(defmethod claw-server-remote-port ((claw-server claw-server)) + (connector-remote-port (claw-server-connector claw-server))) -(defmethod clawserver-real-remote-addr ((clawserver clawserver)) - (connector-real-remote-addr (clawserver-connector clawserver))) +(defmethod claw-server-real-remote-addr ((claw-server claw-server)) + (connector-real-remote-addr (claw-server-connector claw-server))) -(defmethod clawserver-server-addr ((clawserver clawserver)) - (connector-server-addr (clawserver-connector clawserver))) +(defmethod claw-server-server-addr ((claw-server claw-server)) + (connector-server-addr (claw-server-connector claw-server))) -(defmethod clawserver-server-port ((clawserver clawserver)) - (connector-server-port (clawserver-connector clawserver))) +(defmethod claw-server-server-port ((claw-server claw-server)) + (connector-server-port (claw-server-connector claw-server))) -(defmethod clawserver-server-protocol ((clawserver clawserver)) - (connector-server-protocol (clawserver-connector clawserver))) +(defmethod claw-server-server-protocol ((claw-server claw-server)) + (connector-server-protocol (claw-server-connector claw-server))) -(defmethod clawserver-user-agent ((clawserver clawserver)) - (connector-user-agent (clawserver-connector clawserver))) +(defmethod claw-server-user-agent ((claw-server claw-server)) + (connector-user-agent (claw-server-connector claw-server))) -(defmethod clawserver-referer ((clawserver clawserver)) - (connector-referer (clawserver-connector clawserver))) +(defmethod claw-server-referer ((claw-server claw-server)) + (connector-referer (claw-server-connector claw-server))) -(defmethod clawserver-cookie-in ((clawserver clawserver) name) - (connector-cookie-in (clawserver-connector clawserver) name)) +(defmethod claw-server-cookie-in ((claw-server claw-server) name) + (connector-cookie-in (claw-server-connector claw-server) name)) -(defmethod clawserver-cookies-in ((clawserver clawserver)) - (connector-cookies-in (clawserver-connector clawserver))) +(defmethod claw-server-cookies-in ((claw-server claw-server)) + (connector-cookies-in (claw-server-connector claw-server))) -(defmethod clawserver-aux-request-value ((clawserver clawserver) symbol) - (connector-aux-request-value (clawserver-connector clawserver) symbol)) +(defmethod claw-server-aux-request-value ((claw-server claw-server) symbol) + (connector-aux-request-value (claw-server-connector claw-server) symbol)) -(defmethod (setf clawserver-aux-request-value) (value (clawserver clawserver) symbol) - (setf (connector-aux-request-value (clawserver-connector clawserver) symbol) value)) +(defmethod (setf claw-server-aux-request-value) (value (claw-server claw-server) symbol) + (setf (connector-aux-request-value (claw-server-connector claw-server) symbol) value)) -(defmethod clawserver-delete-aux-request-value ((clawserver clawserver) symbol) - (connector-delete-aux-request-value (clawserver-connector clawserver) symbol)) +(defmethod claw-server-delete-aux-request-value ((claw-server claw-server) symbol) + (connector-delete-aux-request-value (claw-server-connector claw-server) symbol)) -(defmethod clawserver-header-out ((clawserver clawserver) name) - (connector-header-out (clawserver-connector clawserver) name)) +(defmethod claw-server-header-out ((claw-server claw-server) name) + (connector-header-out (claw-server-connector claw-server) name)) -(defmethod (setf clawserver-header-out) (value (clawserver clawserver) name) - (setf (connector-header-out (clawserver-connector clawserver) name) value)) +(defmethod (setf claw-server-header-out) (value (claw-server claw-server) name) + (setf (connector-header-out (claw-server-connector claw-server) name) value)) -(defmethod clawserver-headers-out ((clawserver clawserver)) - (connector-headers-out (clawserver-connector clawserver))) +(defmethod claw-server-headers-out ((claw-server claw-server)) + (connector-headers-out (claw-server-connector claw-server))) -(defmethod clawserver-cookie-out ((clawserver clawserver) name) - (connector-cookie-out (clawserver-connector clawserver) name)) +(defmethod claw-server-cookie-out ((claw-server claw-server) name) + (connector-cookie-out (claw-server-connector claw-server) name)) -(defmethod (setf clawserver-cookie-out) (cookie-instance (clawserver clawserver) name) - (setf (connector-cookie-out (clawserver-connector clawserver) name) cookie-instance)) +(defmethod (setf claw-server-cookie-out) (cookie-instance (claw-server claw-server) name) + (setf (connector-cookie-out (claw-server-connector claw-server) name) cookie-instance)) -(defmethod clawserver-cookies-out ((clawserver clawserver)) - (connector-cookies-out (clawserver-connector clawserver))) +(defmethod claw-server-cookies-out ((claw-server claw-server)) + (connector-cookies-out (claw-server-connector claw-server))) -(defmethod clawserver-return-code ((clawserver clawserver)) - (connector-return-code (clawserver-connector clawserver))) +(defmethod claw-server-return-code ((claw-server claw-server)) + (connector-return-code (claw-server-connector claw-server))) -(defmethod (setf clawserver-return-code) (value (clawserver clawserver)) - (setf (connector-return-code (clawserver-connector clawserver)) value)) +(defmethod (setf claw-server-return-code) (value (claw-server claw-server)) + (setf (connector-return-code (claw-server-connector claw-server)) value)) -(defmethod clawserver-content-type ((clawserver clawserver)) - (connector-content-type (clawserver-connector clawserver))) +(defmethod claw-server-content-type ((claw-server claw-server)) + (connector-content-type (claw-server-connector claw-server))) -(defmethod (setf clawserver-content-type) (value (clawserver clawserver)) - (setf (connector-content-type (clawserver-connector clawserver)) value)) +(defmethod (setf claw-server-content-type) (value (claw-server claw-server)) + (setf (connector-content-type (claw-server-connector claw-server)) value)) -(defmethod clawserver-content-length ((clawserver clawserver)) - (connector-content-length (clawserver-connector clawserver))) +(defmethod claw-server-content-length ((claw-server claw-server)) + (connector-content-length (claw-server-connector claw-server))) -(defmethod (setf clawserver-content-length) (value (clawserver clawserver)) - (setf (connector-content-length (clawserver-connector clawserver)) value)) +(defmethod (setf claw-server-content-length) (value (claw-server claw-server)) + (setf (connector-content-length (claw-server-connector claw-server)) value)) -(defmethod clawserver-reply-external-format-encoding ((clawserver clawserver)) - (connector-reply-external-format-encoding (clawserver-connector clawserver))) +(defmethod claw-server-reply-external-format-encoding ((claw-server claw-server)) + (connector-reply-external-format-encoding (claw-server-connector claw-server))) -(defmethod (setf clawserver-reply-external-format-encoding) (value (clawserver clawserver)) - (setf (connector-reply-external-format-encoding (clawserver-connector clawserver)) value)) +(defmethod (setf claw-server-reply-external-format-encoding) (value (claw-server claw-server)) + (setf (connector-reply-external-format-encoding (claw-server-connector claw-server)) value)) -(defmethod clawserver-writer ((clawserver clawserver)) - (connector-writer (clawserver-connector clawserver))) +(defmethod claw-server-writer ((claw-server claw-server)) + (connector-writer (claw-server-connector claw-server))) -(defmethod clawserver-redirect (clawserver target &key host port protocol add-session-id code) - (connector-redirect (clawserver-connector clawserver) target :host host :port port :protocol protocol :add-session-id add-session-id :code code)) +(defmethod claw-server-redirect (claw-server target &key host port protocol add-session-id code) + (connector-redirect (claw-server-connector claw-server) target :host host :port port :protocol protocol :add-session-id add-session-id :code code)) -(defmethod clawserver-script-name ((clawserver clawserver)) - (connector-script-name (clawserver-connector clawserver))) +(defmethod claw-server-script-name ((claw-server claw-server)) + (connector-script-name (claw-server-connector claw-server))) -(defmethod clawserver-address ((clawserver clawserver)) - (connector-address (clawserver-connector clawserver))) +(defmethod claw-server-address ((claw-server claw-server)) + (connector-address (claw-server-connector claw-server))) -(defmethod error-renderer ((clawserver clawserver) &key (error-code 404)) - (let ((request-uri (format nil "~a/~a" *server-path* (subseq (claw-script-name) (1+ (length (clawserver-base-path clawserver)))))) - (connector (clawserver-connector clawserver)) +(defmethod error-renderer ((claw-server claw-server) &key (error-code 404)) + (let ((request-uri (format nil "~a/~a" *server-path* (subseq (claw-script-name) (1+ (length (claw-server-base-path claw-server)))))) + (connector (claw-server-connector claw-server)) (style "body { font-family: arial, elvetica; font-size: 7pt; Modified: trunk/main/claw-as/src/session-manager.lisp ============================================================================== --- trunk/main/claw-as/src/session-manager.lisp (original) +++ trunk/main/claw-as/src/session-manager.lisp Mon Dec 22 10:04:53 2008 @@ -98,11 +98,11 @@ :documentation "The session strings encodes enough data to safely retrieve this session. It is sent to the browser as a cookie value or as a GET parameter.") - (user-agent :initform (connector-user-agent (clawserver-connector *clawserver*)) + (user-agent :initform (connector-user-agent (claw-server-connector *claw-server*)) :reader session-user-agent :documentation "The incoming 'User-Agent' header that was sent when this session was created.") - (remote-addr :initform (connector-remote-addr (clawserver-connector *clawserver*));(connector-real-remote-addr (clawserver-connector *clawserver*)) + (remote-addr :initform (connector-remote-addr (claw-server-connector *claw-server*));(connector-real-remote-addr (claw-server-connector *claw-server*)) :reader session-remote-addr :documentation "The remote IP address of the client when this sessions was started as returned by REAL-REMOTE-ADDR.") @@ -145,8 +145,8 @@ :documentation "The time \(in seconds) after which this session expires if it's not used.")) (:default-initargs :name 'session-manager :max-time 1800) (:documentation "SESSION-MANAGER is an interface, so you cannot directly use it. -A SESSION-MANAGER subclass is a class that helps to decouple CLAW from the web server on which CLAWSERVER resides. -To properly work a CLAWSERVER instance must be provided with a SESSION-MANAGER implementation. +A SESSION-MANAGER subclass is a class that helps to decouple CLAW from the web server on which claw-server resides. +To properly work a claw-server instance must be provided with a SESSION-MANAGER implementation. A SESSION-MANAGER implementation to properly work, must implement all the CONNECTOR- methods. As the name suggests this is a server that handles user sessions.")) @@ -200,7 +200,7 @@ (defmethod default-session-manager-current-session ((session-manager default-session-manager)) (or *claw-session* - (let* ((connector (clawserver-connector *clawserver*)) + (let* ((connector (claw-server-connector *claw-server*)) (cookie-name (default-session-manager-session-cookie-name session-manager)) (sessions (default-session-manager-sessions session-manager)) (session-identifier (or (connector-cookie-in connector cookie-name) @@ -241,7 +241,7 @@ realm)))))) (defmethod default-session-manager-session-verify ((session-manager default-session-manager)) - (let* ((connector (clawserver-connector *clawserver*)) + (let* ((connector (claw-server-connector *claw-server*)) (sessions (default-session-manager-sessions session-manager)) (cookie-name (default-session-manager-session-cookie-name session-manager)) (session-identifier (or (connector-cookie-in connector cookie-name) @@ -301,7 +301,7 @@ (get-universal-time))) (defmethod session-manager-start-session ((session-manager default-session-manager) &key (path "/") max-time domain) - (let* ((connector (clawserver-connector *clawserver*)) + (let* ((connector (claw-server-connector *claw-server*)) (sessions (default-session-manager-sessions session-manager)) (cookie-name (default-session-manager-session-cookie-name session-manager)) (session-identifier (or (connector-cookie-in connector cookie-name) @@ -337,7 +337,7 @@ *claw-session* session)))))) (defmethod session-manager-remove-session ((session-manager default-session-manager) &optional session) - (let ((connector (clawserver-connector *clawserver*)) + (let ((connector (claw-server-connector *claw-server*)) (cookie-name (default-session-manager-session-cookie-name session-manager)) (current-session (or session (default-session-manager-current-session session-manager)))) (when current-session Modified: trunk/main/claw-demo/src/backend/dao.lisp ============================================================================== --- trunk/main/claw-demo/src/backend/dao.lisp (original) +++ trunk/main/claw-demo/src/backend/dao.lisp Mon Dec 22 10:04:53 2008 @@ -50,7 +50,7 @@ :year year :month month :day day :hour hour :minute minute :second sec))) (defmethod sign-table-update ((base-table base-table)) - (let ((user-name (or (and *clawserver* + (let ((user-name (or (and *claw-server* (current-principal) (principal-name (current-principal))) "anonymous")) Modified: trunk/main/claw-demo/src/frontend/main.lisp ============================================================================== --- trunk/main/claw-demo/src/frontend/main.lisp (original) +++ trunk/main/claw-demo/src/frontend/main.lisp Mon Dec 22 10:04:53 2008 @@ -52,27 +52,27 @@ (defvar *ht-log-manager* (make-instance 'hunchentoot-logger)) -(defvar *dojo-clawserver* (make-instance 'clawserver +(defvar *dojo-claw-server* (make-instance 'claw-server :connector *ht-connector* :log-manager *ht-log-manager* :session-manager *sm* :base-path "/claw" :reverse-proxy-path "/claw1")) -(clawserver-register-lisplet *dojo-clawserver* *dojo-demo-lisplet*) +(claw-server-register-lisplet *dojo-claw-server* *dojo-demo-lisplet*) -(clawserver-register-configuration *dojo-clawserver* "demo" (make-instance 'demo-configuration)) +(claw-server-register-configuration *dojo-claw-server* "demo" (make-instance 'demo-configuration)) (let ((path (make-pathname :directory (append (pathname-directory *main-file*) '("docroot")))) - (*clawserver* *dojo-clawserver*)) + (*claw-server* *dojo-claw-server*)) (log-message :info "Registering resource ~a" path) (lisplet-register-resource-location *dojo-demo-lisplet* path "docroot/")) (defun djstart () - (clawserver-start *dojo-clawserver*)) + (claw-server-start *dojo-claw-server*)) (defun djstop () - (clawserver-stop *dojo-clawserver*)) + (claw-server-stop *dojo-claw-server*)) Modified: trunk/main/connectors/claw-hunchentoot-connector/src/hunchentoot.lisp ============================================================================== --- trunk/main/connectors/claw-hunchentoot-connector/src/hunchentoot.lisp (original) +++ trunk/main/connectors/claw-hunchentoot-connector/src/hunchentoot.lisp Mon Dec 22 10:04:53 2008 @@ -124,13 +124,13 @@ (:documentation "This is a connector between hunchentoot and the CLAW server CLAWSERVER object")) (defmethod claw-service-start :before ((connector hunchentoot-connector)) - (let* ((server *clawserver*) + (let* ((server *claw-server*) (port (connector-port connector)) (sslport (connector-sslport connector)) (address (connector-address connector)) (dispatch-table (list #'(lambda (request) (declare (ignore request)) - (clawserver-dispatch-method server)))) + (claw-server-dispatch-method server)))) (mod-lisp-p (hunchentoot-connector-mod-lisp-p connector)) (use-apache-log-p (hunchentoot-connector-use-apache-log-p connector)) (input-chunking-p (hunchentoot-connector-input-chunking-p connector))

1 0

[claw-cvs] r163 - trunk/doc
by Andrea Chiumenti 22 Dec '08

22 Dec '08

Author: achiumenti Date: Mon Dec 22 09:37:08 2008 New Revision: 163 Log: spell bugfix Modified: trunk/doc/claw.texinfo Modified: trunk/doc/claw.texinfo ============================================================================== --- trunk/doc/claw.texinfo (original) +++ trunk/doc/claw.texinfo Mon Dec 22 09:37:08 2008 @@ -7,7 +7,7 @@ @set claw CLAW @set VERSION 0.1 -@set UPDATE-MONTH genuary 2008 +@set UPDATE-MONTH january 2008 @settitle @value{claw} @value{VERSION} User Manual @copying

1 0

[claw-cvs] r162 - trunk/main/claw-html/src
by Andrea Chiumenti 19 Dec '08

19 Dec '08

Author: achiumenti Date: Fri Dec 19 12:54:59 2008 New Revision: 162 Log: validation bugfix Modified: trunk/main/claw-html/src/components.lisp trunk/main/claw-html/src/validators.lisp Modified: trunk/main/claw-html/src/components.lisp ============================================================================== --- trunk/main/claw-html/src/components.lisp (original) +++ trunk/main/claw-html/src/components.lisp Fri Dec 19 12:54:59 2008 @@ -302,7 +302,7 @@ (value (translated-value cinput))) (unless (or (null value) (null visit-object) (component-validation-errors cinput)) (when validator - (funcall validator cinput)) + (funcall validator value)) (unless (component-validation-errors cinput) (if (and (null writer) accessor) (funcall (fdefinition `(setf ,accessor)) (if (and (stringp value) (string= value "") (base-cinput-empty-to-null-p cinput)) Modified: trunk/main/claw-html/src/validators.lisp ============================================================================== --- trunk/main/claw-html/src/validators.lisp (original) +++ trunk/main/claw-html/src/validators.lisp Fri Dec 19 12:54:59 2008 @@ -70,15 +70,17 @@ (add-validation-compliance client-id) (add-validation-error client-id message)))) -(defun validate-required (component value &key message component-label) +(defun validate-required (value &key (component (page-current-component *claw-current-page*)) message component-label) "Checks if the required input field VALUE is present. If not, a localizable message \"Field ~a may not be empty.\" is sent with key \"VALIDATE-REQUIRED\". The argument for the message will be the :label attribute of the COMPONENT." + (unless value + (setf value "")) (when (stringp value) (validate (and value (string-not-equal value "")) :component component :message (or message (format nil "Field ~a may not be empty." (or component-label (label component))))))) -(defun validate-size (component value &key min-size max-size message-low message-hi component-label) +(defun validate-size (value &key (component (page-current-component *claw-current-page*)) min-size max-size message-low message-hi component-label) "Checks if the input field VALUE legth is less then or greater then rispectively of the form keywords :MIN-SIZE and :MAX-SIZE. If less then :MIN-SIZE, a localizable message \"Size of ~a may not be less then ~a chars.\" is sent with key \"VALIDATE-SIZE-MIN\". The argument for the message will be the :label attribute of the COMPONENT and the :MIN-ZIZE value. @@ -102,7 +104,7 @@ (or component-label (label component)) max-size)))))))) -(defun validate-range (component value &key min max message-low message-hi component-label) +(defun validate-range (value &key (component (page-current-component *claw-current-page*)) min max message-low message-hi component-label) "Checks if the numeric input field VALUE is less then or greater then rispectively of the form keywords :MIN and :MAX. If less then :MIN, a localizable message \"Field ~a is not less then or equal to ~d.\" is sent with key \"VALIDATE-RANGE-MIN\". The argument for the message will be the :label attribute of the COMPONENT and the :MIN value. @@ -126,7 +128,7 @@ (coerce max 'float) max)))))))) -(defun validate-number (component value &key min max message-nan message-low message-hi component-label) +(defun validate-number (value &key (component (page-current-component *claw-current-page*)) min max message-nan message-low message-hi component-label) "Checks if the input field VALUE is a valid number and then passes the validation to VALIDATION-RANGE. If not a number, a localizable message \"Field ~a is not a valid number.\" is sent with key \"VALIDATE-NUMBER\". The argument for the message will be the :label attribute of the COMPONENT." @@ -136,9 +138,9 @@ :component component :message (or message-nan (format nil "Field ~a is not a valid number." (or component-label (label component))))) - (validate-range component value :min min :max max :message-low message-low :message-hi message-hi :component-label component-label))))) + (validate-range value :component component :min min :max max :message-low message-low :message-hi message-hi :component-label component-label))))) -(defun validate-integer (component value &key min max message-nan message-low message-hi component-label) +(defun validate-integer (value &key (component (page-current-component *claw-current-page*)) min max message-nan message-low message-hi component-label) "Checks if the input field VALUE is a valid number and then passes the validation to VALIDATION-RANGE. If not a number, a localizable message \"Field ~a is not a valid integer.\" is sent with key \"VALIDATE-INTEGER\". The argument for the message will be the :label attribute of the COMPONENT." @@ -147,10 +149,10 @@ (and (validate test :component component :message (or message-nan (format nil "Field ~a is not a valid integer." (or component-label (label component))))) - (validate-range component value :min min :max max :message-low message-low :message-hi message-hi :component-label component-label))))) + (validate-range value :component component :min min :max max :message-low message-low :message-hi message-hi :component-label component-label))))) -(defun validate-date-range (component value &key min max (use-date-p t) use-time-p message-low message-hi component-label) +(defun validate-date-range (value &key (component (page-current-component *claw-current-page*)) min max (use-date-p t) use-time-p message-low message-hi component-label) "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. @@ -159,7 +161,6 @@ The argument for the message will be the :label attribute of the COMPONENT and the value passed to :MIN parsed with the :LOCAL-TIME-FORMAT keyword. If value is greater then the date passed to :MAX, a localizable message \"Field ~a is greater then ~a.\" is sent with key \"VALIDATE-DATE-RANGE-MAX\". The argument for the message will be the :label attribute of the COMPONENT and the value passed to :MAX parsed with the :LOCAL-TIME-FORMAT keyword." -; (unless (component-validation-errors component)) (let ((local-time-format '(:date "-" :month "-" :year)) (new-value (make-instance 'local-time :nsec (nsec-of value)

1 0

[claw-cvs] r161 - trunk/doc/chapters
by Andrea Chiumenti 19 Dec '08

19 Dec '08

Author: achiumenti Date: Fri Dec 19 11:35:13 2008 New Revision: 161 Log: go straight with documentation Modified: trunk/doc/chapters/claw-html.texinfo Modified: trunk/doc/chapters/claw-html.texinfo ============================================================================== --- trunk/doc/chapters/claw-html.texinfo (original) +++ trunk/doc/chapters/claw-html.texinfo Fri Dec 19 11:35:13 2008 @@ -2,10 +2,10 @@ @comment node-name, next, previous, up @chapter The web framework -@code{CLAW-HTML} is one of the most advanced web aplication framework available, complitely object oriented (see @url{http://en.wikipedia.org/wiki/Common_Lisp_Object_System, CLOS}), +@code{CLAW-HTML} is one of the most advanced web application framework available, completely object oriented (see @url{http://en.wikipedia.org/wiki/Common_Lisp_Object_System, CLOS}), it is based on the concept of pages and components. -Pages are containers for components that provide the request-response business logic. They pervent html elements from duplicating their id, that is very important in component based applications, +Pages are containers for components that provide the request-response business logic. They prevent html elements from duplicating their id, that is very important in component based applications, they are able to handle form requests, and to render components themselves of course. Components are highly reusable building blocks that make easy and fast the creation of a web application. @@ -17,7 +17,7 @@ If you don't have any idea of what asdf is, please read about it at the @url{http://constantly.at/lisp/asdf/, asdf Manual}. -Create a directory named @code{clhtml-sample1} and begin writing the @code{clhtml-sample1.asd} file and create a symolic link +Create a directory named @code{clhtml-sample1} and begin writing the @code{clhtml-sample1.asd} file and create a symbolic link into the asdf system directory. @sp 2 @@ -145,7 +145,7 @@ @section Your first @code{claw-html} page It's time to create your first page using @code{claw-html} this is done creating a @code{PAGE} subclass, override its -@code{page-content} mathod and finally registering it using the @code{make-page-renderer} function. +@code{page-content} method and finally registering it using the @code{make-page-renderer} function. In this very basic example we will not use any of the component feature of the framework, just basic tag functions. @@ -157,10 +157,7 @@ (in-package :clhtml-sample1) (defclass index-page (page) - ((username :initform nil - :accessor index-page-username) - (passwd :initform nil - :accessor index-page-password))) + ()) (defmethod page-content ((o index-page)) (html> @@ -214,7 +211,7 @@ @end smallexample @sp 2 -If you have done all properly inyour Slime REPL, after the following commands: +If you have done all properly in your Slime REPL, after the following commands: @sp 2 @smallexample @@ -237,13 +234,13 @@ the framework potentialities. Effectively this is nothing more then what other framework offers. So let's do what is usually done by component-based frameworks: create the first component. -This will be the site template component, shurely you don't want to write every page to be +This will be the site template component, surely you don't want to write every page to be different from each other, so you'll create the site template. This component will provide a tag function similar to any other standard like @code{html>, body>, div>} and so on. -The first thing you'll have to do is to create a class that subcleasses @code{WCOMPONENT} (the name stands for +The first thing you'll have to do is to create a class that subclasses @code{WCOMPONENT} (the name stands for web component) and with metaclass @code{METACOMPONENT}. Giving such metaclass to your component definition makes the framework to automatically create a tag function for this component whose name will be the component name plus a @code{>} at the end. @@ -283,11 +280,11 @@ @code{CALW-HTML} can control the id of each component so that when a component is put into a page, its id is not duplicated. You can avoid this checking using the @code{STATIC-ID} attribute, so when writing a component you can use the id given to your component through @code{HTCOMPONENT-CLIENT-ID} method an render it into the -component template (or other component methods of course). This is a great point of strenght for @code{claw-html} compared to other frameworks, infact when you put -your component into a collecting loop without beeing worry, about id duplications, a situation that mhight occur for example when creating table row components. +component template (or other component methods of course). This is a great point of strength for @code{claw-html} compared to other frameworks, in fact when you put +your component into a collecting loop without being worry, about id duplications, a situation that might occur for example when creating table row components. -The last thing to note is the absence of the link to the css file. This was made because each componoent can inject into the page its own css or js files or definitions. +The last thing to note is the absence of the link to the css file. This was made because each component can inject into the page its own css or js files or definitions. To add a css or a js file at class definition level you have to implement @code{HTCOMPONENT-SCRIPT-FILES} and @code{HTCOMPONENT-STYLESHEET-FILES} while to add javascript or css directives into the page you have to use @code{HTCOMPONENT-GLOBAL-INITSCRIPTS}, @code{HTCOMPONENT-INITSCRIPTS} and @code{HTCOMPONENT-INITSTYLES} @@ -333,11 +330,11 @@ You have just seen how components can inject css files into your page, as already said for javascript files, this is accomplished by overriding the component method @code{HTCOMPONENT-SCRIPT-FILES}, nothing more. -Some words must be spent to describe what happens if you want to inject css dirsctives and javascript commands into the page inside +Some words must be spent to describe what happens if you want to inject css directives and javascript commands into the page inside <style> and <scripts> tags. When you want to inject css directives into a <style> tag you have to override @code{HTCOMPONENT-INITSTYLES} method. -This method returns a list of strings (containing css directives). The framework removes uplicate strings and subsequently renders +This method returns a list of strings (containing css directives). The framework removes duplicated strings and subsequently renders inside the <head> tag the <style> tag. The removal of duplicates gives you the possibility of using your component inside loops without being worried about duplicating injection @@ -347,11 +344,11 @@ Then there are two different methods: @code{HTCOMPONENT-GLOBAL-INITSCRIPTS} and @code{HTCOMPONENT-INITSCRIPTS}. @code{HTCOMPONENT-GLOBAL-INITSCRIPTS} is used to render scripts that are not tied to a particular instance, but come with the component, -it's usually used to render javascript functions and global variabes. +it's usually used to render javascript functions and global variables. -@code{HTCOMPONENT-INITSCRIPTS} renders scripts that are executed on <body> onload event, so no function definitions sould be put inside. +@code{HTCOMPONENT-INITSCRIPTS} renders scripts that are executed on <body> onload event, so no function definitions should be put inside. -For example, suppose that you want to create a component that displays current client time and refresshes it every second; +For example, suppose that you want to create a component that displays current client time and refreshes it every second; you'll create a global js variable that will sore the component DOM node. You won't initialize it into the global section because you must be sure that the DOM tree is ready, so you'll inject it the with initialization method @code{HTCOMPONENT-INITSCRIPTS}. @@ -401,7 +398,7 @@ @end smalllisp @sp 2 -As you can see, once inserted into your component no more javascrpt is needed, the injection system will do all needed for you! +As you can see, once inserted into your component no more javascript is needed, the injection system will do all needed for you! Here it is how the page will look like: @@ -409,7 +406,7 @@ @image{images/idxpage-showtime,150mm,,,png} @sp 2 -@code{claw-html} will let you to safely insert the ame component multiple times because it will coorectly handle injections and id +@code{claw-html} will let you to safely insert the name component multiple times because it will correctly handle injections and id generations. For example try to put two times the @code{SHOW-TIME>} tag function inside the page content like the following: @@ -432,9 +429,111 @@ @end smalllisp @sp 2 -As you can see from the following source code css and javascript @code{SHOW-TIME} injection are correctly handled and not -duplicated as for the id generations that will not create conflicts. +As you can see from the following source code css and javascript @code{SHOW-TIME} injections are correctly handled and not +duplicated as it is for the id generations that do not create conflicts. @sp 1 @image{images/idxpage-showtime-src,150mm,,,png} @sp 2 + +@section Working with forms + +Though you can use @code{FORM>, INPUT>, SELECT>}, etc. tag functions, @code{claw-html} shows its full power when you +use its own library of form components. + +First you must know that @code{claw-html} is a component based framework, not an action based one (like Java Apache Struts for example). + +@code{claw-html} form components directly interact with their containing page, so that, when a form action is fired, +input components may 'automatically' read and write the form visit object slots (that is set to the page itself as default). + +Forms, submit buttons, and action links, may fire @code{ACTION-OBJECT} (whose default is the current page) methods on submission, just before the page content rendering. + +@subsection You first form + +All right, now it's time to build your first ``hello world'' form. To do so, you have to change your index.lisp file with the following code: + +@sp 2 +@smalllisp +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/index.lisp $ + +(in-package :clhtml-sample2) + +(defgeneric index-page-say-hello (page)) + +(defclass index-page (page) + ((username :initform nil + :accessor index-page-username) + (welcome-message :initform nil + :accessor index-page-welcome-message))) + +(defmethod index-page-say-hello ((page index-page)) + (setf (index-page-welcome-message page) + (format nil "Hello ~a!" (index-page-username page)))) + +(defmethod page-content ((o index-page)) + (site-template> :id "theBody" + :title "Home test page sample 2" + :class "sampleBody" + (div> :class "topHeader" "top header") + (div> :class "mainContent" + (cform> :action 'index-page-say-hello + "Write your name " + (cinput> :id "username" + :accessor 'index-page-username) + (csubmit> :value "Say hello")) + (h1> (index-page-welcome-message o))) + (div> :style "color: black;" + "Today: " + (show-time> :class "showTime")))) + +(lisplet-register-function-location *fs-lisplet* + (make-page-renderer 'index-page + #'claw-post-parameters + #'claw-get-parameters) + "index.html" + :welcome-page-p t) +@end smalllisp +@sp 2 + +As you can see there is no need to handle http request parameters, neither action dispatching! + +Now suppose that you want your form to be able to say both ``Hello'' and ``Goodbye''. This time you only +have to define the ``goodbye'' method for your page and connect the ``goodbye'' button to it changing the @code{PAGE-CONTENT} method definition, like the following: + +@sp 2 +@smalllisp +(defgeneric index-page-say-goodbye (page)) + +(defmethod index-page-say-goodbye ((page index-page)) + (setf (index-page-welcome-message page) + (format nil "Goodbye ~a!" (index-page-username page)))) + +(defmethod page-content ((o index-page)) + (site-template> :id "theBody" + :title "Home test page sample 2" + :class "sampleBody" + (div> :class "topHeader" "top header") + (div> :class "mainContent" + (cform> :action 'index-page-say-hello +; :method "post" + "Write your name " + (cinput> :id "username" + :accessor 'index-page-username) + (csubmit> :value "Say hello") + (csubmit> :action 'index-page-say-goodbye + :value "Say goodbye")) + (h1> (index-page-welcome-message o))) + (div> :style "color: black;" + "Today: " + (show-time> :class "showTime")))) +@end smalllisp +@sp 2 + +Since you have provided the @code{:ACTION} attribute to the second submit button, your form is now able do use two different methods for action +dispatching. Yes you don't have to implement any custom code for dispatching actions! + +Now you may have noticed that if you submit the form leaving the input box blank, the message ``Hello NIL'' will be displayed. + +There is an easy way to avoid this behaviour, ...validation! +

1 0

[claw-cvs] r160 - in trunk: doc/chapters main/claw-html/src
by Andrea Chiumenti 18 Dec '08

18 Dec '08

Author: achiumenti Date: Thu Dec 18 12:27:47 2008 New Revision: 160 Log: bugfixes, documentation update Modified: trunk/doc/chapters/claw-html.texinfo trunk/main/claw-html/src/tags.lisp Modified: trunk/doc/chapters/claw-html.texinfo ============================================================================== --- trunk/doc/chapters/claw-html.texinfo (original) +++ trunk/doc/chapters/claw-html.texinfo Thu Dec 18 12:27:47 2008 @@ -290,7 +290,7 @@ The last thing to note is the absence of the link to the css file. This was made because each componoent can inject into the page its own css or js files or definitions. To add a css or a js file at class definition level you have to implement @code{HTCOMPONENT-SCRIPT-FILES} and @code{HTCOMPONENT-STYLESHEET-FILES} while to add javascript or -css directives into the page you have to use @code{HTCOMPONENT-CLASS-INITSCRIPTS}, @code{HTCOMPONENT-INSTANCE-INITSCRIPT} and @code{HTCOMPONENT-INITSTYLES} +css directives into the page you have to use @code{HTCOMPONENT-GLOBAL-INITSCRIPTS}, @code{HTCOMPONENT-INITSCRIPTS} and @code{HTCOMPONENT-INITSTYLES} In our case it's simply sufficient to override the @code{HTCOMPONENT-STYLESHEET-FILES} method as described @@ -344,9 +344,97 @@ When you want to inject javascript commands (and functions too) the story is a slightly different. Firstly commands are injected into a <script> tag that is positioned as the last <body> tag. -Then there are two different methods: @code{HTCOMPONENT-CLASS-INITSCRIPTS} and @code{HTCOMPONENT-INSTANCE-INITSCRIPT}. +Then there are two different methods: @code{HTCOMPONENT-GLOBAL-INITSCRIPTS} and @code{HTCOMPONENT-INITSCRIPTS}. -@code{HTCOMPONENT-CLASS-INITSCRIPTS} is used to render scripts that are not tied to a particular instance, but come with the component, +@code{HTCOMPONENT-GLOBAL-INITSCRIPTS} is used to render scripts that are not tied to a particular instance, but come with the component, it's usually used to render javascript functions and global variabes. -@code{HTCOMPONENT-INSTANCE-INITSCRIPT} render scripts that are executed on <body> onload event, so no function definitions sould be put inside. +@code{HTCOMPONENT-INITSCRIPTS} renders scripts that are executed on <body> onload event, so no function definitions sould be put inside. + +For example, suppose that you want to create a component that displays current client time and refresshes it every second; +you'll create a global js variable that will sore the component DOM node. You won't initialize it into the global section because you +must be sure that the DOM tree is ready, so you'll inject it the with initialization method @code{HTCOMPONENT-INITSCRIPTS}. + +An example will be better explain the concept, so modify the components.lisp file adding the following code: + +@sp 2 +@smalllisp +(defclass show-time (wcomponent) + ((css-class :initarg :class + :reader show-time-css-class)) + (:default-initargs :class "showTime") + (:metaclass metacomponent)) + +(defmethod htcomponent-initstyles ((obj show-time)) + (format nil ".~a @{color: black;font-weight: bold;@}" (show-time-css-class obj))) + +(defmethod wcomponent-template ((obj show-time)) + (span> :static-id (htcomponent-client-id obj) + :class (show-time-css-class obj) + (wcomponent-informal-parameters obj))) + +(defmethod htcomponent-global-initscripts ((obj show-time)) + "var showTime = function (node) @{ +node.innerHTML = new Date(); +setTimeout(function () @{showTime(node);@}, 1000); +@};") + +(defmethod htcomponent-initscripts ((obj show-time)) + (format nil "showTime(document.getElementById('~a'));" (htcomponent-client-id obj))) +@end smalllisp +@sp 2 + +Then change the @code{WCOMPONENT-TEMPLATE} of the @code{INDEX-PAGE} int the index.lisp file: + +@sp 2 +@smalllisp +(defmethod page-content ((o index-page)) + (site-template> :id "theBody" + :title "Home test page sample 2" + :class "sampleBody" + (div> :class "topHeader" "top header") + (div> :class "mainContent" + (h1> "Hello world")) + (div> :style "color: black;" + "Today: " + (show-time> :class "showTime")))) +@end smalllisp +@sp 2 + +As you can see, once inserted into your component no more javascrpt is needed, the injection system will do all needed for you! + +Here it is how the page will look like: + +@sp 1 +@image{images/idxpage-showtime,150mm,,,png} +@sp 2 + +@code{claw-html} will let you to safely insert the ame component multiple times because it will coorectly handle injections and id +generations. + +For example try to put two times the @code{SHOW-TIME>} tag function inside the page content like the following: + +@sp 2 +@smalllisp +(defmethod page-content ((o index-page)) + (site-template> :id "theBody" + :title "Home test page sample 2" + :class "sampleBody" + (div> :class "topHeader" "top header") + (div> :class "mainContent" + (h1> "Hello world")) + (div> :style "color: black;" + "Today: " + (show-time> :class "showTime")) + (div> :style "color: black;" + "Today: " + (show-time> :class "showTime")))) +@end smalllisp +@sp 2 + +As you can see from the following source code css and javascript @code{SHOW-TIME} injection are correctly handled and not +duplicated as for the id generations that will not create conflicts. + +@sp 1 +@image{images/idxpage-showtime-src,150mm,,,png} +@sp 2 Modified: trunk/main/claw-html/src/tags.lisp ============================================================================== --- trunk/main/claw-html/src/tags.lisp (original) +++ trunk/main/claw-html/src/tags.lisp Thu Dec 18 12:27:47 2008 @@ -493,7 +493,7 @@ :accessor htcomponent-stylesheet-files :documentation "Page injectable css files") (global-initscripts :initarg :global-initscripts :accessor htcomponent-global-initscripts :documentation "Page injectable javascript class derectives") - (initscripts :initarg :initscript + (initscripts :initarg :initscripts :accessor htcomponent-initscripts :documentation "Page injectable javascript instance derectives. It may be a string or a list of strings") (initstyles :initarg :initstyles :accessor htcomponent-initstyles :documentation "Component injectable css derectives. It may be a string or a list of strings")) @@ -763,7 +763,7 @@ (push current-css tag-list)))) (unless (string= "" init-styles) (let ((current-css (style> :type "text/css"))) - (setf (htcomponent-body current-css) (list init-styles)) + (setf (htcomponent-body current-css) (list "\ " init-styles)) (push current-css tag-list))) tag-list)) @@ -1134,7 +1134,7 @@ (let ((js (script> :type "text/javascript")) (js-control-string (if on-load " -var bodyInitFunction = function\(e){~a~%};~% +var bodyInitFunction = function\(e){~%~a~%};~% if (/MSIE (\\d+\\.\\d+);/.test(navigator.userAgent)) {~% window.attachEvent\('onload', bodyInitFunction);~% } else {~% @@ -1261,17 +1261,9 @@ (when (null previous-print-status) (setf (page-can-print page) (htcomponent-can-print wcomponent))) (when (page-can-print page) - (let ((script-files (htcomponent-script-files wcomponent))) - (dolist (script (if (listp script-files) - script-files - (list script-files))) - (pushnew script (page-script-files page) :test #'equal))) - (let ((css-files (htcomponent-stylesheet-files wcomponent))) - (dolist (css (if (listp css-files) - css-files - (list css-files))) - (pushnew css (page-stylesheet-files page) :test #'equal))) - (dolist (js (htcomponent-global-initscripts wcomponent)) + (dolist (css (listify (htcomponent-stylesheet-files wcomponent))) + (pushnew css (page-stylesheet-files page) :test #'equal)) + (dolist (js (listify (htcomponent-global-initscripts wcomponent))) (pushnew js (page-global-initscripts page) :test #'equal)) (dolist (js (listify (htcomponent-initscripts wcomponent))) (pushnew js (page-initscripts page) :test #'equal))

1 0

[claw-cvs] r159 - in trunk/main: claw-demo/src/frontend/components claw-html.dojo/src claw-html/src
by Andrea Chiumenti 18 Dec '08

18 Dec '08

Author: achiumenti Date: Thu Dec 18 07:46:23 2008 New Revision: 159 Log: bugfixes and initscripts methods renaming Modified: trunk/main/claw-demo/src/frontend/components/edit-customer.lisp trunk/main/claw-demo/src/frontend/components/pager.lisp trunk/main/claw-demo/src/frontend/components/redirect.lisp trunk/main/claw-html.dojo/src/djbody.lisp trunk/main/claw-html.dojo/src/djform.lisp trunk/main/claw-html.dojo/src/djwidget.lisp trunk/main/claw-html/src/packages.lisp trunk/main/claw-html/src/tags.lisp Modified: trunk/main/claw-demo/src/frontend/components/edit-customer.lisp ============================================================================== --- trunk/main/claw-demo/src/frontend/components/edit-customer.lisp (original) +++ trunk/main/claw-demo/src/frontend/components/edit-customer.lisp Thu Dec 18 07:46:23 2008 @@ -70,7 +70,7 @@ when val return t)))) -(defmethod htcomponent-class-initscripts :around ((obj edit-customer)) +(defmethod htcomponent-global-initscripts :around ((obj edit-customer)) (let ((req-function (ps:ps (defun is-address-field-required (container-id) (defvar input-list (dojo.query "[widgetId]" (dojo.by-id container-id))) (defvar result false) @@ -99,7 +99,7 @@ (lambda (input-widget) (setf (slot-value input-widget 'required) false)))))))))) (append (list req-function address-field-validation) (call-next-method)))) -(defmethod htcomponent-instance-initscript :around ((obj edit-customer)) +(defmethod htcomponent-initscripts :around ((obj edit-customer)) (let* ((component-id (htcomponent-client-id obj)) (parent-script (call-next-method)) (script (ps:ps* `(progn Modified: trunk/main/claw-demo/src/frontend/components/pager.lisp ============================================================================== --- trunk/main/claw-demo/src/frontend/components/pager.lisp (original) +++ trunk/main/claw-demo/src/frontend/components/pager.lisp Thu Dec 18 07:46:23 2008 @@ -82,7 +82,7 @@ (div> :class "button last" (span> :on-click (set-offset-value pager count-pages) "last")))))))) -(defmethod htcomponent-class-initscripts ((pager pager)) +(defmethod htcomponent-global-initscripts ((pager pager)) (let ((update-component-id (pager-update-component-id pager)) (page-size (pager-page-size pager))) (list Modified: trunk/main/claw-demo/src/frontend/components/redirect.lisp ============================================================================== --- trunk/main/claw-demo/src/frontend/components/redirect.lisp (original) +++ trunk/main/claw-demo/src/frontend/components/redirect.lisp Thu Dec 18 07:46:23 2008 @@ -34,7 +34,7 @@ :reader redirect-href)) (:metaclass metacomponent)) -(defmethod htcomponent-instance-initscript ((redirect redirect)) +(defmethod htcomponent-initscripts ((redirect redirect)) (ps:ps* `(location.replace ,(redirect-href redirect)))) (defmethod wcomponent-template ((redirect redirect)) Modified: trunk/main/claw-html.dojo/src/djbody.lisp ============================================================================== --- trunk/main/claw-html.dojo/src/djbody.lisp (original) +++ trunk/main/claw-html.dojo/src/djbody.lisp Thu Dec 18 07:46:23 2008 @@ -108,7 +108,7 @@ (htcomponent-body obj) (djxcontent-pane> :static-id id (script> :type "text/javascript" - (page-body-init-scripts pobj)))))) + (page-body-initscripts pobj)))))) (defmethod wcomponent-after-prerender ((obj djbody) (pobj page)) Modified: trunk/main/claw-html.dojo/src/djform.lisp ============================================================================== --- trunk/main/claw-html.dojo/src/djform.lisp (original) +++ trunk/main/claw-html.dojo/src/djform.lisp Thu Dec 18 07:46:23 2008 @@ -55,7 +55,7 @@ (subseq js-array 0 (1- (length js-array)))))))))) -(defmethod htcomponent-instance-initscript ((obj djform)) +(defmethod htcomponent-initscripts ((obj djform)) nil) (defclass djtext-box (cinput djwidget) @@ -283,7 +283,7 @@ :editor editor (wcomponent-informal-parameters obj)))) -(defmethod htcomponent-instance-initscript((obj djinline-edit-box)) +(defmethod htcomponent-initscripts((obj djinline-edit-box)) (let ((id (htcomponent-client-id obj)) (page-url (claw-script-name))) (ps* `(dojo.connect (dijit.by-id ,id) Modified: trunk/main/claw-html.dojo/src/djwidget.lisp ============================================================================== --- trunk/main/claw-html.dojo/src/djwidget.lisp (original) +++ trunk/main/claw-html.dojo/src/djwidget.lisp Thu Dec 18 07:46:23 2008 @@ -57,7 +57,7 @@ (defmethod djwidget-formal-parameters ((djwidget djwidget))()) -(defmethod htcomponent-class-initscripts ((obj djwidget)) +(defmethod htcomponent-global-initscripts ((obj djwidget)) (let ((dojo-type (djwidget-dojo-type obj)) (dojo-require (djwidget-dojo-require obj))) (append Modified: trunk/main/claw-html/src/packages.lisp ============================================================================== --- trunk/main/claw-html/src/packages.lisp (original) +++ trunk/main/claw-html/src/packages.lisp Thu Dec 18 07:46:23 2008 @@ -57,11 +57,11 @@ #:page-req-parameter #:page-script-files #:page-stylesheet-files - #:page-class-initscripts - #:page-instance-initscripts + #:page-global-initscripts + #:page-initscripts #:page-initstyles #:page-current-component - #:page-body-init-scripts + #:page-body-initscripts #:htcomponent #:htcomponent-page #:htcomponent-body @@ -70,8 +70,8 @@ #:htcomponent-real-id #:htcomponent-script-files #:htcomponent-stylesheet-files - #:htcomponent-class-initscripts - #:htcomponent-instance-initscript + #:htcomponent-global-initscripts + #:htcomponent-initscripts #:htcomponent-initstyles #:tag #:tag-name Modified: trunk/main/claw-html/src/tags.lisp ============================================================================== --- trunk/main/claw-html/src/tags.lisp (original) +++ trunk/main/claw-html/src/tags.lisp Thu Dec 18 07:46:23 2008 @@ -108,17 +108,17 @@ - REST The format arguments See http://www.lisp.org/HyperSpec/Body/fun_format.html#format for more info.")) -(defgeneric page-body-init-scripts (page) +(defgeneric page-body-initscripts (page) (:documentation "During the render phase wcomponent instances inject their initialization scripts (javascript) that will be evaluated when the page has been loaded. -This internal method is called to render these scripts. The result is used by the HTBODY-INIT-SCRIPTS-TAG method +This internal method is called to render these scripts. The result is used by the HTBODY-INITSCRIPTS-TAG method that generates a <script> tag that will be appended at the end of the <body> tag (generated by the BODY> function tag. - PAGE is the page instance that must be given")) -(defgeneric htbody-init-scripts-tag (page &optional on-load) +(defgeneric htbody-initscripts-tag (page &optional on-load) (:documentation "Encloses the init inscance scripts injected into the page into a <script> tag component -See PAGE-BODY-INIT-SCRIPTS form more info. If the ON-LOAD parameter it not nil, then the script will be executed +See PAGE-BODY-INITSCRIPTS form more info. If the ON-LOAD parameter it not nil, then the script will be executed on the onload document event. - PAGE is the page instance that must be given")) @@ -285,6 +285,11 @@ `(let ((,var ,form)) (when ,var ,@body))) +(defmacro listify (var) + `(if (listp ,var) + ,var + (list ,var))) + (defun flatten (tree &optional result-list) "Traverses the tree in order, collecting even non-null leaves into a list." (let ((result result-list)) @@ -393,10 +398,10 @@ :accessor page-script-files :documentation "Holds component class scripts files injected by components during the request cycle") (stylesheet-files :initarg :stylesheet-files :accessor page-stylesheet-files :documentation "Holds component class css files injected by components during the request cycle") - (class-initscripts :initarg :class-initscripts - :accessor page-class-initscripts :documentation "Holds component class javascript directives injected by components during the request cycle") - (instancee-initscripts :initarg :instance-initscripts - :accessor page-instance-initscripts :documentation "Holds component instance javascript directives injected by components during the request cycle") + (global-initscripts :initarg :global-initscripts + :accessor page-global-initscripts :documentation "Holds component class javascript directives injected by components during the request cycle") + (initscripts :initarg :initscripts + :accessor page-initscripts :documentation "Holds component instance javascript directives injected by components during the request cycle") (initstyles :initarg :initstyles :accessor page-initstyles :documentation "Holds component class and instance stylesheet directives injected by components during the request cycle") (indent :initarg :indent @@ -440,8 +445,8 @@ :script-files nil :json-component-count 0 :stylesheet-files nil - :class-initscripts nil - :instance-initscripts nil + :global-initscripts nil + :initscripts nil :initstyles nil :indent t :tabulator 0 @@ -486,12 +491,12 @@ :accessor htcomponent-script-files :documentation "Page injectable script files") (stylesheet-files :initarg :stylesheet-files :accessor htcomponent-stylesheet-files :documentation "Page injectable css files") - (class-initscripts :initarg :class-initscripts - :accessor htcomponent-class-initscripts :documentation "Page injectable javascript class derectives") - (instance-initscript :initarg :instance-initscript - :accessor htcomponent-instance-initscript :documentation "Page injectable javascript instance derectives") + (global-initscripts :initarg :global-initscripts + :accessor htcomponent-global-initscripts :documentation "Page injectable javascript class derectives") + (initscripts :initarg :initscript + :accessor htcomponent-initscripts :documentation "Page injectable javascript instance derectives. It may be a string or a list of strings") (initstyles :initarg :initstyles - :accessor htcomponent-initstyles :documentation "Component injectable css derectives")) + :accessor htcomponent-initstyles :documentation "Component injectable css derectives. It may be a string or a list of strings")) (:default-initargs :page nil :body nil :json-render-on-validation-errors-p nil @@ -501,8 +506,8 @@ :render-condition nil :script-files nil :stylesheet-files nil - :class-initscripts nil - :instance-initscript nil + :global-initscripts nil + :initscripts nil :initstyles nil) (:documentation "Base class for all other claw components")) @@ -709,7 +714,7 @@ (when injection (htcomponent-render injection page))) (page-format-raw page "\",instanceInjections:\"") - (let ((init-scripts (htbody-init-scripts-tag page))) + (let ((init-scripts (htbody-initscripts-tag page))) (when init-scripts (htcomponent-render init-scripts page))) (page-format-raw page "\",errors:") @@ -719,8 +724,8 @@ (page-format-raw page "}") (page-format-raw page (page-json-suffix page))))) -(defmethod page-body-init-scripts ((page page)) - (when-let (init-scripts (reverse (page-instance-initscripts page))) +(defmethod page-body-initscripts ((page page)) + (when-let (init-scripts (reverse (page-initscripts page))) (format nil "~{~a~%~}" init-scripts))) (defmethod page-print-tabulation ((page page)) @@ -738,7 +743,7 @@ (defmethod page-init-injections ((page page)) (let ((tag-list) - (class-init-scripts (format nil "~{~a~%~}" (reverse (page-class-initscripts page)))) + (class-init-scripts (format nil "~{~a~%~}" (reverse (page-global-initscripts page)))) (init-styles (format nil "~{~a~%~}" (reverse (page-initstyles page))))) (unless (string= "" class-init-scripts) (let ((current-js (script> :type "text/javascript"))) @@ -1117,15 +1122,15 @@ ((null child-tag) nil) (t (htcomponent-render child-tag page))))) (when (page-can-print page) - (when-let (init-script-tag (htbody-init-scripts-tag page t)) + (when-let (init-script-tag (htbody-initscripts-tag page t)) (htcomponent-render init-script-tag page)) (tag-render-endtag htbody page)) (when (or (page-can-print page) previous-print-status) (setf (page-can-print page) nil) (htcomponent-json-print-end-component htbody))))) -(defmethod htbody-init-scripts-tag ((page page) &optional on-load) - (when-let (scripts (page-body-init-scripts page)) +(defmethod htbody-initscripts-tag ((page page) &optional on-load) + (when-let (scripts (page-body-initscripts page)) (let ((js (script> :type "text/javascript")) (js-control-string (if on-load " @@ -1266,9 +1271,11 @@ css-files (list css-files))) (pushnew css (page-stylesheet-files page) :test #'equal))) - (dolist (js (htcomponent-class-initscripts wcomponent)) - (pushnew js (page-class-initscripts page) :test #'equal)) - (dolist (style (htcomponent-initstyles wcomponent)) + (dolist (js (htcomponent-global-initscripts wcomponent)) + (pushnew js (page-global-initscripts page) :test #'equal)) + (dolist (js (listify (htcomponent-initscripts wcomponent))) + (pushnew js (page-initscripts page) :test #'equal)) + (dolist (style (listify (htcomponent-initstyles wcomponent))) (pushnew style (page-initstyles page) :test #'equal))) (if (listp template) (dolist (tag template)

1 0

[claw-cvs] r158 - trunk/doc/images
by Andrea Chiumenti 17 Dec '08

17 Dec '08

Author: achiumenti Date: Wed Dec 17 14:49:23 2008 New Revision: 158 Log: manual update Added: trunk/doc/images/idxpage-src.png (contents, props changed) Added: trunk/doc/images/idxpage-src.png ============================================================================== Binary file. No diff available.

1 0

[claw-cvs] r157 - trunk/doc/chapters
by Andrea Chiumenti 17 Dec '08

17 Dec '08

Author: achiumenti Date: Wed Dec 17 14:49:02 2008 New Revision: 157 Log: manual update Modified: trunk/doc/chapters/claw-html.texinfo Modified: trunk/doc/chapters/claw-html.texinfo ============================================================================== --- trunk/doc/chapters/claw-html.texinfo (original) +++ trunk/doc/chapters/claw-html.texinfo Wed Dec 17 14:49:02 2008 @@ -167,7 +167,9 @@ (head> (title> "Home test page") (link> :rel "stylesheet" :href "docroot/screen.css" :type "text/css")) - (body> :class "sampleBody" + (body> + :id "theBody" + :class "sampleBody" (div> :class "topHeader" "top header") (div> :class "mainContent" (h1> "Hello world"))))) @@ -269,15 +271,82 @@ (html> (head> (title> title-value)) - (body> (wcomponent-informal-parameters obj) + (body> :static-id (htcomponent-client-id obj) + (wcomponent-informal-parameters obj) (htcomponent-body obj))))) @end smalllisp @sp 2 -Here there are three points to highlight. Firstly the @code{HTCOMPONENT-BODY}, here we are informing the the component will render its child +Here there are three points to highlight. Firstly the @code{HTCOMPONENT-BODY}, here we are informing that the component will render its child at this position. Then the @code{WCOMPONENT-INFORMAL-PARAMETERS} is a method that informs the component to render tag parameters not directly specified into the class specification, making it possible to specify any tag parameter to the tag function. -The last thing to notice is the absence of the link to the css file. This was made because each componoent can inject into the page its own css or js definitions -both at class level and at instance level, that in @code{claw-html} are injected by the component directly into the containing page. -To add a css or a js file at class definition level you have to implement @code{HTCOMPONENT-SCRIPT-FILES} and @code{HTCOMPONENT-STYLESHEET-FILES} while +@code{CALW-HTML} can control the id of each component so that when a component is put into a page, its id is not duplicated. You can avoid this checking using the +@code{STATIC-ID} attribute, so when writing a component you can use the id given to your component through @code{HTCOMPONENT-CLIENT-ID} method an render it into the +component template (or other component methods of course). This is a great point of strenght for @code{claw-html} compared to other frameworks, infact when you put +your component into a collecting loop without beeing worry, about id duplications, a situation that mhight occur for example when creating table row components. + + +The last thing to note is the absence of the link to the css file. This was made because each componoent can inject into the page its own css or js files or definitions. + +To add a css or a js file at class definition level you have to implement @code{HTCOMPONENT-SCRIPT-FILES} and @code{HTCOMPONENT-STYLESHEET-FILES} while to add javascript or +css directives into the page you have to use @code{HTCOMPONENT-CLASS-INITSCRIPTS}, @code{HTCOMPONENT-INSTANCE-INITSCRIPT} and @code{HTCOMPONENT-INITSTYLES} + +In our case it's simply sufficient to override the @code{HTCOMPONENT-STYLESHEET-FILES} method as described + +@sp 2 +@smalllisp +(defmethod htcomponent-stylesheet-files ((obj site-template)) + (list "docroot/screen.css")) +@end smalllisp +@sp 2 + +So now that the site template component is ready for our simple example you can now use it into your previous page; do change +the page-content method definition in the @code{src/index.lisp} file: + +@sp 2 +@smalllisp +(defmethod page-content ((o index-page)) + (site-template> + :id "theBody" + :class "sampleBody" + :title "Home test page" + (div> :class "topHeader" "top header") + (div> :class "mainContent" + (h1> "Hello world")))) +@end smalllisp +@sp 2 + +That will produce the same result of the 'long form' @code{PAGE-CONTENT} implementation! + +So, you may have now no repetitions of the html tag elements between application pages, a shorter @code{PAGE-CONTENT} implementation, +and no problems about forgetting to import common stylesheet files (and .js files if you need one). + +For curiosity here it is the html source output: + +@sp 1 +@image{images/idxpage-src,150mm,,,png} +@sp 2 + +@subsection Component scripts injection + +You have just seen how components can inject css files into your page, as already said for javascript files, this is accomplished by +overriding the component method @code{HTCOMPONENT-SCRIPT-FILES}, nothing more. + +Some words must be spent to describe what happens if you want to inject css dirsctives and javascript commands into the page inside +<style> and <scripts> tags. + +When you want to inject css directives into a <style> tag you have to override @code{HTCOMPONENT-INITSTYLES} method. +This method returns a list of strings (containing css directives). The framework removes uplicate strings and subsequently renders +inside the <head> tag the <style> tag. The removal of duplicates gives you the possibility of using your component inside loops +without being worried about duplicating injection + +When you want to inject javascript commands (and functions too) the story is a slightly different. +Firstly commands are injected into a <script> tag that is positioned as the last <body> tag. + +Then there are two different methods: @code{HTCOMPONENT-CLASS-INITSCRIPTS} and @code{HTCOMPONENT-INSTANCE-INITSCRIPT}. + +@code{HTCOMPONENT-CLASS-INITSCRIPTS} is used to render scripts that are not tied to a particular instance, but come with the component, +it's usually used to render javascript functions and global variabes. + +@code{HTCOMPONENT-INSTANCE-INITSCRIPT} render scripts that are executed on <body> onload event, so no function definitions sould be put inside.

1 0

[claw-cvs] r156 - trunk/main/claw-html/src
by Andrea Chiumenti 17 Dec '08

17 Dec '08

Author: achiumenti Date: Wed Dec 17 14:48:31 2008 New Revision: 156 Log: css injection Modified: trunk/main/claw-html/src/tags.lisp Modified: trunk/main/claw-html/src/tags.lisp ============================================================================== --- trunk/main/claw-html/src/tags.lisp (original) +++ trunk/main/claw-html/src/tags.lisp Wed Dec 17 14:48:31 2008 @@ -281,6 +281,10 @@ "Creates an unflattenable value for tag attributes. This is particularly useful when you need to pass a list as an attribute value" (make-list-for-tag-attribute :value value)) +(defmacro when-let ((var form) &body body) + `(let ((,var ,form)) + (when ,var ,@body))) + (defun flatten (tree &optional result-list) "Traverses the tree in order, collecting even non-null leaves into a list." (let ((result result-list)) @@ -716,10 +720,8 @@ (page-format-raw page (page-json-suffix page))))) (defmethod page-body-init-scripts ((page page)) - (let ((js-body "")) - (dolist (current-js (reverse (page-instance-initscripts page))) - (setf js-body (format nil "~a~%~a~%" js-body current-js))) - (format nil "~@[~a~]" js-body))) + (when-let (init-scripts (reverse (page-instance-initscripts page))) + (format nil "~{~a~%~}" init-scripts))) (defmethod page-print-tabulation ((page page)) (let ((tabulator (page-tabulator page)) @@ -736,16 +738,8 @@ (defmethod page-init-injections ((page page)) (let ((tag-list) - (class-init-scripts "") - (init-styles "")) - (dolist (script (reverse (page-class-initscripts page))) - (setf class-init-scripts (format nil "~a~%~a" - class-init-scripts - script))) - (dolist (style (reverse (page-initstyles page))) - (setf init-styles (format nil "~a~%~a" - init-styles - style))) + (class-init-scripts (format nil "~{~a~%~}" (reverse (page-class-initscripts page)))) + (init-styles (format nil "~{~a~%~}" (reverse (page-initstyles page))))) (unless (string= "" class-init-scripts) (let ((current-js (script> :type "text/javascript"))) (setf (htcomponent-body current-js) class-init-scripts) @@ -889,6 +883,7 @@ (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) + ((null child-tag) nil) (t (htcomponent-render child-tag page))))) (when (null previous-print-status) (setf (page-can-print page) nil) @@ -979,6 +974,7 @@ (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) + ((null child-tag) nil) (t (htcomponent-render child-tag page))))) (when (or (page-can-print page) previous-print-status) (tag-render-endtag tag page)) @@ -1005,6 +1001,7 @@ (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) + ((null child-tag) nil) (t (htcomponent-render child-tag page))))) (dolist (injection injections) (when injection @@ -1062,7 +1059,7 @@ (not (null (htcomponent-body htscript)))) (if (null xml-p) (page-format page "~%//") @@ -1116,32 +1114,33 @@ (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) + ((null child-tag) nil) (t (htcomponent-render child-tag page))))) (when (page-can-print page) - (htcomponent-render (htbody-init-scripts-tag page t) page) + (when-let (init-script-tag (htbody-init-scripts-tag page t)) + (htcomponent-render init-script-tag page)) (tag-render-endtag htbody page)) (when (or (page-can-print page) previous-print-status) (setf (page-can-print page) nil) (htcomponent-json-print-end-component htbody))))) (defmethod htbody-init-scripts-tag ((page page) &optional on-load) - (let ((js (script> :type "text/javascript")) - (js-control-string-directive (if on-load - " -var bodyInitFunction = function\(e){~{~a~%~}};~% + (when-let (scripts (page-body-init-scripts page)) + (let ((js (script> :type "text/javascript")) + (js-control-string (if on-load + " +var bodyInitFunction = function\(e){~a~%};~% if (/MSIE (\\d+\\.\\d+);/.test(navigator.userAgent)) {~% window.attachEvent\('onload', bodyInitFunction);~% } else {~% document.addEventListener\('DOMContentLoaded', bodyInitFunction, false);~% }" - "~{~a~%~}~%")) - (page-body-init-scripts (page-body-init-scripts page))) - (setf (htcomponent-page js) page - (htcomponent-body js) (when page-body-init-scripts - (format nil js-control-string-directive (if (listp page-body-init-scripts) - page-body-init-scripts - (list page-body-init-scripts))))) - js)) + "~a~%"))) + (setf (htcomponent-page js) page + (htcomponent-body js) (format nil + js-control-string + scripts)) + js))) ;;;========= WCOMPONENT =================================== (defclass wcomponent (htcomponent) @@ -1299,6 +1298,7 @@ (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) + ((null child-tag) nil) (t (htcomponent-render child-tag page))))) (wcomponent-after-render wcomponent page) (when (null previous-print-status)

1 0