Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv12180

Modified Files: presentation-defs.lisp Log Message: A partial fix to add support for AND and SATISFIES in presentation-subtypep, where they were previously not supported. Christophe has a better one to replace this with soon.

Also added an accept method for AND types.

--- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2007/01/06 12:50:38 1.66 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2007/01/09 03:39:09 1.67 @@ -172,6 +172,21 @@ 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) @@ -1526,10 +1541,17 @@ ;; XXX: We can only visually represent the pathname if it has a name ;; - making it wild is a compromise. If the pathname is completely ;; blank, we leave it as-is, though. + + ;; The above comment was meant to indicate that if the pathname had + ;; neither a name NOR a directory, then it couldn't be visually + ;; represented. Some discussion has ensued on the possbility of + ;; emitting something like "A pathname of type <foo>" + ;; [2007/01/08:rpg] (let ((pathname (if (equal object #.(make-pathname)) object (merge-pathnames object (make-pathname :name :wild))))) - (princ pathname stream))) + (princ object stream)) + )

(define-presentation-method present ((object string) (type pathname) stream (view textual-view) @@ -2150,6 +2172,19 @@ :acceptably acceptably :for-context-type for-context-type))

+(define-presentation-method accept ((type and) + (stream input-editing-stream) + (view textual-view) + &key) + (let* ((subtype (first types)) + (value (accept subtype + :stream stream + :view view + :prompt nil))) + (unless (presentation-typep value type) + (simple-parse-error "Input type is not of type ~S" type)) + value)) + (define-presentation-type-abbreviation token-or-type (tokens type) `(or (member-alist ,tokens) ,type))