(define-condition deprecation-condition ()
((name :initarg :name :reader deprecated-name)
- (replacement :initarg :replacement :reader deprecated-name-replacement)
+ (replacements :initarg :replacements :reader deprecated-name-replacements)
(since :initarg :since :reader deprecated-since)
(runtime-error :initarg :runtime-error :reader deprecated-name-runtime-error)))
(let ((*package* (find-package :keyword)))
(if *print-escape*
(print-unreadable-object (condition stream :type t)
- (format stream "~S is deprecated~@[, use ~S~]"
+ (apply #'format
+ stream "~S is deprecated.~
+ ~#[~; Use ~S instead.~; ~
+ Use ~S or ~S instead.~:; ~
+ Use~@{~#[~; or~] ~S~^,~} instead.~]"
(deprecated-name condition)
- (deprecated-name-replacement condition)))
- (format stream "~@<~S has been deprecated as of SBCL ~A~
- ~@[, use ~S instead~].~:@>"
+ (deprecated-name-replacements condition)))
+ (apply #'format
+ stream "~@<~S has been deprecated as of SBCL ~A.~
+ ~#[~; Use ~S instead.~; ~
+ Use ~S or ~S instead.~:; ~
+ Use~@{~#[~; or~] ~S~^,~:_~} instead.~]~:@>"
(deprecated-name condition)
(deprecated-since condition)
- (deprecated-name-replacement condition)))))
+ (deprecated-name-replacements condition)))))
(define-condition early-deprecation-warning (style-warning deprecation-condition)
())
;;;; Deprecating stuff
-(defun deprecation-error (since name replacement)
+(defun normalize-deprecation-replacements (replacements)
+ (if (or (not (listp replacements))
+ (eq 'setf (car replacements)))
+ (list replacements)
+ replacements))
+
+(defun deprecation-error (since name replacements)
(error 'deprecation-error
:name name
- :replacement replacement
+ :replacements (normalize-deprecation-replacements replacements)
:since since))
-(defun deprecation-warning (state since name replacement
+(defun deprecation-warning (state since name replacements
&key (runtime-error (neq :early state)))
(warn (ecase state
(:early 'early-deprecation-warning)
(:late 'late-deprecation-warning)
(:final 'final-deprecation-warning))
:name name
- :replacement replacement
+ :replacements (normalize-deprecation-replacements replacements)
:since since
:runtime-error runtime-error))
-(defun deprecated-function (since name replacement)
+(defun deprecated-function (since name replacements)
(lambda (&rest deprecated-function-args)
(declare (ignore deprecated-function-args))
- (deprecation-error since name replacement)))
+ (deprecation-error since name replacements)))
-(defun deprecation-compiler-macro (state since name replacement)
+(defun deprecation-compiler-macro (state since name replacements)
(lambda (form env)
(declare (ignore env))
- (deprecation-warning state since name replacement)
+ (deprecation-warning state since name replacements)
form))
-(defmacro define-deprecated-function (state since name replacement lambda-list &body body)
- (let ((doc (let ((*package* (find-package :keyword)))
- (format nil "~@<~S has been deprecated as of SBCL ~A~@[, use ~S instead~].~:>"
- name since replacement))))
+(defmacro define-deprecated-function (state since name replacements lambda-list &body body)
+ (let* ((replacements (normalize-deprecation-replacements replacements))
+ (doc (let ((*package* (find-package :keyword)))
+ (apply #'format nil
+ "~@<~S has been deprecated as of SBCL ~A.~
+ ~#[~; Use ~S instead.~; ~
+ Use ~S or ~S instead.~:; ~
+ Use~@{~#[~; or~] ~S~^,~} instead.~]~@:>"
+ name since replacements))))
`(progn
,(ecase state
- ((:early :late)
- `(defun ,name ,lambda-list
- ,doc
- ,@body))
- ((:final)
- `(progn
- (declaim (ftype (function * nil) ,name))
- (setf (fdefinition ',name)
- (deprecated-function ',name ',replacement ,since))
- (setf (documentation ',name 'function) ,doc))))
+ ((:early :late)
+ `(defun ,name ,lambda-list
+ ,doc
+ ,@body))
+ ((:final)
+ `(progn
+ (declaim (ftype (function * nil) ,name))
+ (setf (fdefinition ',name)
+ (deprecated-function ',name ',replacements ,since))
+ (setf (documentation ',name 'function) ,doc))))
(setf (compiler-macro-function ',name)
- (deprecation-compiler-macro ,state ,since ',name ',replacement)))))
+ (deprecation-compiler-macro ,state ,since ',name ',replacements)))))
;;; Anaphoric macros
(defmacro awhen (test &body body)