diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/data-types.lisp | 10 | ||||
| -rw-r--r-- | Lisp/utilities.lisp | 27 |
2 files changed, 19 insertions, 18 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 6c1a6e8..2c309e7 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -192,7 +192,7 @@ a suitable class method instead as you would in Objective-C. :reader pointer-to :initarg :pointer)) (:report (lambda (condition stream) - (describe-object condition stream))) + (print-object condition stream))) (:documentation "The condition type for Objective-C exceptions. ## Description: @@ -232,14 +232,6 @@ an __exception__, you can simply send it the `self' message. __id__")) -(defmethod describe-object ((condition exception) stream) - (format stream "The Objective-C runtime has issued an exception of ~ - type `~A'.~&~ - Reason: ~A." - (invoke-by-name (invoke-by-name condition "name") "UTF8String") - (invoke-by-name (invoke-by-name condition "reason") "UTF8String"))) - - (defclass foreign-value (c-pointer-wrapper) ((lisp-managed-cell :type (array boolean ()) :accessor foreign-value-lisp-managed-cell-p diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp index 175e3df..757fc6e 100644 --- a/Lisp/utilities.lisp +++ b/Lisp/utilities.lisp @@ -274,15 +274,24 @@ invocations will return numbers.) (defmethod print-object ((exception exception) stream) - (print-unreadable-object (exception stream) - ;; FIXME: Inexplicably, WITH-SLOTS doesn't work for exceptions. Is - ;; direct slot access disallowed for instances of type CONDITION? - (with-accessors ((pointer pointer-to)) exception - (format stream "~S ~A {~X}" - (type-of exception) - (primitive-invoke (primitive-invoke exception "name" 'id) - "UTF8String" :string) - (cffi:pointer-address pointer))))) + (cond (*print-escape* + (print-unreadable-object (exception stream) + ;; FIXME: Inexplicably, WITH-SLOTS doesn't work for + ;; exceptions. Is direct slot access disallowed for + ;; instances of type CONDITION? + (with-accessors ((pointer pointer-to)) exception + (format stream "~S ~A {~X}" + (type-of exception) + (primitive-invoke (primitive-invoke exception "name" 'id) + "UTF8String" :string) + (cffi:pointer-address pointer))))) + (t (format stream "The Objective-C runtime has issued an exception ~ + of type `~A'.~&~ + Reason: ~A." + (invoke-by-name (invoke-by-name exception "name") + "UTF8String") + (invoke-by-name (invoke-by-name exception "reason") + "UTF8String"))))) (defmethod describe-object :after ((exception exception) stream) |