Multipass Translator for 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.
> (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
(integer 0 18) then "a minor" is not selectable. This is because the
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
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
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)