From xlopez at common-lisp.net Fri Nov 14 21:17:43 2008 From: xlopez at common-lisp.net (Xan Lopez) Date: Fri, 14 Nov 2008 21:17:43 +0000 Subject: [ht-ajax-cvs] r1 - doc static test Message-ID: Author: xlopez Date: Fri Nov 14 21:17:43 2008 New Revision: 1 Log: Initial commit, version 0.0.7. Added: ChangeLog LICENSE doc/ doc/ht-ajax.html ht-ajax-test.asd ht-ajax.asd ht-ajax.lisp join-strings.lisp jsmin.lisp optimization.lisp packages.lisp processor-dojo.lisp processor-lokris.lisp processor-prototype.lisp processor-simple.lisp processor-yui.lisp static/ static/lokris.js static/prototype.js test/ test/packages.lisp test/test-ajax.tmpl.html test/test-ht-ajax.lisp utils.lisp version.lisp Added: ChangeLog ============================================================================== --- (empty file) +++ ChangeLog Fri Nov 14 21:17:43 2008 @@ -0,0 +1,25 @@ +* HT-AJAX ChangeLog +** Version 0.0.7 <2007-03-08> +**** Fixed bug in jsmin.lisp + +** Version 0.0.6 <2007-02-20> +**** Added unexport function +**** Added the "virtual .js file" feature +**** Code reorganization +**** Changed the JS-FILE-URI parameter to JS-FILE-URIS +**** Added support for Yahoo UI library +**** Support for returning complex objects to Javascript with JSON + +** Version 0.0.5 /unreleased/ +**** Added error calbacks to the public interface +**** Added the option to compress the generated Javascript + to minimize the download size +**** Processor for Dojo Toolkit ( http://dojotoolkit.org/ ) + +** Version 0.0.4 <2007-02-09> +**** Applied patch by Pierre THIERRY for better control over + Javascript debugging +**** Code & documentation cleanups + +** Version 0.0.3 <2007-02-05> +**** Added Prototype processor Added: LICENSE ============================================================================== --- (empty file) +++ LICENSE Fri Nov 14 21:17:43 2008 @@ -0,0 +1,29 @@ +Copyright (c) 2007, Ury Marshak +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of the author(s) nor the names of contributors + may be used to endorse or promote products derived from this + software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Added: doc/ht-ajax.html ============================================================================== --- (empty file) +++ doc/ht-ajax.html Fri Nov 14 21:17:43 2008 @@ -0,0 +1,523 @@ + + + + + + HT-AJAX - Common Lisp AJAX framework for Hunchentoot + + + + + + + + +

HT-AJAX - AJAX framework for Hunchentoot

+ +
+
 

Abstract

+ +

+HT-AJAX is a small Common Lisp framework that is designed to ease dynamic +interaction of your web pages with the server. It runs under the +Hunchentoot web server by Dr. Edi Weitz. +

+ +

+Basically it allows 'exporting' of your lisp functions so that they can be easily called +from the Javascript code on your web page. The details of the data transfer can be +handled by different backends, or as we'll call them 'AJAX processors'. At the moment three +such processors are supported: one simple, built-in, that generates code inside the +web page and does not require external libraries. The others are using a javascript +library, such as +Prototype or +Dojo +(full list). +

+ +

+The code comes with +a BSD-style +license so you can basically do with it whatever you want. +

+ +

+Download shortcut: http://85.65.214.241/misc/ht-ajax.tar.gz. +

+
+ +
 

Contents

+
    +
  1. Download and installation
    2. +
  2. Support
    3. +
  3. Getting started (mini-tutorial)
    4. +
  4. Choosing the right ajax-processor
    5. +
  5. Using the generated Javascript functions
    6. +
  6. The HT-AJAX dictionary +
      +
    1. make-ajax-processor
      2. +
    2. export-func
      3. +
    3. unexport-func
      4. +
    4. defun-ajax
      5. +
    5. generate-prologue
      6. +
    6. get-handler
      7. +
    +
    7. +
  7. Supported Javascript libraries
    8. +
  8. Portability
    9. +
  9. Notes
    10. +
  10. Acknowledgements
    11. +
+ +
 

Download and installation

+ +HT-AJAX together with this documentation can be downloaded from +http://85.65.214.241/misc/ht-ajax.tar.gz. +The current version is 0.0.7 . + +
+If you have ASDF-Install working you can use +it to install HT-AJAX: +
+(require 'asdf-install)
+(asdf-install:install :ht-ajax)
+
+ +
+Otherwise, download and untar the distribution and use the normal procedure for your system to +install a library that comes with an ASDF system definition. For example, make an appropriate +symbolic link to the ht-ajax.asd file and run +
(require 'asdf)
+(asdf:oos 'asdf:load-op :ht-ajax)
+ +
 

Support

+

Questions, bug reports, requests, criticism and just plain information that you found +this package useful (or useless) are to be sent to +urym@two-bytes.com + +

+ +
 

Getting started (mini-tutorial)

+

In this tutorial we assume that the reader is reasonably familiar with Hunchentoot +and AJAX.

+ + +

So, let's suppose we already have some lisp code working under Hunchentoot and start +modifying it to use AJAX. +Note that normally we'll (use-package :ht-ajax), so that we won't have to prefix +the symbols with ht-ajax:, but here we'll still do it to show clearly which symbols +come from the HT-AJAX package.

+ + +

At first some setup:

+
+(defparameter *ajax-handler-url* "/hunchentoot/some/suitable/uri/ajax-hdlr")
+
+

Here we select some URL that will handle our AJAX requests. Later we'll need to arrange +for an appropriate handler to be called when we get a request for this URL (and all +URLs starting with it). Replace the URL with whatever makes sense for your application

+ +

+

After this we create an instance of so-called ajax-processor that will handle all our +AJAX needs. One ajax-processor per application should be enough. We pass the following +parameters: :type :lokris to select which backend to use, in this case it's +the Lokris library. Also we pass the +:server-uri that we've selected and the :js-file-uris that shows where +to find the appropriate library file, lokris.js in this case (the URL may be relative +to the URL of the page):

+
+(defparameter *ajax-processor* (ht-ajax:make-ajax-processor
+                                :type :lokris
+                                :server-uri *ajax-handler-url*
+                                :js-file-uris "static/lokris.js"))
+
+ +
+ +

Now we create the function that we want to be called from the web page:

+
+(ht-ajax:defun-ajax testfunc (command) (*ajax-processor* :method :post)
+    (prin1-to-string (eval (read-from-string command nil))))
+
+

We've used here the defun-ajax macro that performs two tasks: defines the function +as per defun and 'exports' it - makes available to the web page's javascript. +This fragment could've been written more verbosely as:

+
+(defun testfunc (command)
+    (prin1-to-string (eval (read-from-string command nil))))
+
+(ht-ajax:export-func *ajax-processor* 'testfunc :method :post)
+
+

The function itself contains the code to evaluate the string parameter command +and return the result as a string. (It's possible to return more complex objects to the +Javascript code by using JSON). +While processig the request HT-AJAX will call Hunchentoot's function +no-cache to make sure the browser +will make a request to the server each time and not cache the results, so we don't have to +do it here. If we want to manually control the caching we can pass :allow-cache t +parameter when exporting the function. +

+ +

The only thing left to prepare the server side of the things +is to create the dispatcher for our *ajax-handler-url* and to add it to +Hunchentoot's dispatch table. The specifics of this can vary, but it might include something +like: +

+
(create-prefix-dispatcher *ajax-handler-url* (ht-ajax:get-handler *ajax-processor*)
+
+

The call to (ht-ajax:get-handler *ajax-processor*) returns the handler that the +handler URL +needs to be dispatched to.[1]

+
+

Now we need to make sure that the dynamic web pages we generate are correctly set up. +This means that the result of the call (ht-ajax:generate-prologue *ajax-processor*) +needs to be inserted somewhere in the HTML page (right after the <body> tag +seems like +a good place). Once again how to do this depends on the facilities that are used for HTML +generation. +For example when using HTML-TEMPLATE we'll have +something like the following in our template:

+
+<body>
+<!-- TMPL_VAR prologue -->
+
+

and then pass the output of (ht-ajax:get-handler *ajax-processor*) as the +prologue parameter to the fill-and-print-template call.[2]

+ +

After that, whatever means for HTML generation we're using, let's put the following HTML +somewhere in the page:

+
+
+<table width="50%">
+  <tr>
+    <td colspan="2">
+      <span id="result"> <i>no results yet</i>
+      </span>
+    </td>
+  </tr>
+  <tr>
+    <td width="70%">
+      <input type="text" size="70" name="command" id="command" />
+    </td>
+    <td>
+      <input type="button" value="Eval" onclick="javascript:command_clicked();"/>
+    </td>
+  </tr>
+</table>
+
+
+ +

This will produce something like:

+
+ + + + + + + + +
+ no results yet + +
+ + + +
+
+ +
+Now write into the template the javascript function that will be called when you click the +button: +
+<script type="text/javascript">
+function command_clicked(txt) {
+// get the current value of the text input field
+var command = document.getElementById('command').value;
+
+// call function testfunc on the server with the parameter
+// command and set the element with the id 'result' to the return
+// value of the function
+ajax_testfunc_set_element('result', command); 
+}
+</script>
+
+

The function ajax_testfunc_set_element that we call here was generated for us by +HT-AJAX. +It takes one required parameter - the id of the element that we want to be set to the result of +the remote call. All other parameters will be passed to corresponding exported lisp function, +testfunc in this case (watch out for the number of arguments). The resulting string will +be assigned to the .innerHTML property of the element with the id 'result'. +

+ +
+ +

This is it. Now to save the files, compile the lisp code, make sure the +Hunchentoot server is started and open the web page in the browser. +Enter something like (+ 1 42) in the text field and click 'Eval'. +If all's well the results of the evaluation will be displayed.

+ +
+ + + +
 

Choosing the right ajax-processor

+

If one of the supported libraries +(like Prototype) is +already used in Javascript code then the decision is is easy - use the appropriate ajax-processor. +Otherwise consider if you need to make server calls using HTTP GET or POST method. If GET works +for you then SIMPLE may be enough, otherwise for POST method use Lokris. +

+ +
 

Using the generated Javascript functions

+

+Exporting the function (and later including the result of the GENERATE-PROLOGUE call in the +web page) makes available two functions for the Javascript code on the page. Assuming the +exported function was called TESTFUNC and the standard prefix (ajax_) was used they are: +

+
+ajax_testfunc_callback(callback_specification, [params for the server's TESTFUNC....])
+
+and +
+ajax_testfunc_set_element(element_id, [params for the server's TESTFUNC....])
+
+

+Both functions will call the server-side function TESTFUNC, the ajax_testfunc_callback +version will call the provided callback function with the result of the server call +as a single parameter, the ajax_testfunc_set_element version with find the document +element with the id element_id and set it's innerHTML to the result of the +server call.
+The result of the server call is normally a string and is passed to the callback as-is, +unless the Content-Type header was set to application/json which is the +official IANA +media type. In case of JSON the result is evaluated using "unsafe" +[3] eval +call and the resulting object is passed to the callback. +
+

+

+The callback_specification parameter can be used +to specify two kinds of callacks (at the same time). The success callback function will +be called +after a successful interaction with the server and passed the server call result +as a parameter. The error callback function will be called in case of an error +and passed a string with the information about the error. +
So the callback_specification can take the following forms:

+ + + +
 

The HT-AJAX dictionary

+ + + + +


[Function]
make-ajax-processor &rest rest &key type &allow-other-keys => new-ajax-processor

+

+ +Creates an ajax-processor object. Parameters:
+ TYPE - selects the kind of ajax-processor to use (should be + one of:SIMPLE or :LOKRIS, :PROTOTYPE, :YIU or :DOJO) (required).
+ SERVER-URI - url that the ajax function calls will use (required).
+ JS-FILE-URIS - a list of URLs on your server of the .js files that the + used library requires , such as lokris.js or prototype.js + (parameter required for all processors except :SIMPLE). If + only one file needs to be included then instead of a list a single + string may be passed. Also if this parameter is a string that ends + in a forward slash ( #\/ ) then it is assumed to be a directory + and the default file names for the processor are appended to it.
+ AJAX-FUNCTION-PREFIX - the string to be prepended to the generated js functions, + (default prefix is "ajax_").
+ JS-DEBUG - enable the Javascript debugging function debug_alert(). Overrides + such parameters as JS-COMPRESSION and VIRTUAL-FILES.
+ JS-COMPRESSION - enable Javascript compression of the generated code + to minimize the download size.
+ VIRTUAL-JS-FILE - enable creation of virtual Javascript file instead of + inline Javascript code that may be + cached on the client to minimize traffic.
+
+ + + + + + +


[Generic function]
export-func processor funcallable &key method name content-type allow-cache =>|

+

+ +Makes the function designated by FUNCALLABLE exported (available to call from js) +Parameters:
+ METHOD - :get (default) or :post (:post is not supported under SIMPLE processor).
+ NAME - export the function under a different name.
+ CONTENT-TYPE - Value of Content-Type header so set on the reply + (default: text/plain).
+ ALLOW-CACHE - (default nil) if true then HT-AJAX will not call NO-CACHE function and + allow to control cache manually.
+ JSON - (default nil) if true, the function returns a JSON-encoded object that will + be decoded on the client and passed to the callback as an object
+
+Exporting the function (and later including the result of the GENERATE-PROLOGUE call in the +web page) makes available two functions for the Javascript code on the page: +ajax_testfunc_callback and ajax_testfunc_set_element. See +"Using the generated Javascript functions" +for more details. +
+ + + + + +


[Generic function]
unexport-func processor symbol-or-name =>|

+

+ +Removes the previously exported function, should be called +with either the name (string) under which it was exported or the symbol +designating the function + +
+ + + + + + +


[Macro]
defun-ajax name params (processor &rest export-args) declaration* statement*

+

+ +Macro, defining a function exported to AJAX +Example: (defun-ajax func1 (arg1 arg2) (*ajax-processor*) + (do-stuff)) + +
+ + + + + + +


[Generic function]
generate-prologue processor &key use-cache => html-prologue

+

+ +Generates the necessary HTML+JS to be included in the web page. +Provides caching if USE-CACHE is true (default). + +
+ + + + + + +


[Generic function]
get-handler processor => handler

+

+ +Get the hunchentoot handler for AJAX url. +The url that was passed as the SERVER-URI parameter (and all URLs starting with it) +should be dispatched to this handler. + +
+ + + + +
 

Supported Javascript libraries

+ + + +
 

Portability

+

At the moment HT-AJAX is known to run on SBCL and Lispworks, but it aims to be +portable across all the implementations Hunchentoot runs on. Please report all incompatibilities. +

+ +
 

Notes

+

[1] +When not using CREATE-PREFIX-DISPATCHER, note that not only the SERVER-URI itself +but also all the URLs starting with it need to be dispatched to the handler in order for +"virtual .js files" mechanism to function. +

+ +

[2] +By default HTML-TEMPLATE escapes some characters while expanding. In the case of the prologue of +HT-AJAX there's no need to do it since HT-AJAX already wraps the generated Javascript code in the +proper CDATA sections (which also makes it possible to generate documents compliant with for +example XHTML Strict requirements). So one of the options is to wrap the template expansion +in the following binding: +

+ +
+(let ((*string-modifier* #'CL:IDENTITY))
+      ...template expansion...  )
+
+
+ +

[3] +The word "unsafe" means that it might not be generally safe to evaluate +arbitrary Javascript code coming from an untrusted source; in our case it's ok since +we control both the client and the server. +

+ +
 

Acknowledgements

+ +

+This documentation was prepared with the help of +DOCUMENTATION-TEMPLATE +by Edi Weitz (the code was hacked to run on SBCL).
+The initial inspiration for the SIMPLE processor came from Richard Newman's CL-AJAX which is designed for use with Araneida. +

+ +
+Back to the Lisp page +
+

+;;; Copyright (c) 2007, Ury Marshak +
+

+ + Added: ht-ajax-test.asd ============================================================================== --- (empty file) +++ ht-ajax-test.asd Fri Nov 14 21:17:43 2008 @@ -0,0 +1,18 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; +;;; Copyright (c) 2007, Ury Marshak +;;; The code comes with a BSD-style license, so you can basically do +;;; with it whatever you want. See the file LICENSE for details. +;;; + + +(asdf:defsystem :ht-ajax-test + :description "Test files for HT-AJAX" + :version "0.0.1" + :serial t + :components ((:module "test" + :serial t + :components ( (:file "packages") + (:file "test-ht-ajax")))) + :depends-on (:html-template + :ht-ajax)) Added: ht-ajax.asd ============================================================================== --- (empty file) +++ ht-ajax.asd Fri Nov 14 21:17:43 2008 @@ -0,0 +1,27 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; +;;; Copyright (c) 2007, Ury Marshak +;;; The code comes with a BSD-style license, so you can basically do +;;; with it whatever you want. See the file LICENSE for details. +;;; + + +(asdf:defsystem :ht-ajax + :description "AJAX for Hunchentoot" + :version "0.0.7" + :serial t + :components ((:file "packages") + (:file "optimization") + (:file "version") + (:file "jsmin") + (:file "ht-ajax") + (:file "utils") + (:file "join-strings") + (:file "processor-simple") + (:file "processor-lokris") + (:file "processor-prototype") + (:file "processor-dojo") + (:file "processor-yui") + ) + :depends-on (:hunchentoot + :cl-ppcre)) Added: ht-ajax.lisp ============================================================================== --- (empty file) +++ ht-ajax.lisp Fri Nov 14 21:17:43 2008 @@ -0,0 +1,342 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; +;;; Copyright (c) 2007, Ury Marshak +;;; The code comes with a BSD-style license, so you can basically do +;;; with it whatever you want. See the file LICENSE for details. +;;; + +(in-package #:ht-ajax) + +(declaim #.*optimization*) + +;; + +(defclass ajax-processor () + ((exported-funcs :initform nil :accessor exported-funcs) + (server-uri :initarg :server-uri :accessor server-uri) + (hunchentoot-handler :accessor hunchentoot-handler) + (cached-prologue :accessor cached-prologue :initform nil) + (js-debug :accessor js-debug :initarg :js-debug :initform nil) + (js-compression :accessor js-compression :initarg :js-compression :initform nil) + (ajax-function-prefix :initarg :ajax-function-prefix + :accessor ajax-function-prefix :initform "ajax_") + (default-content-type :initarg :default-content-type + :accessor default-content-type :initform "text/plain; charset=\"utf-8\"") + (default-reply-external-format :initarg :default-reply-external-format + :accessor default-reply-external-format :initform hunchentoot::+utf-8+) + (virtual-js-file :initarg :virtual-js-file + :accessor virtual-js-file :initform nil) + (virtual-files :accessor virtual-files :initform nil)) + + (:documentation "The class containing all ajax-related handling")) + + +(defmethod initialize-instance :after ((processor ajax-processor) &key) + (setf (exported-funcs processor) (make-hash-table :test 'equal)) + (unless (and (slot-boundp processor 'server-uri) + (server-uri processor)) + (error "Initializing AJAX-PROCESSOR without SERVER-URI."))) + + +;; + + +(defgeneric handle-request (processor) + (:documentation "Process the incoming request from hunchentoot")) + + +(defgeneric export-func (processor funcallable + &key method name content-type allow-cache) + (:documentation "Makes the function designated by FUNCALLABLE exported (available to call from js) +Parameters: + METHOD - :get (default) or :post (:post is not supported under SIMPLE processor) + NAME - export the function under a different name + CONTENT-TYPE - Value of Content-Type header so set on the reply (default: text/plain) + ALLOW-CACHE - (default nil) if true then HT-AJAX will not call NO-CACHE function and + allow to control cache manually + JSON - (default nil) if true, the function returns a JSON-encoded object that will + be decoded on the client and passed to the callback +")) + +(defgeneric unexport-func (processor symbol-or-name) + (:documentation "Removes the previously exported function, should be called +with either the name (string) under which it was exported or the symbol +designating the function")) + + +(defmacro defun-ajax (name params (processor &rest export-args) &body body) + "Macro, defining a function exported to AJAX +Example: (defun-ajax func1 (arg1 arg2) (*ajax-processor*) + (do-stuff))" + (let ((f (gensym))) + `(let ((,f (defun ,name ,params , at body))) + (if ,f (export-func ,processor ',name , at export-args))))) + + +(defgeneric generate-prologue (processor &key use-cache) + (:documentation "Generates the necessary HTML+JS to be included in the web page. +Provides caching if USE-CACHE is true (default)")) + + +(defgeneric %generate-includes (processor) + (:documentation "Internal generic function to be implemented in specific +ajax processor")) + +(defgeneric %generate-js-code (processor) + (:documentation "Internal generic function to be implemented in specific +ajax processor")) + + +(defgeneric get-handler (processor) + (:documentation "Get the hunchentoot handler for AJAX url. +The url that was passed as the SERVER-URI parameter should be +dispatched to this handler.")) + + +(defgeneric reset-prologue-cache (processor) + (:documentation "")) + + +(defgeneric js-function-name (processor function-name) + (:documentation "")) + +(defgeneric prepare-js-ajax-function (processor fun-name js-fun-name + &rest rest &key method &allow-other-keys) + (:documentation "")) + +;;; + +(defmethod export-func ((processor ajax-processor) funcallable + &key (method :get) name content-type allow-cache json) + (let ((func-name (or name + (when (symbolp funcallable) + (symbol-name funcallable))))) + (unless func-name + (error "Name not provided for ~A" funcallable)) + + (setf (gethash (string-upcase func-name) (exported-funcs processor)) + `(:funcallable ,funcallable + :method ,method + :content-type ,content-type + :allow-cache ,allow-cache + :json ,json)) + (reset-prologue-cache processor) + (values))) + + +(defmethod unexport-func ((processor ajax-processor) symbol-or-name) + (let ((func-name (or (when (symbolp symbol-or-name) + (symbol-name symbol-or-name)) + symbol-or-name))) + (unless (and func-name + (stringp func-name)) + (error "Invalid name ~S in UNEXPORT-FUNC" symbol-or-name)) + + (remhash (string-upcase func-name) (exported-funcs processor)) + (reset-prologue-cache processor) + (values))) + + + +(defmethod handle-request ((processor ajax-processor)) + ;; See if it's a request for a virtual .JS file + (let ((virtual-file-result (handle-virtual-file processor))) + (when virtual-file-result + (return-from handle-request virtual-file-result))) + + ;; Not a vitual file, process as a function call + (let ((func-name (parameter "ajax-fun")) + (num-args (parameter "ajax-num-args"))) + (unless (and func-name num-args) + (error "Error in HANDLE-REQUEST: required parameters missing")) + + (let* ((args (loop for i from 0 below (parse-integer num-args) + for arg-name = (concatenate 'string "ajax-arg" (princ-to-string i)) + for arg = (parameter arg-name) + collect arg)) + (funcallable-plist (gethash func-name (exported-funcs processor))) + (funcallable (getf funcallable-plist :funcallable))) + (unless funcallable + (error "Error in HANDLE-REQUEST: no such function: ~A" func-name)) + + (let ((content-type (getf funcallable-plist :content-type))) + ;; Can't use the default parameter of getf since it may be present but null + (setf (content-type) (or content-type + (when (getf funcallable-plist :json) (json-content-type)) + (default-content-type processor)))) + (when (default-reply-external-format processor) + (setf (reply-external-format) (default-reply-external-format processor))) + (unless (getf funcallable-plist :allow-cache) + (no-cache)) + + (apply funcallable args)))) + + +(defun handle-virtual-file (processor) + (let* ((file-name (string-downcase (script-name))) + (file-record (assoc file-name (virtual-files processor) :test 'equal))) + (when file-record + (let ((time (cddr file-record))) + (handle-if-modified-since time) ; Does not return if the file was not modified + + (setf (content-type) "text/javascript") + (setf (header-out "Last-Modified") (rfc-1123-date time)) + ;;(setf (header-out "Expires") (rfc-1123-date (+ time #.(* 60 60 2)))) + (cadr file-record))))) + + +(defun store-virtual-js-file (processor file-contents) + "Makes a new unique name for a file, makes an alist of file name and a cons of +contents and time, stores the alist in the processor's slot and returns the +file name" + (let ((file-name (string-downcase (concatenate 'string + (server-uri processor) + "/" + (symbol-name (gensym)) + ".js")))) + (setf (virtual-files processor) (list (cons file-name + (cons file-contents (get-universal-time))))) + file-name)) + + +(defmethod get-handler ((processor ajax-processor)) + (if (slot-boundp processor 'hunchentoot-handler) + (hunchentoot-handler processor) + (setf (hunchentoot-handler processor) #'(lambda () + (handle-request processor))))) + + +(defun make-ajax-processor (&rest rest &key (type :simple) &allow-other-keys) + "Creates an ajax-processor object. Parameters: + TYPE - selects the kind of ajax-processor to use (should be + one of:SIMPLE or :LOKRIS, :PROTOTYPE, :YUI or :DOJO) (required) + SERVER-URI - url that the ajax function calls will use (required) + JS-FILE-URIS - a list of URLs on your server of the .js files that the + used library requires , such as lokris.js or prototype.js + (parameter required for all processors except :SIMPLE). If + only one file needs to be included then instead of a list a single + string may be passed. Also if this parameter is a string that ends + in a forward slash ( #\/ ) then it is assumed to be a directory + and the default file names for the processor are appended to it. + AJAX-FUNCTION-PREFIX - the string to be prepended to the generated js functions, + (default prefix is \"ajax_\") + JS-DEBUG - enable the Javascript debugging function debug_alert(). Overrides + such parameters as JS-COMPRESSION and VIRTUAL-FILES + JS-COMPRESSION - enable Javascript compression to minimize the download size + VIRTUAL-JS-FILE - enable creation of virtual Javascript file instead of + inline Javascript code that may be cached on the client to + minimize traffic + " + (let ((params (copy-seq rest))) + (remf params :type) + + ;; make a class name depending on TYPE and create an instance + (let* ((class-name (concatenate 'string (symbol-name type) "-ajax-processor")) + (class-sym (intern (string-upcase class-name) #.*package*))) + (apply #'make-instance class-sym params)))) + + +(defmethod generate-prologue ((processor ajax-processor) &key (use-cache t)) + (let ((cached-prologue (cached-prologue processor))) + (if (and cached-prologue use-cache) + cached-prologue + (let ((prologue (%generate-includes processor)) + (js-code (%generate-js-code processor))) + + (when (and (js-compression processor) (js-debug processor)) + (setf (js-compression processor) nil) + (warn "JS-COMPRESSION conflicts with JS-DEBUG, JS-COMPRESSION disabled.")) + + (when (js-compression processor) + (setf js-code (jsmin js-code))) + + (when (and (virtual-js-file processor) (js-debug processor)) + (setf (virtual-js-file processor) nil) + (warn "VIRTUAL-JS-FILE conflicts with JS-DEBUG, VIRTUAL-JS-FILE disabled.")) + + (if (virtual-js-file processor) + ;; Create a virtual file and use a link to it + (let ((file-name (store-virtual-js-file processor js-code))) + (setf prologue (concatenate 'string + "" + prologue + (prepare-js-file-include file-name)))) + ;; Not using virtual file, create inline +GET COUNTER +
+text + +
+ +
+
+ + + + + + + + +
+ no results yet + +
+ + + +
+ +
+ + + + +
+ +

Test JSON

+
+ + + + + + + + + + + +
 object.pobject.p[3]
Click here  
+
+ + +
+

This is just a test page

+
+ + Added: test/test-ht-ajax.lisp ============================================================================== --- (empty file) +++ test/test-ht-ajax.lisp Fri Nov 14 21:17:43 2008 @@ -0,0 +1,143 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; +;;; Copyright (c) 2007, Ury Marshak +;;; The code comes with a BSD-style license, so you can basically do +;;; with it whatever you want. See the file LICENSE for details. +;;; + +(in-package #:ht-ajax-test) + +(declaim (optimize (space 0) (speed 0) (safety 3) (debug 3))) + + +(defvar *this-file* (load-time-value + (or #.*compile-file-pathname* *load-pathname*))) + +(defvar *this-dir* (make-pathname :host (pathname-host *this-file*) + :device (pathname-device *this-file*) + :directory (pathname-directory *this-file*))) + + +;; (defmacro debug-output (value) +;; `(ignore-errors +;; (swank::with-connection ((swank::default-connection)) (print ,value)))) + + + +;; +(defparameter +templates-root+ (namestring *this-dir*)) + +(defparameter +web-root-base+ "/hunchentoot/test") +(defparameter +web-root+ (concatenate 'string +web-root-base+ "/")) +(defparameter +static-web-root+ (concatenate 'string +web-root+ "static/")) + +(defparameter +ajax-handler-url+ (concatenate 'string +web-root+ "ajax-hdlr")) + +(defparameter +static-files-root+ (concatenate 'string +templates-root+ "../static/")) + + + +;; +(defun expand-web-addr (short-addr) + (concatenate 'string +web-root+ short-addr )) + + +(defun expand-template (templ-short-name &optional args) + (let ((templ-full-name (merge-pathnames templ-short-name +templates-root+))) + (with-output-to-string (*default-template-output*) + (funcall #'fill-and-print-template templ-full-name args :external-format :utf-8)))) + + +(defun expand-template-with-prologue (templ-short-name &optional args prologue) + (let ((page (expand-template templ-short-name args))) + (regex-replace "(?s)]*>" page (list :match prologue)))) + +;; + + +(defparameter *ajax-processor* (ht-ajax:make-ajax-processor + :type :prototype + :server-uri +ajax-handler-url+ + :js-file-uris "static/" + :js-debug nil + :js-compression t + :virtual-js-file t)) + + +;; + + +(defun test () + (no-cache) +;; (setf (content-type) "text/html; charset=utf-8") +;; (setf (reply-external-format) hunchentoot::+utf-8+) + + (expand-template-with-prologue "test-ajax.tmpl.html" '() + (ht-ajax:generate-prologue *ajax-processor*))) + + +(let ((counter 0)) + (ht-ajax:defun-ajax get-counter () (*ajax-processor*) + (concatenate 'string + "" "counter: " + (princ-to-string (incf counter)) + ""))) + + +(ht-ajax:defun-ajax testfunc (command) (*ajax-processor* :method :post) + (prin1-to-string (handler-case (eval (read-from-string command nil)) + (error (c) (format nil "~A" c))))) + + +(ht-ajax:defun-ajax testjson () (*ajax-processor* :method :get + :json t) + "{\"p\":[1,2,3,5,7,11]}") + + +;; + +(defun string-starts-with (string prefix) + ;; (from Hunchentoot) + (let ((mismatch (mismatch string prefix :test #'char=))) + (or (null mismatch) + (>= mismatch (length prefix))))) + +;; +(defun page404 () + (no-cache) + (setf (return-code *reply*) +http-not-found+) + (throw 'handler-done nil)) + + +(defparameter +urls-alist+ '(("test" . test)) ) + + +(defun serve-static () + "Handle a request for a file under static/ directory" + (let* ((script-name (script-name)) + (fname (subseq script-name (length +static-web-root+))) + (fullname (concatenate 'string +static-files-root+ fname))) + (handle-static-file fullname))) + + +(defun dispatch (request) + (let ((script-name (script-name request))) + (cond + ((or (string-equal script-name +web-root-base+) + (string-equal script-name +web-root+)) 'root-url) ; go to the start page + ((string-starts-with script-name +ajax-handler-url+) ; process AJAX requests + (ht-ajax:get-handler *ajax-processor*)) + ((not (string-starts-with script-name +web-root+)) nil) ; do not handle this request + ((string-starts-with script-name +static-web-root+) 'serve-static) ; serve static file + + (t ; normal processing + (let* ((name (subseq script-name (length +web-root+))) + (handler (assoc name +urls-alist+ :test #'string-equal))) + + (if handler + (cdr handler) + 'page404)))))) + + + +(pushnew 'dispatch *dispatch-table* :test #'eq) Added: utils.lisp ============================================================================== --- (empty file) +++ utils.lisp Fri Nov 14 21:17:43 2008 @@ -0,0 +1,206 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; +;;; Copyright (c) 2007, Ury Marshak +;;; The code comes with a BSD-style license, so you can basically do +;;; with it whatever you want. See the file LICENSE for details. +;;; + +(in-package #:ht-ajax) + +(declaim #.*optimization*) + + +;; +;; Common functions +;; + +(defun make-safe-js-name (function-name) + "Primitive function to try to turn rich lisp names into suitable + for Javascript" + (loop for c across "-<>" + do (setf function-name (substitute #\_ c function-name)) + finally (return function-name))) + + +(defun prepare-js-debug-function (processor) + "Output the debugging function." + (concatenate 'string " +function debug_alert(text) {" + (when (js-debug processor) + " alert(\"HT-AJAX: \" + text);" ) + "} +")) + + +;; (defun js-string-to-boolean (str) +;; (when str +;; (not (or (string= str "") +;; (string= str "null") +;; (string= str "false") +;; (string= str "0")) +;; ))) + + + +;; (defun entity-escape (s) +;; (setf s (regex-replace-all "(?s)&" s "&")) +;; (setf s (regex-replace-all "(?s)<" s "<")) +;; (setf s (regex-replace-all "(?s)>" s ">")) +;; ) + + + +(defun prepare-js-collect-varargs-to-array (num-standard-args &optional (array-name "args")) + (let ((start_args (symbol-name (gensym))) + (end_args (symbol-name (gensym))) + (i (symbol-name (gensym)))) + (concatenate 'string + " + var " start_args " = " (princ-to-string num-standard-args) "; + var " end_args " = arguments.length; + + var " array-name " = new Array(); + var " i " = " start_args "; + for (var " i "=" start_args "; " i " < " end_args "; ++" i ") + " array-name ".push(arguments[" i "]); +" ))) + + +(defun prepare-js-ajax-encode-args () + ;; + " +function ajax_encode_args(func, args) { + var res = 'ajax-fun=' + encodeURIComponent(func); + var i; + if (args) + for (i = 0; i < args.length; ++i) { + res = res + '&ajax-arg' + i + '=' + encodeURIComponent(args[i]); + } + res = res + '&ajax-num-args=' + args.length; + + res = res + '&ajax-xml=false'; + + return res; +} +") + + +(defun wrap-js-in-script-tags (js) + (concatenate 'string + " + +" )) + + + +(defun prepare-js-file-include (js-file-uri) + (concatenate 'string + "")) + + +(defun prepare-js-parse-callbacks () + "Create a Javascript function that receives a specification for + callbacks and returns an array of two functions, the first is the + success callback and the second is the error callback. The callback + specification may be: + Function. It is assumed to be the success callback, the error callback + is assumed to be null + Array. Returned as is, i.e. it should be [success_callback, error_callback] + Object. If the object has a success property it is used as success callback. + The error property if present becomes the error callback." + ;; + " +function ajax_parse_callbacks(obj) { + if (typeof obj === 'function') { + return [obj, null]; + } + if (typeof obj === 'object' && typeof obj.length === 'number') { + // array + return obj; + } + var error_callback = null; + var success_callback = null; + if (obj.error !== undefined) { + error_callback = obj.error; + } + if (obj.success !== undefined) { + success_callback = obj.success; + } + + return [success_callback, error_callback]; +} +") + + +(defun json-content-type () + "Official IANA http://www.iana.org/assignments/media-types/application/" + ;; + "application/json") + + +(defun prepare-js-ajax-is-json () + (concatenate 'string + " +function ajax_trim_CR(s) { + if (s.charCodeAt(s.length-1)==13) { + s = s.substring(0,s.length-1) + } + return s; +} + +function ajax_is_json(content_type) { + content_type = ajax_trim_CR(content_type); // YUI under IE needs this + return (content_type == '" (json-content-type) "'); +} +")) + + +(defun prepare-js-ajax-call-maybe-evaluate-json () + (concatenate 'string + " +function ajax_call_maybe_evaluate_json(callback, data, content_type) { + if (ajax_is_json(content_type)) { + try { + data = eval('(' + data + ')'); + } + catch (e) { + debug_alert(e.message); + } + } + callback(data); +} +")) + + +(defun prepare-js-ajax-function-definitions(request-func fun-name js-fun-name &key method &allow-other-keys) + "Output a string containing the appropriate Javascript for accessing fun-name + on server-uri." + (concatenate 'string + " +function " js-fun-name "_callback(callback) + { +" (prepare-js-collect-varargs-to-array 1 "args") " + " request-func "('" fun-name "', callback, args); +} +" + " +function " js-fun-name "_set_element(elem_id) + { +" (prepare-js-collect-varargs-to-array 1 "args") " + + var elem = document.getElementById(elem_id); + if (!elem) { + debug_alert('!elem'); + } + + " request-func "('" fun-name "', function(res) {elem.innerHTML=res;} , args); +} +")) + + Added: version.lisp ============================================================================== --- (empty file) +++ version.lisp Fri Nov 14 21:17:43 2008 @@ -0,0 +1,11 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; +;;; Copyright (c) 2007, Ury Marshak +;;; The code comes with a BSD-style license, so you can basically do +;;; with it whatever you want. See the file LICENSE for details. +;;; + +(in-package #:ht-ajax) + +(defparameter +version+ "0.0.7") +