diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-24 17:00:30 +0200 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-24 17:00:30 +0200 |
| commit | 417ac76fc4b289f5135680ee7300fee2dd31f1e6 (patch) | |
| tree | db0901f65843dc04573d75c2727be797a76de096 | |
| parent | 0544272da832227ad04ae1a48c478a166e81077d (diff) | |
Fix condition signalling.
darcs-hash:d14fd897e9b232e09261823625f1083b6d37aa11
| -rw-r--r-- | Lisp/compiler-macros.lisp | 6 | ||||
| -rw-r--r-- | Lisp/conditions.lisp | 29 | ||||
| -rw-r--r-- | objective-cl.asd | 3 |
3 files changed, 25 insertions, 13 deletions
diff --git a/Lisp/compiler-macros.lisp b/Lisp/compiler-macros.lisp index ba29c2d..2661687 100644 --- a/Lisp/compiler-macros.lisp +++ b/Lisp/compiler-macros.lisp @@ -15,7 +15,7 @@ (serious-condition () (warn (make-condition - 'style-warning + 'simple-style-warning :format-control "~S designates an unknown ~ method selector." @@ -38,7 +38,7 @@ (selector ,method-name) (serious-condition () (warn - (make-condition 'style-warning + (make-condition 'simple-style-warning :format-control "~S designates an unknown ~ method selector." @@ -60,7 +60,7 @@ (selector ',method-name) (serious-condition () (warn - (make-condition 'style-warning + (make-condition 'simple-style-warning :format-control "~S designates an unknown ~ method selector." diff --git a/Lisp/conditions.lisp b/Lisp/conditions.lisp index 839838e..86897ba 100644 --- a/Lisp/conditions.lisp +++ b/Lisp/conditions.lisp @@ -1,14 +1,26 @@ (in-package #:mulk.objective-cl) +(define-condition simple-style-warning (style-warning) + ((format-control :initarg :format-control + :reader format-control) + (format-arguments :initarg :format-arguments + :reader format-arguments)) + (:report (lambda (condition stream) + (apply #'format + stream + (format-control condition) + (format-arguments condition))))) + + (define-condition no-such-selector (error) ((designator :initarg :designator :reader rejected-selector-designator)) (:report (lambda (condition stream) - (with-slots (designator) condition - (format stream - "~S does not designate a known selector." - designator))))) + ;; The CLHS forbids the use of WITH-SLOTS for conditions. + (format stream + "~S does not designate a known selector." + (rejected-selector-designator condition))))) (define-condition message-not-understood (error) @@ -17,9 +29,8 @@ (class :initarg :class :reader rejecting-class)) (:report (lambda (condition stream) - (with-slots (selector class) condition - (format stream - "The Objective-C class ~S does not understand the ~ + (format stream + "The Objective-C class ~S does not understand the ~ message ~S." - class - selector))))) + (rejecting-class condition) + (rejected-selector condition))))) diff --git a/objective-cl.asd b/objective-cl.asd index 1b725d5..8f66cab 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -44,5 +44,6 @@ "method-invocation" "data-types")) (:file "compiler-macros" :depends-on ("defpackage" - "method-invocation"))))) + "method-invocation" + "conditions"))))) :serial t) |