With Xof's help, I have butchered the definition of presentation-subtypep in McCLIM to hand AND types --- previously it only handled OR. Here is a draft new defun (apologies is wrapper gonks it) and, for those who prefer, I will attach (unless I forget again) a patch file:
(defun presentation-subtypep (type maybe-supertype) (when (equal type maybe-supertype) (return-from presentation-subtypep (values t t))) (with-presentation-type-decoded (super-name super-parameters) maybe-supertype (when (eq super-name 'or) (loop for or-type in super-parameters when (presentation-subtypep type or-type) do (return-from presentation-subtypep (values t t)) finally (return-from presentation-subtypep (values nil t)))) (when (eq super-name 'satisfies) (return-from presentation-subtypep (values nil nil))) (with-presentation-type-decoded (sub-name sub-parameters) type (when (eq sub-name 'and) (loop for and-type in sub-parameters with subtypep and knownp with answer-knownp = t do (multiple-value-setq (subtypep knownp) (presentation-subtypep and-type maybe-supertype)) if subtypep do (return-from presentation-subtypep (values t t)) else ; track whether we know the answer do (setf answer-knownp (and answer-knownp knownp)) finally (return-from presentation-subtypep (values nil answer-knownp))))) (map-over-presentation-type-supertypes #'(lambda (name massaged) (when (eq name super-name) (return-from presentation-subtypep (funcall-presentation-generic-function presentation-subtypep massaged maybe-supertype)))) type)) (values nil t))
Robert Goldman rpgoldman@real-time.com writes:
With Xof's help, I have butchered the definition of presentation-subtypep in McCLIM to hand AND types --- previously it only handled OR. Here is a draft new defun (apologies is wrapper gonks it) and, for those who prefer, I will attach (unless I forget again) a patch file:
I think that the attached is better, but it still is not perfect. (I will commit it unless I hear screams of pain, though). It comes in two parts (plus some tests):
* modifications to PRESENTATION-SUBTYPEP and STUPID-SUBTYPEP to handle most cases of AND and OR presentation types. Some of the cases are about as good as we can get; there's room for improvement in others.
There are a few surprises lurking in the definitions of presentation types and their relationships: they don't correspond directly to CL types, so some of the instincts about those are misleading; AND types are somewhat special, in that the first parameter of an AND type is magical.
* a modification to DEFAULT-TRANSLATOR to try to get the right behaviour for complicated presentation types. It's not quite right, but actually I think that to get it completely right involves solving SATISFIABILITY, which isn't in my gameplan.
This seems to mostly work; the test file which is included in the attached diff passes. A further test at the listener is (present "abc" 'string) (present "def" 'string) (defun foop (x) (char= (char x 0) #\a)) (with-input-context ('(and string (satisfies foop))) (obj otype ev opts) (loop (read-char)) (t obj)) which makes only the "abc" string and not the "def" string mousable.
Unfortunately, (accept '(and string (satisfies foop))) doesn't work as expected, as the accept method for AND establishes an inner input-context for STRING, which means that the "def" string is mousable (and causes an error if you click on it).
Would something like (define-presentation-method accept ((type and) (stream input-editing-stream) (view textual-view) &key) (let ((subtype (first types))) (multiple-value-bind (ob ty) (funcall-presentation-generic-function accept subtype stream view) (unless (presentation-typep ob type) (simple-parse-error "Object ~S is not of type ~S" ob type)) value))) be acceptable (haha)? It seems to work for me, in that after I define this (accept '(and string (satisfies foop))) makes only the strings beginning with #\a mousable, but I don't know how to handle the keyword arguments (or even if they've already been handled by stuff up the stack).
Cheers,
Christophe
-
Christophe Rhodes -
Robert Goldman