[mcclim-devel] presentation-subtypep

[Robert Goldman]

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))
-------------- next part --------------
A non-text attachment was scrubbed...
Name: presentation-subtypep.patch
Type: text/x-patch
Size: 2758 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/mcclim-devel/attachments/20070108/8308a936/attachment.bin>