#!+sb-package-locks
(let* ((symbol (etypecase name
(symbol name)
- (list (if (eq 'setf (first name))
+ (list (if (and (consp (cdr name))
+ (eq 'setf (first name)))
(second name)
- ;; Skip (class-predicate foo), etc.
+ ;; Skip lists of length 1, single conses and
+ ;; (class-predicate foo), etc.
;; FIXME: MOP and package-lock
;; interaction needs to be thought about.
(return-from
(push n (package-%nicknames package)))
((eq found package))
((string= (the string (package-%name found)) n)
- (error 'simple-package-error
- :package package
- :format-control "~S is a package name, so it cannot be a nickname for ~S."
- :format-arguments (list n (package-%name package))))
+ (cerror "Ignore this nickname."
+ 'simple-package-error
+ :package package
+ :format-control "~S is a package name, so it cannot be a nickname for ~S."
+ :format-arguments (list n (package-%name package))))
(t
- (error 'simple-package-error
- :package package
- :format-control "~S is already a nickname for ~S."
- :format-arguments (list n (package-%name found))))))))
+ (cerror "Leave this nickname alone."
+ 'simple-package-error
+ :package package
+ :format-control "~S is already a nickname for ~S."
+ :format-arguments (list n (package-%name found))))))))
(defun make-package (name &key
(use '#.*default-package-use-list*)
#!+sb-doc
"Changes the name and nicknames for a package."
(let* ((package (find-undeleted-package-or-lose package))
- (name (string name))
+ (name (package-namify name))
(found (find-package name))
(nicks (mapcar #'string nicknames)))
(unless (or (not found) (eq found package))
;; We just simple-stringify the name and call INTERN*, where the real
;; logic is.
(let ((name (if (simple-string-p name)
- name
- (coerce name 'simple-string)))
+ name
+ (coerce name 'simple-string)))
(package (find-undeleted-package-or-lose package)))
(declare (simple-string name))
(intern* name
:package package
:format-control
"~@<These symbols are not accessible in the ~A package:~2I~_~S~@:>"
- :format-arguments (list (package-%name package) missing)))
+ :format-arguments (list (package-%name package) missing))
+ 'import (package-%name package))
(import missing package))
(import imports package))