Re: propagated slots

From: Erick Gallesio <eg_at_kaolin.unice.fr>
Date: Sat, 20 Sep 1997 18:01:09 +0200

Andrew Dorrell writes:
> Hi,
>
> Thanks for the quick replies to previous postings! On a slightly
> different matter...
>
> When designing composite widgets which use :propagated slots I would
> like to be able to control the keyword used for the propagation. I
> need this so that I can have a convinient mechanism for setting things
> like the relief and border widths of components in a composite. I see
> the idea working a little like this:
>
> (define-class ...
>
> (button-1) (button-2)
> ...
> (button-relief :allocation :propagated
> :propagate-as 'relief
> :propagate-to (button-1 button-2))
>
> ...)

I don't really understand what is your problem; Is it to set the relief AND
the border-width at the same time? BTW, what is the role of 'relief here?
>
> This approach seems to be much tidier than what I am doing at the
> moment - which is allocating these slots as virtual and writing the
> appropriate setters and getters manually.

Yes it is better. If you have virtual slots with always the same function to
access it, it is simpler to write a metaclass for that. the
<Composite-metaclass> does just that.

> Has anyone done this
> previously or have any hints as to how I would go about (best) doing
> this. (I anticipate it would be a fairly minor change to stklos.stk)

It is not a change. Write you metaclass and say that you object use this
metaclass. Here is the complete code for composites in stklos.stk with some
comments

(define-class <Composite-metaclass> (<class>)
  ())

To be a metaclass just inherit from <class>

(define-method compute-get-n-set ((class <Composite-metaclass>) slot)
  (if (memv (slot-definition-allocation slot) '(:propagated :special))
      (compute-propagated-get-n-set slot)
      (next-method)))

When a class is created the readers and writers for its slots are computed
by the function compute-get-n-set. This function must return a list of two
functions: a reader for the slot and a writer. Here we test if the allocation
is :propagated (:special is her for compatibility reasons) and if this is the
case, it computes the 2-length list. Note: slot is the complete definition of
your slot (i.e. a list whose car is the slot name and rest is the option you
gave).

(define (compute-propagated-get-n-set s)
  (let ((prop (or (get-keyword :propagate-to (cdr s) #f)
                            (get-keyword :propagate (cdr s) #f)))
        (s-name (car s))
        (build-reader (lambda (s default)
                          (unless (pair? s) (set! s (list s default)))
                          `(slot-ref (slot-ref o ',(car s)) ',(cadr s))))
        (build-writer (lambda (s default)
                          (unless (pair? s) (set! s (list s default)))
                          `(slot-set! (slot-ref o ',(car s)) ',(cadr s) v))))

    (unless prop (error "Propagation not specified for slot ~s" s-name))
    (unless (pair? prop) (error "Bad propagation list for slot ~s" s-name))

    (list
       ;; The getter
       (eval `(lambda (o) ,(build-reader (car prop) s-name)))
       ;; The setter
       (eval `(lambda (o v)
                ,_at_(map (lambda (item) (build-writer item s-name))
                       prop))))))

You see here that the reader get the value of the slot by reading the value of
the first item of the propagation list. In counterpart, the writer sets all
the new value to all its slots. The code is a little bit tricky here because
it is allowed to change the name of the slot on which we propagate.
Consider the following classes:
    (define-class A ()
      (a b c))

    (define-class X ()
       (x y z))

    (define-class compo ()
      ((the-a :initform (make A))
       (the-x :initform (make X))
       (a :allocation :propagated
          :propagate-to (the-a (the-x x))))
      :metaclass <Composite-metaclass>)

In this case the previous function create a list of 2 procedure which are:

    (lambda (o)
       (slot-ref (slot-ref o 'the-a) 'a))

    (lambda (o v)
      (slot-set! (slot-ref o 'the-a) 'a v)
      (slot-set! (slot-ref o 'the-x) 'x v))
 

>
> Alternatively, is there already a mechanism for doing this; does
> anyone have a better idea?
>
I think this is THE better idea ;)

                -- Erick
Received on Sat Sep 20 1997 - 18:04:08 CEST