| ... |
... |
@@ -77,11 +77,11 @@ |
|
77
|
77
|
;;; definition is done by %defmacro which we expand into.
|
|
78
|
78
|
;;;
|
|
79
|
79
|
(defmacro defmacro (name lambda-list &body body)
|
|
|
80
|
+ #+nil
|
|
80
|
81
|
(when lisp::*enable-package-locked-errors*
|
|
81
|
82
|
(multiple-value-bind (valid block-name)
|
|
82
|
83
|
(ext:valid-function-name-p name)
|
|
83
|
84
|
(declare (ignore valid))
|
|
84
|
|
- #+nil
|
|
85
|
85
|
(let ((package (symbol-package block-name)))
|
|
86
|
86
|
(when package
|
|
87
|
87
|
(when (ext:package-definition-lock package)
|
| ... |
... |
@@ -138,28 +138,33 @@ |
|
138
|
138
|
(c::%%defmacro name definition doc))
|
|
139
|
139
|
;;;
|
|
140
|
140
|
(defun c::%%defmacro (name definition doc)
|
|
141
|
|
- (let ((package (symbol-package name)))
|
|
142
|
|
- (when package
|
|
143
|
|
- (when (and (ext:package-definition-lock package)
|
|
144
|
|
- ;; Bootstrap. This might not be bound yet.
|
|
145
|
|
- (boundp 'lisp::*enable-package-locked-errors)
|
|
146
|
|
- lisp::*enable-package-locked-errors)
|
|
147
|
|
- (restart-case
|
|
148
|
|
- (error 'lisp::package-locked-error
|
|
149
|
|
- :package package
|
|
150
|
|
- :format-control (intl:gettext "defining macro ~A")
|
|
151
|
|
- :format-arguments (list name))
|
|
152
|
|
- (continue ()
|
|
153
|
|
- :report (lambda (stream)
|
|
154
|
|
- (write-string (intl:gettext "Ignore the lock and continue") stream)))
|
|
155
|
|
- (unlock-package ()
|
|
156
|
|
- :report (lambda (stream)
|
|
157
|
|
- (write-string (intl:gettext "Disable the package's definition-lock then continue") stream))
|
|
158
|
|
- (setf (ext:package-definition-lock package) nil))
|
|
159
|
|
- (unlock-all ()
|
|
160
|
|
- :report (lambda (stream)
|
|
161
|
|
- (write-string (intl:gettext "Unlock all packages, then continue") stream))
|
|
162
|
|
- (lisp::unlock-all-packages))))))
|
|
|
141
|
+ ;; Bootstrap: *enable-package-locked-errors* may not be bound while
|
|
|
142
|
+ ;; loading the kernel.core.
|
|
|
143
|
+ (when (and (boundp 'lisp::*enable-package-locked-errors*)
|
|
|
144
|
+ lisp::*enable-package-locked-errors*)
|
|
|
145
|
+ (multiple-value-bind (valid block-name)
|
|
|
146
|
+ (ext:valid-function-name-p name)
|
|
|
147
|
+ (declare (ignore valid))
|
|
|
148
|
+ (let ((package (symbol-package block-name)))
|
|
|
149
|
+ (when package
|
|
|
150
|
+ (when (ext:package-definition-lock package)
|
|
|
151
|
+ (restart-case
|
|
|
152
|
+ (error 'lisp::package-locked-error
|
|
|
153
|
+ :package package
|
|
|
154
|
+ :format-control (intl:gettext "defining macro ~A")
|
|
|
155
|
+ :format-arguments (list name))
|
|
|
156
|
+ (continue ()
|
|
|
157
|
+ :report (lambda (stream)
|
|
|
158
|
+ (write-string (intl:gettext "Ignore the lock and continue") stream)))
|
|
|
159
|
+ (unlock-package ()
|
|
|
160
|
+ :report (lambda (stream)
|
|
|
161
|
+ (write-string (intl:gettext "Disable the package's definition-lock then continue") stream))
|
|
|
162
|
+ (setf (ext:package-definition-lock package) nil))
|
|
|
163
|
+ (unlock-all ()
|
|
|
164
|
+ :report (lambda (stream)
|
|
|
165
|
+ (write-string (intl:gettext "Unlock all packages, then continue") stream))
|
|
|
166
|
+ (lisp::unlock-all-packages))))))))
|
|
|
167
|
+
|
|
163
|
168
|
(clear-info function where-from name)
|
|
164
|
169
|
(setf (macro-function name) definition)
|
|
165
|
170
|
(setf (documentation name 'function) doc)
|