diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 27 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-preloaded.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 3 |
4 files changed, 24 insertions, 12 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index a9d422929f1..ada4f0344d3 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3412,19 +3412,23 @@ Of course, we really can't know that for sure, so it's just a heuristic." (cons . consp) (fixnum . fixnump) (float . floatp) + (frame . framep) (function . functionp) (integer . integerp) (keyword . keywordp) (list . listp) + (marker . markerp) (natnum . natnump) (number . numberp) (null . null) + (overlay . overlayp) (real . numberp) (sequence . sequencep) (subr . subrp) (string . stringp) (symbol . symbolp) (vector . vectorp) + (window . windowp) ;; FIXME: Do we really want to consider this a type? (integer-or-marker . integer-or-marker-p) )) @@ -3475,16 +3479,19 @@ Of course, we really can't know that for sure, so it's just a heuristic." (inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val))) ((and (or 'nil 't) type) (inline-quote ',type)) ((and (pred symbolp) type) - (let* ((name (symbol-name type)) - (namep (intern (concat name "p")))) - (cond - ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val))) - ((cl--macroexp-fboundp - (setq namep (intern (concat name "-p")))) - (inline-quote (funcall #',namep ,val))) - ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val))) - (t (error "Unknown type %S" type))))) - (type (error "Bad type spec: %s" type))))) + (macroexp-warn-and-return + (format-message "Unknown type: %S" type) + (let* ((name (symbol-name type)) + (namep (intern (concat name "p")))) + (cond + ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val))) + ((cl--macroexp-fboundp + (setq namep (intern (concat name "-p")))) + (inline-quote (funcall #',namep ,val))) + ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val))) + (t (error "Unknown type %S" type)))) + nil nil type)) + (type (error "Bad type spec: %S" type))))) ;;;###autoload diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 2b32bc4844a..ec9fd86a55c 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -152,7 +152,7 @@ supertypes from the most specific to least specific.") ;;;###autoload (defun cl-struct-define (name docstring parent type named slots children-sym tag print) - (cl-check-type name cl--struct-name) + (cl-check-type name (satisfies cl--struct-name-p)) (unless type ;; Legacy defstruct, using tagged vectors. Enable backward compatibility. (cl-old-struct-compat-mode 1)) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index d687289b22f..d9864e6965d 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -137,6 +137,8 @@ Currently under control of this var: X can also be is a symbol." (eieio--class-p (if (symbolp x) (cl--find-class x) x))) +(cl-deftype class () `(satisfies class-p)) + (defun eieio--class-print-name (class) "Return a printed representation of CLASS." (format "#<class %s>" (eieio-class-name class))) @@ -165,6 +167,8 @@ Return nil if that option doesn't exist." (and (recordp obj) (eieio--class-p (eieio--object-class obj)))) +(cl-deftype eieio-object () `(satisfies eieio-object-p)) + (define-obsolete-function-alias 'object-p #'eieio-object-p "25.1") (defun class-abstract-p (class) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1315ca0c627..565eaf2d733 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -271,7 +271,8 @@ This method is obsolete." ;; test, so we can let typep have the CLOS documented behavior ;; while keeping our above predicate clean. - (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2) + (eval-and-compile + (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2)) (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc) |