Hi,
I did this small project to learn MOP. I'm starting to think how this
could be done better (for example a print method for the metaclass, or
something).
If this is useful for other people I can polish it and put it
somewhere. Where could this somewhere be?
What it does:
It enables you to specify how to print a slot when defining a class.
Originally I wanted to use it to easily define form-objects for html-
forms. But I see now that it can do a lot more. So I will change the
name of some of the macros, functions and metaclasses to something
more generic. I think I will stick to HTML for now.
Comments, suggestions, improvements (and MOP teachings) are very
welcome.
Futher plans:
* maybe extend clsql objects so that forms can be automatically stored
and retrieve from a database
* maybe make a html-page object that takes different kind of
templates.
* maybe do some cool stuf with ajax and javascript/parenscript ( ex.
support for form field validation )
How to use it:
(make-web-form-type foo
((len :accessor len :initform "HitMe!" :initarg :len))
(format t "test-foo: ~a ~a~%" value (len foo)))
(defclass webform ()
((username :accessor username :initarg :username :form (text len
10))
(password :accessor password :initarg :password :form password)
(email :accessor email :initarg :email :form text)
(addr :accessor addr :initarg :addr :form (foo len
10)))
(:metaclass html-form-metaclass))
(defparameter *knobo* nil)
(setf *knobo* (make-instance 'webform
:username "knobo"
:password "the password"
:email ·······@gmail.com"
:addr "oslo"))
(display-form-object *knobo*)
-----------------------------------------------------------------------
The code:
(defpackage :html-form (:use :sb-mop :cl :closer-mop))
(in-package :html-form)
(defparameter *web-form-lookup* (list
(list 'direct-form-password 'password)
(list 'direct-form-text 'text)))
(defvar *dsd* nil)
(defclass html-form-metaclass (standard-class) ())
(defclass direct-form-slot (standard-direct-slot-definition)
((form :accessor form :initarg :form)))
(defclass effective-form-slot (standard-effective-slot-definition)
((form :accessor form :initarg :form)))
(defmacro make-web-form-type (name (&rest slots) &body print-form)
(let ((symb (intern (format nil "DIRECT-FORM-~s" name))))
`(progn
(defclass ,symb (direct-form-slot)
,slots)
(defclass ,name (effective-form-slot)
,slots)
(push (list ',symb ',name) *web-form-lookup*)
(defmethod html-form ((,name ,name) value)
,@print-form))))
(make-web-form-type text
((foo :accessor foo-of :initform "You-foo" :initarg :foo)
(len :accessor len :initarg :len))
(format t "<input type=\"text\" name=\"~s\" value=~s"
(slot-definition-name text)
value)
(when (slot-boundp text 'len)
(format t " length=~s" (len text)))
(format t ">~%"))
(make-web-form-type password
()
(format t "<input type=\"password\" value=~s name=\"~s\"~%" value
(slot-definition-name password)))
(defmethod direct-slot-definition-class ((class html-form-metaclass)
&key form &allow-other-keys)
(find-class (intern (format nil "DIRECT-FORM-~a"
(if (consp form)
(car form)
form)))))
(defmethod effective-slot-definition-class ((class html-form-
metaclass) &key &allow-other-keys)
(find-class (or (second (assoc (type-of *dsd*) *web-form-lookup*))
'effective-form-slot)))
(defmethod compute-effective-slot-definition ((class html-form-
metaclass) slot-name direct-slot-definitions)
(let* ((effective-slotd (call-next-method))
(form (form (first direct-slot-definitions))))
(if (consp form)
;;; We have slot options
;;; This has to be made more generic (I think) maybe this could be
handled by generic functions.
(do* ((options (cdr form) (cddr options))
(key (car options) (car options))
(val (cadr options) (cadr options)))
((null key) nil)
(setf (slot-value effective-slotd key) val))
;;; Else (no slot options)
(setf (form effective-slotd)
(form (first direct-slot-definitions))))
effective-slotd))
(defmethod compute-effective-slot-definition :around ((class html-form-
metaclass) slot-name direct-slot-definitions)
(let ((*dsd* (first direct-slot-definitions)))
(call-next-method)))
(defmethod validate-superclass ((class html-form-metaclass) super)
t)
(defmethod html-form ((form effective-form-slot) value)
(format t "<input type=\"text\">~a</input>~%" value))
(defmethod html-form (form value)
(format t "~s : ~s~%" form value))
(defmethod display-slot (class (slot effective-form-slot))
(html-form slot (slot-value class (slot-definition-name slot))))
(defmethod display-slot (class slot)
(format t "default ~a ~a~%" class slot)
)
(defmethod display-form-object (form)
(format t "<form method=\"post\">~%")
(mapcar (lambda (slot) (display-slot form slot))
(class-slots (class-of form)))
(format t "</form>"))
Hi,
I'm working with some improvementsto make classes that inherits from
DIV, TEMPLATE or TABLE class, to format the output in different way.
So If you want to change the way your page is rendred, you only need
to change where your object inherits from.
For DIV and TEMPLATE class I need to set some extra parameters like
for example which CLASS attribute to use in the DIV class, or which
template-file to use for the TEMPLATE class. But I'm not sure where I
should store these values. I could store it as extra slots in the
object, but I want to separate the configuration of the page/html from
the data the page/html contains.
Maybe I could customize initialize-instance, and take some extra
arguments to do something like this:
(defclass web-page (html-template)
((head ......)
(body ......)
(tail ......))
(:metaclass html-form-metaclass)
(:template-file "Path/to/template/file")))
Then maybe I could store this information in the metaclass somewhere,
but If I want to change the template-file at runtime, where sould i
store the information so it could be changed? Maybe the template file
value could be a function an do a lookup.
Also if I wanted to set the value during (make-instance 'web-page ...)
then would the template-file have to be a slot-value?
Alternatively I could do a function after (change-template web-page
new-template-path-or-function)
Any ideas that could help me here?