/[gcl]/gcl/clcs/clcs_condition_definitions.lisp
ViewVC logotype

Diff of /gcl/clcs/clcs_condition_definitions.lisp

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

revision 1.2 by camm, Fri Oct 3 16:03:14 2003 UTC revision 1.3 by camm, Tue Oct 7 21:06:32 2003 UTC
# Line 189  Line 189 
189    
190  #+kcl  #+kcl
191  (progn  (progn
192    (define-condition internal-warning ( warning)
193      #-(or clos pcl)
194      ((function-name nil))
195      #+(or clos pcl)
196      ((function-name :initarg :function-name
197                      :reader internal-error-function-name
198                      :initform 'nil))
199      (:report (lambda (condition stream)
200                 (when (internal-error-function-name condition)
201                   (format stream "Warning in ~S [or a callee]: "
202                           (internal-error-function-name condition)))
203                 #+(or clos pcl)(call-next-method))))
204    
205  (define-condition internal-error ( error)  (define-condition internal-error ( error)
206    #-(or clos pcl)    #-(or clos pcl)
207    ((function-name nil))    ((function-name nil))
# Line 209  Line 222 
222    (apply #'format stream (simple-condition-format-string    condition)    (apply #'format stream (simple-condition-format-string    condition)
223                           (simple-condition-format-arguments condition)))                           (simple-condition-format-arguments condition)))
224    
225    (defun internal-simple-warning-printer (condition stream)
226      (when (internal-error-function-name condition)
227        (format stream "Warning in ~S [or a callee]: "
228                (internal-error-function-name condition)))
229      (apply #'format stream (simple-condition-format-string    condition)
230                             (simple-condition-format-arguments condition)))
231    
232  (define-condition internal-simple-error  (define-condition internal-simple-error
233      (internal-error #+(or clos pcl) simple-condition)      (internal-error #+(or clos pcl) simple-condition)
234    #-(or clos pcl)    #-(or clos pcl)
# Line 218  Line 238 
238    #-(or clos pcl)(:conc-name %%internal-simple-error-)    #-(or clos pcl)(:conc-name %%internal-simple-error-)
239    (:report internal-simple-error-printer))    (:report internal-simple-error-printer))
240    
241    (define-condition internal-simple-warning
242        (internal-warning #+(or clos pcl) simple-condition)
243      #-(or clos pcl)
244      ((function-name nil) format-string (format-arguments '()))
245      #+(or clos pcl)
246      ()
247      #-(or clos pcl)(:conc-name %%internal-simple-warning-)
248      (:report internal-simple-warning-printer))
249    
250  (define-condition internal-type-error  (define-condition internal-type-error
251      (#+(or clos pcl) internal-error type-error)      (#+(or clos pcl) internal-error type-error)
252    #-(or clos pcl)    #-(or clos pcl)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26