Changeset 8817


Ignore:
Timestamp:
Mar 18, 2008, 1:25:04 AM (11 years ago)
Author:
gz
Message:

Propagate Greg's changeset:8667 (various interactive restarts) from trunk to this branch

Location:
branches/working-0711/ccl/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-clos-boot.lisp

    r8623 r8817  
    12331233                (return class)))))
    12341234        (when (or errorp (not (symbolp name)))
    1235           (error "Class named ~S not found." name)))))
     1235          (cerror "Try finding the class again"
     1236                  "Class named ~S not found." name)
     1237          (find-class name errorp environment)))))
    12361238
    12371239(defun set-find-class (name class)
     
    23512353                        method-qualifiers specializers &optional (errorp t))
    23522354  (dolist (m (%gf-methods generic-function)
    2353            (if errorp
    2354              (error "~s has no method for ~s ~s"
    2355                     generic-function method-qualifiers specializers)))
     2355           (when errorp
     2356             (cerror "Try finding the method again"
     2357                     "~s has no method for ~s ~s"
     2358                     generic-function method-qualifiers specializers)
     2359             (find-method generic-function method-qualifiers specializers
     2360                          errorp)))
    23562361    (flet ((err ()
    23572362             (error "Wrong number of specializers: ~s" specializers)))
     
    26002605           (slotd (find-slotd slot-name (%class-slots class))))
    26012606      (if slotd
    2602         (slot-value-using-class class instance slotd)
    2603         (values (slot-missing class instance slot-name 'slot-value)))))
     2607       (slot-value-using-class class instance slotd)
     2608       (restart-case
     2609           (values (slot-missing class instance slot-name 'slot-value))
     2610         (continue ()
     2611           :report "Try accessing the slot again"
     2612           (slot-value instance slot-name))
     2613         (use-value (value)
     2614           :report "Return a value"
     2615           :interactive (lambda ()
     2616                          (format *query-io* "~&Value to use: ")
     2617                          (list (read *query-io*)))
     2618           value)))))
    26042619   
    26052620
     
    26072622(defmethod slot-unbound (class instance slot-name)
    26082623  (declare (ignore class))
    2609   (error 'unbound-slot :name slot-name :instance instance))
     2624  (restart-case (error 'unbound-slot :name slot-name :instance instance)
     2625    (use-value (value)
     2626      :report "Return a value"
     2627      :interactive (lambda ()
     2628                     (format *query-io* "~&Value to use: ")
     2629                     (list (read *query-io*)))
     2630      value)))
    26102631
    26112632
     
    32813302
    32823303(defmethod no-applicable-method (gf &rest args)
    3283   (error "No applicable method for args:~% ~s~% to ~s" args gf))
     3304  (cerror "Try calling it again"
     3305          "No applicable method for args:~% ~s~% to ~s" args gf)
     3306  (apply #'no-applicable-method gf args))
    32843307
    32853308
  • branches/working-0711/ccl/level-1/l1-dcode.lisp

    r7848 r8817  
    124124                               (logbitp $lfbits-rest-bit newbits)
    125125                               (logbitp $lfbits-restv-bit newbits))))
    126             (error "New lambda list ~s of generic function ~s is not
    127 congruent with lambda lists of existing methods." lambda-list gf)))
     126            (cerror (format nil
     127                            "Remove ~d method~:p from the generic-function and ~
     128                             change its lambda list."
     129                            (length (%gf-methods gf)))
     130                    "New lambda list of generic function ~s is not congruent ~
     131                     with lambda lists of existing methods.~%~
     132                     Generic-function's   : ~s~%~
     133                     Method's lambda-list : ~s~%"
     134                    gf lambda-list (%method-lambda-list (car methods)))
     135            (loop
     136               (let ((methods (%gf-methods gf)))
     137                 (if methods
     138                     (remove-method gf (car methods))
     139                     (return))))
     140            (%set-defgeneric-keys gf nil)))
    128141        (when lambda-list-p
    129142          (setf (%gf-%lambda-list gf) lambda-list
Note: See TracChangeset for help on using the changeset viewer.