(error "Method invocation order %s is not allowed" io)))
(let ((testsym1 (intern (concat (symbol-name name) "-p")))
- (testsym2 (intern (format "eieio--childp--%s" name)))
+ (testsym2 (intern (format "%s--eieio-childp" name)))
(accessors ()))
;; Collect the accessors we need to define.
(alloc (plist-get soptions :allocation))
(label (plist-get soptions :label)))
+ ;; Update eieio--known-slot-names already in case we compile code which
+ ;; uses this before the class is loaded.
+ (cl-pushnew sname eieio--known-slot-names)
+
(if eieio-error-unsupported-class-tags
(let ((tmp soptions))
(while tmp
(if (not (stringp abs))
(setq abs (format "Class %s is abstract" name)))
`(defun ,name (&rest _)
- ,(format "You cannot create a new object of type %S." name)
+ ,(format "You cannot create a new object of type `%S'." name)
(error ,abs)))
;; Non-abstract classes need a constructor.
`(defun ,name (&rest slots)
- ,(format "Create a new object with name NAME of class type %S."
- name)
+ ,(format "Create a new object of class type `%S'." name)
(declare (compiler-macro
(lambda (whole)
(if (not (stringp (car slots)))
(list var `(slot-value ,object ',slot))))
spec-list)
,@body)))
+
+;; Keep it as a non-inlined function, so the internals of object don't get
+;; hard-coded in random .elc files.
+(defun eieio-pcase-slot-index-table (obj)
+ "Return some data structure from which can be extracted the slot offset."
+ (eieio--class-index-table
+ (symbol-value (eieio--object-class-tag obj))))
+
+(defun eieio-pcase-slot-index-from-index-table (index-table slot)
+ "Find the index to pass to `aref' to access SLOT."
+ (let ((index (gethash slot index-table)))
+ (if index (+ (eval-when-compile
+ (length (cl-struct-slot-info 'eieio--object)))
+ index))))
+
+(pcase-defmacro eieio (&rest fields)
+ "Pcase patterns to match EIEIO objects.
+Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
+field NAME is matched against UPAT, or they can be of the form NAME which
+is a shorthand for (NAME NAME)."
+ (declare (debug (&rest [&or (sexp pcase-UPAT) sexp])))
+ (let ((is (make-symbol "table")))
+ ;; FIXME: This generates a horrendous mess of redundant let bindings.
+ ;; `pcase' needs to be improved somehow to introduce let-bindings more
+ ;; sparingly, or the byte-compiler needs to be taught to optimize
+ ;; them away.
+ ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
+ ;; various branches.
+ `(and (pred eieio-object-p)
+ (app eieio-pcase-slot-index-table ,is)
+ ,@(mapcar (lambda (field)
+ (let* ((name (if (consp field) (car field) field))
+ (pat (if (consp field) (cadr field) field))
+ (i (make-symbol "index")))
+ `(and (let (and ,i (pred natnump))
+ (eieio-pcase-slot-index-from-index-table
+ ,is ',name))
+ (app (pcase--flip aref ,i) ,pat))))
+ fields))))
\f
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
"Return child classes to CLASS.
The CLOS function `class-direct-subclasses' is aliased to this function."
(cl-check-type class class)
- (eieio--class-children (eieio--class-v class)))
+ (eieio--class-children (cl--find-class class)))
(define-obsolete-function-alias
'class-children #'eieio-class-children "24.4")
"Return the class that SYMBOL represents.
If there is no class, nil is returned if ERRORP is nil.
If ERRORP is non-nil, `wrong-argument-type' is signaled."
- (let ((class (eieio--class-v symbol)))
+ (let ((class (cl--find-class symbol)))
(cond
((eieio--class-p class) class)
(errorp (signal 'wrong-type-argument (list 'class-p symbol))))))
This class is not stored in the `parent' slot of a class vector."
:abstract t)
-(setq eieio-default-superclass (eieio--class-v 'eieio-default-superclass))
+(setq eieio-default-superclass (cl--find-class 'eieio-default-superclass))
(defalias 'standard-class 'eieio-default-superclass)
(princ comment)
(princ "\n"))
(let* ((cl (eieio-object-class this))
- (cv (eieio--class-v cl)))
+ (cv (cl--find-class cl)))
;; Now output readable lisp to recreate this object
;; It should look like this:
;; (<constructor> <name> <slot> <slot> ... )
(error "EIEIO: `change-class' is unimplemented"))
;; Hook ourselves into help system for describing classes and methods.
+;; FIXME: This is not actually needed any more since we can click on the
+;; hyperlink from the constructor's docstring to see the type definition.
(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
;;; Interfacing with edebug
\f
;;; Start of automatically extracted autoloads.
\f
-;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "813d32fbf76d4248fc6b4dc97ebcd720")
+;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "916f54b818479a77a02f3ecccda84a11")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
;;;***
\f
-;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "3005b815c6b30eccbf0642170b3f82a5")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "cb1aba7670b6a4b9c6f968c0ad6dc130")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
\(fn &optional ROOT-CLASS)" t nil)
-(autoload 'eieio-help-class "eieio-opt" "\
-Print help description for CLASS.
-If CLASS is actually an object, then also display current values of that object.
-
-\(fn CLASS)" nil nil)
+(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1")
(autoload 'eieio-help-constructor "eieio-opt" "\
Describe CTR if it is a class constructor.