Changeset 5141


Ignore:
Timestamp:
12/15/03 14:07:48 (17 years ago)
Author:
piso
Message:

WARN

Location:
trunk/j/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/autoloads.lisp

    r5092 r5141  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: autoloads.lisp,v 1.73 2003-12-12 15:54:49 piso Exp $
     4;;; $Id: autoloads.lisp,v 1.74 2003-12-15 14:07:48 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    115115
    116116(autoload '(find-restart invoke-restart restart-name compute-restarts
    117             abort continue muffle-warning store-value use-value)
     117            abort continue muffle-warning store-value use-value warn)
    118118          "restart.lisp")
    119119(autoload-macro '(with-simple-restart restart-bind restart-case
  • trunk/j/src/org/armedbear/lisp/restart.lisp

    r4992 r5141  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: restart.lisp,v 1.2 2003-12-06 15:44:42 piso Exp $
     4;;; $Id: restart.lisp,v 1.3 2003-12-15 14:07:22 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    178178       ,@body)))
    179179
    180 (defun abort ()
     180(defun abort (&optional condition)
    181181  (invoke-restart 'abort)
    182182  (error 'abort-failure))
    183183
    184 (defun continue ()
     184(defun continue (&optional condition)
    185185  (invoke-restart 'continue))
    186186
    187 (defun muffle-warning ()
     187(defun muffle-warning (&optional condition)
    188188  (invoke-restart 'muffle-warning))
    189189
     
    193193(defun use-value (value)
    194194  (invoke-restart 'use-value value))
     195
     196;;; Adapted from SBCL.
     197(defun warn (datum &rest arguments)
     198  (let ((condition (coerce-to-condition datum arguments 'simple-warning 'warn)))
     199    (require-type condition 'warning)
     200    (restart-case (signal condition)
     201                  (muffle-warning ()
     202                                  :report "Skip warning."
     203                                  (return-from warn nil)))
     204    (let ((badness (etypecase condition
     205                     (style-warning 'style-warning)
     206                     (warning 'warning))))
     207      (fresh-line *error-output*)
     208      (format *error-output* "~S: ~A~%" badness condition)))
     209  nil)
Note: See TracChangeset for help on using the changeset viewer.