From e3aaa0f699541c372e3e0ab0e71ed5c468a039c0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 4 Sep 2002 19:25:45 +0000 Subject: [PATCH] . original commit: 51565c302ae92857a1a41e2955e4567ffeb1515a --- collects/mred/mred.ss | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss index 66e71a58..7db4c686 100644 --- a/collects/mred/mred.ss +++ b/collects/mred/mred.ss @@ -6150,18 +6150,22 @@ (unless (and (list? style) (andmap symbol? style)) (raise-type-error (who->name who) "list of style symbols" style)) (when reqd - (unless (ormap (lambda (i) (memq i reqd)) style) - (raise-type-error (who->name who) - (format "style list including ~a" - (if (= (length reqd) 1) - (car reqd) - (string-append - "one of " - (let loop ([l reqd]) - (if (null? (cdr l)) - (format "or ~a" (car l)) - (format "~a, ~a" (car l) (loop (cdr l)))))))) - style))) + (letrec ([or-together (lambda (l) + (if (= (length l) 2) + (format "~a or ~a" (car l) (cadr l)) + (let loop ([l l]) + (if (null? (cdr l)) + (format "or ~a" (car l)) + (format "~a, ~a" (car l) (loop (cdr l)))))))]) + (unless (ormap (lambda (i) (memq i reqd)) style) + (raise-type-error (who->name who) + (format "style list, missing ~a" + (if (= (length reqd) 1) + (car reqd) + (string-append + "one of " + (or-together reqd)))) + style)))) (if (and (not reqd) (null? other-allowed)) (unless (null? style) (raise-type-error (who->name who) "empty style list" style))