[mcclim-devel] CLIM on the WEB

[Friedrich Dominicus]

"=?ISO-8859-2?Q?M=E9sz=E1ros_Levente?=" <melevy at freemail.hu> writes:

> Hi,
>
> I don't know much about CLIM internals, so my theoretical question 
> might be weird.
>
> Is it possible to render a CLIM application on current web browsers 
> using JavaScript, XHTML and AJAX? I do not mean that is it possible 
> right now (I wish it would be, but it certainly isn't) but
> conceptually?
Yes theoratically in practical Arthur Lemmens and (a bit me) have
worke on making the present/accept Model available for Web pages. We
do not use JavaScript we do no use any scripting all the stuff is done
on the server side from within common lisp an example on how it looks:

#|
* Date example

This example shows how to define a new presentation type
that corresponds to multiple HTML gadgets.

* Running the example:

- Compile and load this buffer

- Start a listener and do:

CL-USER 1 > (in-package :wps.date)
WPS.DATE 2 > (run)

- Start a web-browser and enter the URL 
  http://localhost:8000/date

- When you're getting bored, stop the listener:

WPS.DATE 3> (stop-running)

|#


(defpackage wps.date
  (:use :clim-lisp :clim :wps :lml2 :araneida)
  (:shadowing-import-from :lml2 #:html-stream #:html)
  #+lispworks
  ;; In Lispworks, CLIM-LISP::WRITE-SEQUENCE is not exported so we need
  ;; to import it explicitly.
  (:import-from :common-lisp #:write-sequence))

(in-package :wps.date)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Application
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass date-application (wps-application araneida:handler)
  ((title :accessor title :initform "WPS Date Example"))
  (:default-initargs
   :name "date"))

(defmethod handle-wps-get-request ((handler date-application) stream request)
  ;; This is the wps entry point for dealing with HTTP GET requests
  ;; (POST requests are normally handled automatically by wps).
  ;; Here you look at request and the state of your app and decide what you're
  ;; going to do.  For this example, we keep it simple and just show
  ;; the ask-for-date page.
  (declare (ignore request))
  (ask-for-date stream))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Defining the presentation type
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconstant +months+
  '(("January" 31)
    ("February" 28)
    ("March" 31)
    ("April" 30)
    ("May" 31)
    ("June" 30)
    ("July" 31)
    ("August" 31)
    ("September" 30)
    ("October" 31)
    ("November" 30)
    ("December" 31)))

  
(defun ask-for-date (stream)
  (html-stream stream
    (:html (:head (:title "WPS Date"))
     (:body
      (html (:h1 (:princ-safe (title *wps-application*))))
      (let (date)
        (with-continuation (k stream)
            (web-accepting-values (stream :continuation k
                                          :align-prompts :left)
              (setq date
                    (accept 'date
                            :stream stream
                            :prompt "Date"
                            :query-identifier 'date)))
          ;; Input accepted
          (html-stream stream
            (:html (:head (:title "WPS Date (response)"))
             (:body
              (:p (:princ-safe (format nil "You entered ~A"
                                       (present-to-string date 'date)))))))))))))



(clim:define-presentation-type date ()
                               :options ((separator #\-)))


(define-presentation-method accept ((type date) (stream wps-stream) view
                                    &key
                                    (default (get-universal-time))
                                    query-identifier
                                    query-input-error-p
                                    &allow-other-keys)
  (when query-input-error-p
    (html-stream (encapsulating-stream-stream stream)
      (:p (:princ-safe "You entered an impossible date.  Please try again."))))
  (multiple-value-bind (sec min hr day month year)
      (decode-universal-time default)
    (declare (ignore sec min hr))
    (multiple-value-bind (year year-type year-changed-p)
        (accept `(completion ,(loop for y from 1990 to 2020 collect y))
                :stream stream
                :prompt "Year"
                :default year
                :query-identifier (format nil "~A.year"
                                          (html-query-identifier query-identifier)))
      (declare (ignore year-type))
      (multiple-value-bind (month month-type month-changed-p)
          (accept `(member-alist ,(loop for name in (mapcar #'first +months+)
                                        for number from 1
                                        collect (list name number)))
                  :stream stream
                  :prompt "Month"
                  :default month
                  :query-identifier (format nil "~A.month"
                                            (html-query-identifier query-identifier)))
        (declare (ignore month-type))
        (multiple-value-bind (day day-type day-changed-p)
            (accept `(completion ,(loop for i from 1 to 31 collect i))
                    :stream stream
                    :prompt "Day"
                    :default day
                    :query-identifier (format nil "~A.day"
                                              (html-query-identifier query-identifier)))
          (declare (ignore day-type))
          (cond ((and year-changed-p month-changed-p day-changed-p)
                 ;; Do a simple minded date check.
                 (let ((max-nr-days (second (elt +months+ (1- month)))))
                   (if (> day max-nr-days)
                       (error 'wps-error
                              :message "Wrong number of days for month.")
                     (encode-universal-time 0 0 0 day month year))))
                (t default)))))))


;; Define a PRESENT method for textual-views.

(define-presentation-method present (universal-time (type date) stream
                                                    (view textual-view) &key)
  ;; Print the date part of a universal-time.
  ;; Note how we can refer to the presentation-type option (separator)
  ;; without 'introducing' it explicitly.
  (multiple-value-bind (second minute hour day month year)
      (decode-universal-time universal-time)
    (declare (ignore second minute hour))
    (format stream "~4,'0D~A~2,'0D~A~2,'0D" year separator month separator day)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Araneida-specific setup
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *listener*
  (make-instance 'araneida:threaded-http-listener :port 8000))

(defun run (&key (application (make-instance 'date-application))
                 (host "localhost")
                 (port 8000))
  (araneida:install-handler (araneida:http-listener-handler *listener*)
                            application
                            (format nil "http://~A:~D/~A"
                                    host
                                    port
                                    (wps-application-name application))
                            nil)
  ;; For easier debugging.  You may not want this for a production app.
  (setq araneida::*handler-timeout* 600)
  ;;
  (araneida:start-listening *listener*))

(defun stop-running ()
  (araneida:stop-listening *listener*))


Regards
Friedrich