/[meta-cvs]/meta-cvs/F-1C43C940D8740CAA78752C1206316B55
ViewVC logotype

Diff of /meta-cvs/F-1C43C940D8740CAA78752C1206316B55

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3.8.1 by kaz, Sun Mar 2 06:56:07 2003 UTC revision 1.3.8.2 by kaz, Sun Mar 2 07:22:31 2003 UTC
# Line 22  Line 22 
22              (report-spec()))              (report-spec()))
23          (do ((key (first body) (first body))          (do ((key (first body) (first body))
24               (val (second body) (second body)))               (val (second body) (second body)))
25              ((not (member key '(:report :test :report-format :interactive))))              ((not (member key '(:report :test :interactive))))
26            (pop body)            (pop body)
27            (pop body)            (pop body)
28            (case key            (case key
# Line 30  Line 30 
30               (setf interactive-spec `(:interactive-function (function ,val))))               (setf interactive-spec `(:interactive-function (function ,val))))
31              ((:report)              ((:report)
32               (setf report-spec               (setf report-spec
33                     (if (stringp val)                     (cond
34                       `(:report-function #'(lambda (stream)                       ((stringp val)
35                                              (write-string ,val stream)))                          `(:report-function #'(lambda (stream)
36                       `(:report-function (function ,val)))))                                               (write-string ,val stream))))
37              ((:report-format)                       ((and (consp val) (stringp (first val)))
38               (setf report-spec                          `(:report-function #'(lambda (stream)
39                     `(:report-function #'(lambda (stream)                                               (format stream ,@val))))
40                                            (format stream ,@val)))))                       (t `(:report-function (function ,val))))))
41              ((:test)              ((:test)
42               (setf test-spec `(:test-function (function ,val))))))               (setf test-spec `(:test-function (function ,val))))))
43          `(,name          `(,name
# Line 56  Line 56 
56  "This is a macro that is very similar to the standard RESTART-CASE, but  "This is a macro that is very similar to the standard RESTART-CASE, but
57  with a few refinements.  with a few refinements.
58    
59  Firstly, the special syntax :REPORT-FORMAT VALUE is accepted. VALUE must  Firstly, the special syntax :REPORT (STRING ...) is accepted.
60  be an argument list for the FORMAT function, starting with the format  This is a shorthand for
 string. This is a shorthand for  
61    
62    :REPORT (LAMBDA (STREAM) (FORMAT STREAM ...)))    :REPORT (LAMBDA (STREAM) (FORMAT STREAM STRING ...)))
63    
64  Secondly, unlike RESTART-CASE, SUPER-RESTART-CASE does not perform a  Secondly, unlike RESTART-CASE, SUPER-RESTART-CASE does not perform a
65  non-local exit before executing the body of a clause. A clause body is  non-local exit before executing the body of a clause. A clause body is
# Line 87  will be the value of the last form in (U Line 86  will be the value of the last form in (U
86      `(let ((,closure-var nil))      `(let ((,closure-var nil))
87         (block nil         (block nil
88           (tagbody           (tagbody
            (go ,top-sym)  
            ,out-sym  
            (return (funcall ,closure-var))  
89             ,top-sym             ,top-sym
90             (restart-bind             (restart-bind
91               ,(mapcar #'(lambda (clause)               ,(mapcar #'(lambda (clause)
92                            (super-restart-case-expander clause top-sym out-sym                            (super-restart-case-expander clause top-sym out-sym
93                                                         closure-var))                                                         closure-var))
94                        clauses)                        clauses)
95               (progn ,expr)))))))               (return (progn ,expr)))
96               ,out-sym
97               (return (funcall ,closure-var)))))))

Legend:
Removed from v.1.3.8.1  
changed lines
  Added in v.1.3.8.2

  ViewVC Help
Powered by ViewVC 1.1.5