From: Kevin M. Rosenberg Date: Tue, 6 Apr 2004 21:41:19 +0000 (+0000) Subject: r8844: laptop updates X-Git-Tag: v1.96~83 X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=526eef1b59e071cbb4ecd35f73a14c1a3f8e32b6 r8844: laptop updates --- diff --git a/macros.lisp b/macros.lisp index 46894ba..9b6150a 100644 --- a/macros.lisp +++ b/macros.lisp @@ -233,3 +233,9 @@ (defun ,release-name (instance) (kmrcl::with-lock-held (,lock-name) (push instance ,cache-name)))))) + +(defmacro with-ignore-errors (&rest forms) + `(progn + ,@(mapcar + (lambda (x) (list 'ignore-errors x)) + forms))) diff --git a/mop.lisp b/mop.lisp index 82fcb47..8decec5 100644 --- a/mop.lisp +++ b/mop.lisp @@ -53,29 +53,29 @@ (defun intern-eql-specializer (slot) `(eql ,slot)) - (defmacro process-class-option (metaclass slot-name &optional required) - #+lispworks - `(defmethod clos:process-a-class-option ((class ,metaclass) - (name (eql ,slot-name)) - value) - (when (and ,required (null value)) - (error "metaclass ~A class slot ~A must have a value" (quote ,metaclass) name)) - (list name `',value)) - #-lispworks - (declare (ignore metaclass slot-name required)) - ) +(defmacro process-class-option (metaclass slot-name &optional required) + #+lispworks + `(defmethod clos:process-a-class-option ((class ,metaclass) + (name (eql ,slot-name)) + value) + (when (and ,required (null value)) + (error "metaclass ~A class slot ~A must have a value" (quote ,metaclass) name)) + (list name `',value)) + #-lispworks + (declare (ignore metaclass slot-name required)) + ) - (defmacro process-slot-option (metaclass slot-name) - #+lispworks - `(defmethod clos:process-a-slot-option ((class ,metaclass) - (option (eql ,slot-name)) - value - already-processed-options - slot) - (list* option `',value already-processed-options)) - #-lispworks - (declare (ignore metaclass slot-name)) - ) +(defmacro process-slot-option (metaclass slot-name) + #+lispworks + `(defmethod clos:process-a-slot-option ((class ,metaclass) + (option (eql ,slot-name)) + value + already-processed-options + slot) + (list* option `',value already-processed-options)) + #-lispworks + (declare (ignore metaclass slot-name)) + ) (eval-when (:compile-toplevel :load-toplevel :execute) diff --git a/package.lisp b/package.lisp index 60df299..9e61ef6 100644 --- a/package.lisp +++ b/package.lisp @@ -138,6 +138,7 @@ #:deflex #:def-cached-vector #:def-cached-instance + #:with-ignore-errors ;; files.lisp #:print-file-contents