Function: defclass

defclass is an autoloaded macro defined in eieio.el.gz.

Signature

(defclass NAME SUPERCLASSES SLOTS &rest OPTIONS-AND-DOC)

Documentation

Define NAME as a new class derived from SUPERCLASS with SLOTS.

OPTIONS-AND-DOC is used as the class' options and base documentation. SUPERCLASSES is a list of superclasses to inherit from, with SLOTS being the slots residing in that class definition. Supported tags are:

  :initform - Initializing form.
  :initarg - Tag used during initialization.
  :accessor - Tag used to create a function to access this slot.
  :allocation - Specify where the value is stored.
                Defaults to :instance, but could also be :class.
  :writer - A function symbol which will write an object's slot.
  :reader - A function symbol which will read an object.
  :type - The type of data allowed in this slot (see typep).
  :documentation
              - A string documenting use of this slot.

The following are extensions on CLOS:
  :custom - When customizing an object, the custom :type. Public only.
  :label - A text string label used for a slot when customizing.
  :group - Name of a customization group this slot belongs in.
  :printer - A function to call to print the value of a slot.
                See eieio-override-prin1 as an example.

A class can also have optional options. These options happen in place of documentation (including a :documentation tag), in addition to documentation, or not at all. Supported options are:

  :documentation - The doc-string used for this class.

Options added to EIEIO:

  :allow-nil-initform - Non-nil to skip typechecking of null initforms.
  :custom-groups - List of custom group names. Organizes slots into
                        reasonable groups for customizations.
  :abstract - Non-nil to prevent instances of this class.
                        If a string, use as an error string if someone does
                        try to make an instance.
  :method-invocation-order
                      - Control the method invocation order if there is
                        multiple inheritance. Valid values are:
                         :breadth-first - The default.
                         :depth-first

Options in CLOS not supported in EIEIO:

  :metaclass - Class to use in place of standard-class
  :default-initargs - Initargs to use when initializing new objects of
                      this class.

Due to the way class options are set up, you can add any tags you wish, and reference them using the function class-option.

Probably introduced at or before Emacs version 26.1.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/eieio.el.gz
;;; Defining a new class
;;
;;;###autoload
(defmacro defclass (name superclasses slots &rest options-and-doc)
  "Define NAME as a new class derived from SUPERCLASS with SLOTS.
OPTIONS-AND-DOC is used as the class' options and base documentation.
SUPERCLASSES is a list of superclasses to inherit from, with SLOTS
being the slots residing in that class definition.  Supported tags are:

  :initform   - Initializing form.
  :initarg    - Tag used during initialization.
  :accessor   - Tag used to create a function to access this slot.
  :allocation - Specify where the value is stored.
                Defaults to `:instance', but could also be `:class'.
  :writer     - A function symbol which will `write' an object's slot.
  :reader     - A function symbol which will `read' an object.
  :type       - The type of data allowed in this slot (see `typep').
  :documentation
              - A string documenting use of this slot.

The following are extensions on CLOS:
  :custom     - When customizing an object, the custom :type.  Public only.
  :label      - A text string label used for a slot when customizing.
  :group      - Name of a customization group this slot belongs in.
  :printer    - A function to call to print the value of a slot.
                See `eieio-override-prin1' as an example.

A class can also have optional options.  These options happen in place
of documentation (including a :documentation tag), in addition to
documentation, or not at all.  Supported options are:

  :documentation - The doc-string used for this class.

Options added to EIEIO:

  :allow-nil-initform - Non-nil to skip typechecking of null initforms.
  :custom-groups      - List of custom group names.  Organizes slots into
                        reasonable groups for customizations.
  :abstract           - Non-nil to prevent instances of this class.
                        If a string, use as an error string if someone does
                        try to make an instance.
  :method-invocation-order
                      - Control the method invocation order if there is
                        multiple inheritance.  Valid values are:
                         :breadth-first - The default.
                         :depth-first

Options in CLOS not supported in EIEIO:

  :metaclass - Class to use in place of `standard-class'
  :default-initargs - Initargs to use when initializing new objects of
                      this class.

Due to the way class options are set up, you can add any tags you wish,
and reference them using the function `class-option'."
  (declare (doc-string 4) (indent defun))
  (cl-check-type superclasses list)

  (cond ((and (stringp (car options-and-doc))
              (evenp (length options-and-doc)))
         (error "Too many arguments to `defclass'"))
        ((and (symbolp (car options-and-doc))
              (oddp (length options-and-doc)))
         (error "Too many arguments to `defclass'")))

  (if (stringp (car options-and-doc))
      (setq options-and-doc
            (cons :documentation options-and-doc)))

  ;; Make sure the method invocation order is a valid value.
  (let ((io (eieio--class-option-assoc options-and-doc
                                       :method-invocation-order)))
    (when (and io (not (member io '(:depth-first :breadth-first :c3))))
      (error "Method invocation order %s is not allowed" io)))

  (let ((testsym1 (intern (concat (symbol-name name) "-p")))
        (testsym2 (intern (format "%s--eieio-childp" name)))
        (warnings '())
        (accessors ()))

    ;; Collect the accessors we need to define.
    (setq slots (mapcar (lambda (x) (if (consp x) x (list x))) slots))
    (pcase-dolist (`(,sname . ,soptions) slots)
      (let* ((acces   (plist-get soptions :accessor))
	     (initarg (plist-get soptions :initarg))
	     (reader  (plist-get soptions :reader))
	     (writer  (plist-get soptions :writer))
	     (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)
        (when (eq alloc :class)
          (cl-pushnew sname eieio--known-class-slot-names))

	(if eieio-error-unsupported-class-tags
	    (let ((tmp soptions))
	      (while tmp
		(if (not (member (car tmp) '(:accessor
					     :initform
					     :initarg
					     :documentation
					     :protection
					     :reader
					     :writer
					     :allocation
					     :type
					     :custom
					     :label
					     :group
					     :printer
					     :allow-nil-initform
					     :custom-groups)))
		    (signal 'invalid-slot-type (list (car tmp))))
		(setq tmp (cdr (cdr tmp))))))

	;; Make sure the :allocation parameter has a valid value.
	(if (not (memq alloc '(nil :class :instance)))
	    (signal 'invalid-slot-type (list :allocation alloc)))

	;; Label is nil, or a string
	(if (not (or (null label) (stringp label)))
	    (signal 'invalid-slot-type (list :label label)))

	;; Is there an initarg, but allocation of class?
	(when (and initarg (eq alloc :class))
	  (push
           (cons sname
                 (format-message
                  "Meaningless :initarg for class allocated slot `%S'"
                  sname))
	   warnings))

        (let ((init (plist-get soptions :initform)))
          (unless (or (macroexp-const-p init)
                      (eieio--eval-default-p init))
            ;; FIXME: Historically, EIEIO used a heuristic to try and guess
            ;; whether the initform is a form to be evaluated or just
            ;; a constant.  We use `eieio--eval-default-p' to see what the
            ;; heuristic says and if it disagrees with normal evaluation
            ;; then tweak the initform to make it fit and emit
            ;; a warning accordingly.
            (push
             (cons init (format "Ambiguous initform needs quoting: %S" init))
             warnings)))

	;; Anyone can have an accessor function.  This creates a function
	;; of the specified name, and also performs a `defsetf' if applicable
	;; so that users can `setf' the space returned by this function.
	(when acces
          (push `(cl-defmethod (setf ,acces) (value (this ,name))
                   (eieio-oset this ',sname value))
                accessors)
          (push `(cl-defmethod ,acces ((this ,name))
                   ,(internal--format-docstring-line
                     "Retrieve the slot `%S' from an object of class `%S'."
                     sname name)
                   (slot-value this ',sname))
                  accessors)
          (when (and eieio-backward-compatibility (eq alloc :class))
            ;; FIXME: How could I declare this *method* as obsolete.
            (push `(cl-defmethod ,acces ((this (subclass ,name)))
                     ,(concat
                       (internal--format-docstring-line
                        "Retrieve the class slot `%S' from a class `%S'."
                        sname name)
                       "\nThis method is obsolete.")
                     (when (eq eieio-backward-compatibility 'warn)
                       (message "Use of obsolete method %S on %S"
                                ',acces '(subclass ,name)))
                     (if (slot-boundp this ',sname)
                         (eieio-oref-default this ',sname)))
                  accessors)))

	;; If a writer is defined, then create a generic method of that
	;; name whose purpose is to set the value of the slot.
	(if writer
            (push `(cl-defmethod ,writer ((this ,name) value)
                     ,(internal--format-docstring-line
                       "Set the slot `%S' of an object of class `%S'."
                       sname name)
                     (setf (slot-value this ',sname) value))
                  accessors))
	;; If a reader is defined, then create a generic method
	;; of that name whose purpose is to access this slot value.
	(if reader
            (push `(cl-defmethod ,reader ((this ,name))
                     ,(internal--format-docstring-line
                       "Access the slot `%S' from object of class `%S'."
                       sname name)
                     (slot-value this ',sname))
                  accessors))
	))

    `(progn
       ,@(mapcar (lambda (w)
                   (macroexp-warn-and-return
                    (cdr w) `(progn ',(cdr w)) nil 'compile-only (car w)))
                 warnings)
       ;; This test must be created right away so we can have self-
       ;; referencing classes.  ei, a class whose slot can contain only
       ;; pointers to itself.

       ;; Create the test functions.
       (defalias ',testsym1 (eieio-make-class-predicate ',name))
       (defalias ',testsym2 (eieio-make-child-predicate ',name))

       ,@(when eieio-backward-compatibility
           (let ((f (intern (format "%s-child-p" name))))
             `((defalias ',f #',testsym2)
               (make-obsolete
                ',f ,(format "use (cl-typep ... '%s) instead" name)
                "25.1"))))

       ;; When using typep, (typep OBJ 'myclass) returns t for objects which
       ;; are subclasses of myclass.  For our predicates, however, it is
       ;; important for EIEIO to be backwards compatible, where
       ;; myobject-p, and myobject-child-p are different.
       ;; "cl" uses this technique to specify symbols with specific typep
       ;; test, so we can let typep have the CLOS documented behavior
       ;; while keeping our above predicate clean.

       (eval-and-compile
         (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2))

       (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)

       ,@accessors

       ;; Create the constructor function
       ,(if (eieio--class-option-assoc options-and-doc :abstract)
            ;; Abstract classes cannot be instantiated.  Say so.
            (let ((abs (eieio--class-option-assoc options-and-doc :abstract)))
              (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)
                 (error ,abs)))

          ;; Non-abstract classes need a constructor.
          `(defun ,name (&rest slots)
             ,(internal--format-docstring-line
               "Create a new object of class type `%S'." name)
             (declare (compiler-macro eieio--constructor-macro))
             (apply #'make-instance ',name slots))))))