Function: cl-defgeneric

cl-defgeneric is a macro defined in cl-generic.el.gz.

Signature

(cl-defgeneric NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)

Documentation

Create a generic function NAME.

DOC-STRING is the base documentation for this class. A generic function usually has no body, as its purpose is to decide which method body is appropriate to use; ARGS are currently ignored if there's no body. If BODY is present, it provides the default implementation. Specific implementation methods are defined with cl-defmethod. OPTIONS-AND-METHODS currently understands:
- (:documentation DOCSTRING)
- (declare DECLARATIONS)
- (:argument-precedence-order &rest ARGS)
- (:method [QUALIFIERS...] ARGS &rest BODY)
DEFAULT-BODY, if present, is used as the body of a default method.

View in manual

Probably introduced at or before Emacs version 25.1.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/cl-generic.el.gz
;;;###autoload
(defmacro cl-defgeneric (name args &rest options-and-methods)
  "Create a generic function NAME.
DOC-STRING is the base documentation for this class.  A generic
function usually has no body, as its purpose is to decide which
method body is appropriate to use; ARGS are currently ignored if
there's no body.  If BODY is present, it provides the default
implementation.
Specific implementation methods are defined with `cl-defmethod'.
OPTIONS-AND-METHODS currently understands:
- (:documentation DOCSTRING)
- (declare DECLARATIONS)
- (:argument-precedence-order &rest ARGS)
- (:method [QUALIFIERS...] ARGS &rest BODY)
DEFAULT-BODY, if present, is used as the body of a default method.

\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)"
  (declare (indent 2) (doc-string 3)
           (debug
            (&define
             &interpose
             [&name sexp] ;Allow (setf ...) additionally to symbols.
             cl--generic-edebug-remember-name
             listp lambda-doc
             [&rest [&or
                     ("declare" &rest sexp)
                     (":argument-precedence-order" &rest sexp)
                     (&define ":method"
                              [&name
                               [[&rest cl-generic--method-qualifier-p]
                                listp] ;Formal args
                               cl--generic-edebug-make-name in:method]
                              lambda-doc
                              def-body)]]
             def-body)))
  (let* ((doc (if (stringp (car-safe options-and-methods))
                  (pop options-and-methods)))
         (declarations nil)
         (methods ())
         (options ())
         (warnings
          (let ((nonsymargs
                 (delq nil (mapcar (lambda (arg) (unless (symbolp arg) arg))
                                   args))))
            (when nonsymargs
              (list
               (macroexp-warn-and-return
                (format "Non-symbol arguments to cl-defgeneric: %s"
                        (mapconcat #'prin1-to-string nonsymargs " "))
                nil nil nil nonsymargs)))))
         next-head)
    (while (progn (setq next-head (car-safe (car options-and-methods)))
                  (or (keywordp next-head)
                      (eq next-head 'declare)))
      (pcase next-head
        (`:documentation
         (when doc (error "Multiple doc strings for %S" name))
         (setq doc (cadr (pop options-and-methods))))
        (`declare
         (when declarations (error "Multiple `declare' for %S" name))
         (setq declarations (pop options-and-methods)))
        (`:method (push (cdr (pop options-and-methods)) methods))
        (_ (push (pop options-and-methods) options))))
    (when options-and-methods
      ;; Anything remaining is assumed to be a default method body.
      (push `(,args ,@options-and-methods) methods))
    (when (eq 'setf (car-safe name))
      (require 'gv)
      (declare-function gv-setter "gv" (name))
      (setq name (gv-setter (cadr name))))
    `(prog1
         (progn
           ,@warnings
           (defalias ',name
             (cl-generic-define ',name ',args ',(nreverse options))
             ,(if (consp doc)           ;An expression rather than a constant.
                  `(help-add-fundoc-usage ,doc ',args)
                (help-add-fundoc-usage doc args)))
           :autoload-end
           ,(when methods
              `(with-suppressed-warnings ((obsolete ,name))
                 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
                           (nreverse methods)))))
       ,@(mapcar (lambda (declaration)
                   (let ((f (cdr (assq (car declaration)
                                       defun-declarations-alist))))
                     (cond
                      (f (apply (car f) name args (cdr declaration)))
                      (t (message "Warning: Unknown defun property `%S' in %S"
                                  (car declaration) name)
                         nil))))
                 (cdr declarations)))))