((:module :ucw
:components ((:file "packages")
(:file "standard-components")
- (:file "lol-tags"))
+ (:file "lol-tags")
+ (:file "html-description"))
:serial t))))
:serial t
(attribute-value nil (find-attribute d 'attribute-2))))
(is (equalp "VALUE2" (attribute-value nil (find-attribute d 'attribute-1))))))))
-(deftest test-attribute-with-different-class ()
+(deftest (test-attribute-with-different-class :compile-before-run t) ()
(eval '(progn
;;;; We cannot ever redefine this class ic think...
;;; as attributes are also slot meta-objects.
- (unless (find-class 'test-attribute-class nil)
- (define-layered-class
- test-attribute-class (lol::standard-attribute)
- ((some-slot :initarg :some-slot :layered-accessor some-slot))))
+
+ (define-layered-class
+ test-attribute-class (lol::standard-attribute)
+ ((some-slot :initarg :some-slot
+ :layered t
+ :layered-accessor some-slot)))
+
(define-description test-attribute-with-different-class-description ()
((attribute-with-different-class :attribute-class test-attribute-class :some-slot "BRILLANT!")))))
(define-layered-method slot-value-using-layer
:in-layer (layer t)
:around (class (attribute standard-attribute) property reader)
- ;(dprint "Getting the slot value of ~A" property)
-
- (when (not (slot-boundp-using-class class attribute property))
- ;; If the slot is unbound, we search for its layered-function
-
- (let ((fn (property-layered-function
- (attribute-description attribute)
- (attribute-name attribute)
- (closer-mop:slot-definition-name property))))
- (dprint ".. not bound yet, have function ~A" fn)
- (if (generic-function-methods fn)
- (let ((*bypass-property-layered-function* t))
- ; (dprint " This shit has been bound!. We gona set the _real_ slot to the generic function like.")
- (setf (slot-value-using-class class attribute property) fn))
- (progn
- ;(dprint "This shit aint never been bound nowhere! checking for initfunction...")
- (when (slot-definition-initfunction property)
- ;(dprint "At least we have an initfunction. sweeet")
- (let ((*bypass-property-layered-function* nil))
- (setf (slot-value attribute (slot-definition-name property))
- (funcall (slot-definition-initfunction property)))))))))
-
- ;(dprint "If we're here, the slot should be bound")
+ ;; (dprint "Getting the slot value of ~A" property)
-
- (if (and
+ ;; We do some magic in here and i thought it
+ ;; would be called magically in call-next-method.
+ ;; This explicit call is good enough for now.
+
+ (unless (slot-boundp-using-class class attribute property)
+ (slot-unbound class attribute (slot-definition-name property)))
+
+ (if (and
(contextl::slot-definition-layeredp property)
(not *bypass-property-layered-function*))
(let ((fn (call-next-method)))
(funcall fn layer (attribute-description attribute)))
(call-next-method)))
+(defmacro define-bypass-function (name function-name)
+ `(defun ,name (&rest args)
+ (let ((*bypass-property-layered-function* t))
+ (apply (function ,function-name) args))))
-
-
+(define-bypass-function real-slot-boundp-using-class slot-boundp-using-class)
+(define-bypass-function real-slot-value-using-class slot-value-using-class)
+(define-bypass-function (setf real-slot-value-using-class) (setf slot-value-using-class))
+
(defun slot-boundp-using-property-layered-function (class attribute property)
- (when (not
- (let ((*bypass-property-layered-function* t))
- (slot-boundp-using-class class attribute property)))
- ;; If the slot is unbound, we search for its layered-function
-
- (let ((fn (property-layered-function
- (attribute-description attribute)
-
+ (dprint "plf boundp:")
+ (let* ((really-bound-p
+ (real-slot-boundp-using-class class attribute property))
+ (fn (if really-bound-p
+ (real-slot-value-using-class class attribute property)
+ (setf (real-slot-value-using-class class attribute property)
+ (property-layered-function
+ (attribute-description attribute)
(attribute-name attribute)
- (closer-mop:slot-definition-name property))))
+ (closer-mop:slot-definition-name property))))))
+ (dprint "Slot was bound? ~A" really-bound-p)
+ ;; If the slot is unbound, we search for its layered-function
(if (generic-function-methods fn)
- (let ((*bypass-property-layered-function* t))
- (setf (slot-value-using-class class attribute property) fn))
- NIL))))
+ T
+ NIL)))
-#+nil(define-layered-method slot-boundp-using-layer
+(define-layered-method slot-boundp-using-layer
:in-layer (layer t)
:around (class (attribute standard-attribute) property reader)
(if *bypass-property-layered-function*
(defun description-class-name (description-class)
(read-from-string (symbol-name (class-name description-class))))
-
+
(defun initialize-description-class (class)
-;;; HACK: initialization does not happen properly
+;;; HACK: initialization does not happ en properly
;;; when compiling and loading or something like that.
;;; Obviously i'm not sure why.
;;; So we're going to explicitly initialize things.
(find (slot-definition-name direct-slot)
attribute-objects
:key #'attribute-name)))
+ (dprint "Re-initing")
(apply #'reinitialize-instance attribute
- (direct-attribute-properties direct-slot))
- (apply #'change-class attribute (attribute-class attribute) (direct-attribute-properties direct-slot))
+ (print (direct-attribute-properties direct-slot)))
+ (when (not (eq (find-class (attribute-class attribute))
+ (class-of attribute)))
+
+ (apply #'change-class attribute (attribute-class attribute)
+ (direct-attribute-properties direct-slot)))
+
(setf (slot-value description (attribute-name attribute))
attribute))))))))
((class-slots :label "Slots"
:function (compose 'class-slots 'class-of))))
+(define-layered-class slot-definition-attribute (standard-attribute)
+ ((slot-name :initarg :slot-name :accessor attribute-slot-name)))
+
+(define-layered-method attribute-value (object (attribute slot-definition-attribute))
+ (slot-value object (attribute-slot-name attribute)))
+
+
(define-layered-method description-of ((object standard-object))
(find-description 'standard-object))
((attribute standard-attribute) display object &rest args)
(declare (ignore args))
- (format t "Editabpe? ~A ~A" (attribute-label attribute) attribute))
+ (format t "Editable? ~A ~A" (attribute-label attribute) (attribute-editp object attribute)))
\ No newline at end of file
(in-package :lisp-on-lines)
-(export '(html-description))
+(export '(html-description) (find-package :lisp-on-lines))
(define-description html-description ()
+ ())
+
+
+(define-description t ()
((css-class :value "lol-description")
(dom-id :function (lambda (x)
(declare (ignore x))
(symbol-name
(gensym "DOM-ID-")))))
- (:mixinp t))
-
-
-(define-description t (html-description)
- ()
(:in-description html-description))
(define-layered-class html-attribute ()
(define-display
:in-description html-description ((description t))
(with-attributes (css-class dom-id) description
-
+ (<:style
+ (<:as-html "
+
+.lol-attribute-label, .lol-attribute-value {
+ display: block;
+ width: 70%;
+ float: left;
+ margin-bottom: 10px;
+
+}
+.lol-attribute-label {
+ text-align: right;
+ width: 24%;
+ padding-right: 20px;
+}
+
+.lol-attribute-value {
+
+ }
+
+br {
+clear: left;
+}"))
+
(<:div
- :class (attribute-value* css-class)
+ :class (list (attribute-value* css-class) "lol-description")
:id (attribute-value* dom-id)
(dolist (attribute (attributes description))
(<:div
:class (attribute-css-class attribute)
(when (attribute-dom-id attribute)
:id (attribute-dom-id attribute))
- (<:span
- :class "lol-attribute-label"
- (<:as-html (attribute-label attribute)))
+ (let ((label (attribute-label attribute)))
+ (when label
+ (<:label
+ :class "lol-attribute-label"
+ (<:as-html label))))
(<:span
:class "lol-attribute-value"
- (<:as-html (attribute-value* attribute))))))))
+ (<:as-html (format nil "~A" (attribute-value* attribute))))
+ (<:br))))))