Multipass Translator for CLIM

Tagged as lisp, clim

Written on 2022-04-28 by Daniel 'jackdaniel' KochmaƄski

One of interesting concepts in CLIM is typed output. Basically we associate a presentation type with the presented object. When we establish an input context, then presentations which types are a subtype to the input context are selectable with the pointer.

For example:

> (present 42 'integer)
42
;; -> #<presentation>

> (with-output-as-presentation (*standard-output* 15 'integer)
    (format *standard-output* "A minor"))
A minor
;; -> #<presentation>

> (with-output-as-presentation (*standard-output* 13 '(integer 11 17))
    (format *standard-output* "A teenager"))
A teenager
;; -> #<presentation>

> (accept 'integer :prompt "Give me an integer")
;; We select "a minor" with a pointer
Give me an integer: 15
;; -> 15, integer

> (accept '(integer 0 18) :prompt "Please select a minor")
;; We select "a teenager" with a pointer
Please select a minor: 13
;; -> 13, (integer 11 17)

The typed output may get a little tricky. If we try to accept a presentation type (integer 0 18) then "a minor" is not selectable. This is because the type integer is not a subtype of the type (integer 0 18). It seems a bit counterintuitive, because the object has the correct type!

> (presentation-typep 15 '(integer 0 18))
;; -> T
> (presentation-subtypep 'integer '(integer 0 18))
;; -> NIL
> (presentation-typep 13 '(integer 0 18))
;; -> T
> (presentation-subtypep '(integer 11 17) '(integer 0 18))
;; -> T

This behavior may be explained with a short story:

There was a cook who had a day off; they have decided to spend the evening with their friends. When they've entered the restaurant, someone has asked the waiter: "please compliment the cook!" - the waiter obviously ignored "our" cook and left to the kitchen. This is because they are incognito.

Sometimes it is desirable to ignore the fact that some object does not advertise its precise type. An appropriate story would involve a medical doctor who is in the plane when some other person has a heart attack. Then we want to select any suitable object that meets the criteria of being a doctor, despite them being incognito.

It is possible to achieve such relaxed constraints by defining a translator:

> (define-presentation-translator multipass-integer
      (integer nil global-command-table
               :tester ((object context-type)
                        (presentation-typep object context-type)))
      (object context-type)
    (values object context-type))
;; -> #<Translator>

> (accept '(integer 0 18) :prompt "Please select a minor")
;; We select "a minor" with a pointer
Please select a minor: 15
;; -> 15, (integer 0 18)

> (accept '(integer 0 18) :prompt "Please select a minor")
;; We select "a teenager" with a pointer
Please select a minor: 13
;; -> 13, (integer 11 17)

The first two arguments of the presentation translator are from-type and to-type. This is a little more complex, but the applicability of the translator could be determined with the following test:

(and (presentation-subtypep #<object-ptype> from-type)
     (presentation-subtypep #<context-ptype> to-type)
     (tester object #<context-ptype>)

In other words the translator multipass-integer translates all objects of the type integer to the type nil. The latter is a subtype of all types so this translator will work for any context type, because:

> (presentation-subtypep nil '(integer 0 18))
;; -> (t t)

Then we add a test whether the object meets the input context criteria. This is necessary, because otherwise the translator would happily return values that are integers, but they are for instance bigger than 18. At last the translator returns the object, and the context type.

A nice thing about this approach is that translators reside in command tables and it is possible to define such translator that works only locally in "our" application frame without affecting others.

Now we may define a macro that relaxes the constraint for selected types:

> (defmacro define-multipass-translator
      (ptype &optional (command-table 'global-command-table))
    (let ((name (alexandria:symbolicate 'multipass- ptype)))
      `(define-presentation-translator ,name
           (,ptype nil ,command-table
                   :tester ((object context-type)
                            (presentation-typep object context-type)))
           (object context-type)
         (values object context-type))))
> (define-multipass-translator integer)
> (define-multipass-translator doctor)