master d65534d254: * lisp/emacs-list/eieio-compat.el: Really move to obsolete

[Stefan Monnier]

branch: master
commit d65534d254b3965ea82a9300c12c5c07f88818b7
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * lisp/emacs-list/eieio-compat.el: Really move to obsolete
---
 lisp/emacs-lisp/eieio-compat.el | 278 ----------------------------------------
 1 file changed, 278 deletions(-)

diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
deleted file mode 100644
index a5f3750009..0000000000
--- a/lisp/emacs-lisp/eieio-compat.el
+++ /dev/null
@@ -1,278 +0,0 @@
-;;; eieio-compat.el --- Compatibility with Older EIEIO versions  -*- 
lexical-binding:t -*-
-
-;; Copyright (C) 1995-1996, 1998-2021 Free Software Foundation, Inc.
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Keywords: OO, lisp
-;; Package: eieio
-;; Obsolete-Since: 25.1
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Backward compatibility definition of old EIEIO functions in
-;; terms of newer equivalent.
-
-;; The main elements are the old EIEIO `defmethod' and `defgeneric' which are
-;; now implemented on top of cl-generic.  The differences we have to
-;; accommodate are:
-;; - EIEIO's :static methods (turned into a new `eieio--static' specializer).
-;; - EIEIO's support for `call-next-method' and `next-method-p' instead of
-;;   `cl-next-method-p' and `cl-call-next-method' (simple matter of renaming).
-;; - Different errors are signaled.
-;; - EIEIO's defgeneric does not reset the function.
-;; - EIEIO's no-next-method and no-applicable-method can't be aliases of
-;;   cl-generic's namesakes since they have different calling conventions,
-;;   which means that packages that (defmethod no-next-method ..) don't work.
-;; - EIEIO's `call-next-method' and `next-method-p' had dynamic scope whereas
-;;   cl-generic's `cl-next-method-p' and `cl-call-next-method' are lexically
-;;   scoped.
-
-;;; Code:
-
-(require 'eieio-core)
-(require 'cl-generic)
-
-(put 'eieio--defalias 'byte-hunk-handler
-     #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
-;;;###autoload
-(defun eieio--defalias (name body)
-  "Like `defalias', but with less side-effects.
-More specifically, it has no side-effects at all when the new function
-definition is the same (`eq') as the old one."
-  (cl-assert (not (symbolp body)))
-  (while (and (fboundp name) (symbolp (symbol-function name)))
-    ;; Follow aliases, so methods applied to obsolete aliases still work.
-    (setq name (symbol-function name)))
-  (unless (and (fboundp name)
-               (eq (symbol-function name) body))
-    (defalias name body)))
-
-;;;###autoload
-(defmacro defgeneric (method args &optional doc-string)
-  "Create a generic function METHOD.
-DOC-STRING is the base documentation for this class.  A generic
-function has no body, as its purpose is to decide which method body
-is appropriate to use.  Uses `defmethod' to create methods, and calls
-`defgeneric' for you.  With this implementation the ARGS are
-currently ignored.  You can use `defgeneric' to apply specialized
-top level documentation to a method."
-  (declare (doc-string 3) (obsolete cl-defgeneric "25.1")
-           (indent defun))
-  `(eieio--defalias ',method
-                    (eieio--defgeneric-init-form
-                     ',method
-                     ,(if doc-string (help-add-fundoc-usage doc-string 
args)))))
-
-;;;###autoload
-(defmacro defmethod (method &rest args)
-  "Create a new METHOD through `defgeneric' with ARGS.
-
-The optional second argument KEY is a specifier that
-modifies how the method is called, including:
-   :before  - Method will be called before the :primary
-   :primary - The default if not specified
-   :after   - Method will be called after the :primary
-   :static  - First arg could be an object or class
-The next argument is the ARGLIST.  The ARGLIST specifies the arguments
-to the method as with `defun'.  The first argument can have a type
-specifier, such as:
-  ((VARNAME CLASS) ARG2 ...)
-where VARNAME is the name of the local variable for the method being
-created.  The CLASS is a class symbol for a class made with `defclass'.
-A DOCSTRING comes after the ARGLIST, and is optional.
-All the rest of the args are the BODY of the method.  A method will
-return the value of the last form in the BODY.
-
-Summary:
-
- (defmethod mymethod [:before | :primary | :after | :static]
-                     ((typearg class-name) arg2 &optional opt &rest rest)
-    \"doc-string\"
-     body)"
-  (declare (doc-string 3) (obsolete cl-defmethod "25.1")
-           (indent defun)
-           (debug
-            (&define                    ; this means we are defining something
-             [&name sexp]   ;Allow (setf ...) additionally to symbols.
-             ;; ^^ This is the methods symbol
-             [ &optional symbolp ]                ; this is key :before etc
-             cl-generic-method-args               ; arguments
-             [ &optional stringp ]                ; documentation string
-             def-body                             ; part to be debugged
-             )))
-  (let* ((key (if (keywordp (car args)) (pop args)))
-        (params (car args))
-        (arg1 (car params))
-         (fargs (if (consp arg1)
-                   (cons (car arg1) (cdr params))
-                 params))
-        (class (if (consp arg1) (nth 1 arg1)))
-         (code `(lambda ,fargs ,@(cdr args))))
-    `(progn
-       ;; Make sure there is a generic and the byte-compiler sees it.
-       (defgeneric ,method ,args)
-       (eieio--defmethod ',method ',key ',class #',code))))
-
-(defun eieio--generic-static-symbol-specializers (tag &rest _)
-  (cl-assert (or (null tag) (eieio--class-p tag)))
-  (when (eieio--class-p tag)
-    (let ((superclasses (eieio--generic-subclass-specializers tag))
-         (specializers ()))
-      (dolist (superclass superclasses)
-       (push superclass specializers)
-       (push `(eieio--static ,(cadr superclass)) specializers))
-      (nreverse specializers))))
-
-(cl-generic-define-generalizer eieio--generic-static-symbol-generalizer
-  ;; Give it a slightly higher priority than `subclass' so that the
-  ;; interleaved list comes before subclass's non-interleaved list.
-  61 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name)))
-  #'eieio--generic-static-symbol-specializers)
-(cl-generic-define-generalizer eieio--generic-static-object-generalizer
-  ;; Give it a slightly higher priority than `class' so that the
-  ;; interleaved list comes before the class's non-interleaved list.
-  51 #'cl--generic-struct-tag
-  (lambda (tag &rest _)
-    (and (symbolp tag) (setq tag (cl--find-class tag))
-         (eieio--class-p tag)
-         (let ((superclasses (eieio--class-precedence-list tag))
-               (specializers ()))
-           (dolist (superclass superclasses)
-             (setq superclass (eieio--class-name superclass))
-             (push superclass specializers)
-             (push `(eieio--static ,superclass) specializers))
-           (nreverse specializers)))))
-
-(cl-defmethod cl-generic-generalizers ((_specializer (head eieio--static)))
-  (list eieio--generic-static-symbol-generalizer
-        eieio--generic-static-object-generalizer))
-
-;;;###autoload
-(defun eieio--defgeneric-init-form (method doc-string)
-  (if doc-string (put method 'function-documentation doc-string))
-  (if (memq method '(no-next-method no-applicable-method))
-      (symbol-function method)
-    (let ((generic (cl-generic-ensure-function method)))
-      (or (symbol-function (cl--generic-name generic))
-          (cl--generic-make-function generic)))))
-
-;;;###autoload
-(defun eieio--defmethod (method kind argclass code)
-  (setq kind (intern (downcase (symbol-name kind))))
-  (let* ((specializer (if (not (eq kind :static))
-                          (or argclass t)
-                        (setq kind nil)
-                        `(eieio--static ,argclass)))
-         (uses-cnm (not (memq kind '(:before :after))))
-         (specializers `((arg ,specializer)))
-         (code
-          ;; Backward compatibility for `no-next-method' and
-          ;; `no-applicable-method', which have slightly different calling
-          ;; convention than their cl-generic counterpart.
-          (pcase method
-            ('no-next-method
-             (setq method 'cl-no-next-method)
-             (setq specializers `(generic method ,@specializers))
-             (lambda (_generic _method &rest args) (apply code args)))
-            ('no-applicable-method
-             (setq method 'cl-no-applicable-method)
-             (setq specializers `(generic ,@specializers))
-             (lambda (generic arg &rest args)
-               (apply code arg (cl--generic-name generic) (cons arg args))))
-            (_ code))))
-    (cl-generic-define-method
-     method (unless (memq kind '(nil :primary)) (list kind))
-     specializers uses-cnm
-     (if uses-cnm
-         (let* ((docstring (documentation code 'raw))
-                (args (help-function-arglist code 'preserve-names))
-                (doc-only (if docstring
-                              (let ((split (help-split-fundoc docstring nil)))
-                                (if split (cdr split) docstring)))))
-           (lambda (cnm &rest args)
-             (:documentation
-              (help-add-fundoc-usage doc-only (cons 'cl-cnm args)))
-             (cl-letf (((symbol-function 'call-next-method) cnm)
-                       ((symbol-function 'next-method-p)
-                        (lambda () (cl--generic-isnot-nnm-p cnm))))
-               (apply code args))))
-       code))
-    ;; The old EIEIO code did not signal an error when there are methods
-    ;; applicable but only of the before/after kind.  So if we add a :before
-    ;; or :after, make sure there's a matching dummy primary.
-    (when (and (memq kind '(:before :after))
-               ;; FIXME: Use `cl-find-method'?
-               (not (cl-find-method method ()
-                                    (mapcar (lambda (arg)
-                                              (if (consp arg) (nth 1 arg) t))
-                                            specializers))))
-      (cl-generic-define-method method () specializers t
-                                (lambda (cnm &rest args)
-                                  (if (cl--generic-isnot-nnm-p cnm)
-                                      (apply cnm args)))))
-    method))
-
-;; Compatibility with code which tries to catch `no-method-definition' errors.
-(push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions))
-
-(defun generic-p (fname) (not (null (cl--generic fname))))
-
-(defun no-next-method (&rest args)
-  (declare (obsolete cl-no-next-method "25.1"))
-  (apply #'cl-no-next-method 'unknown nil args))
-
-(defun no-applicable-method (object method &rest args)
-  (declare (obsolete cl-no-applicable-method "25.1"))
-  (apply #'cl-no-applicable-method method object args))
-
-(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
-(defun next-method-p ()
-  (declare (obsolete cl-next-method-p "25.1"))
-  ;; EIEIO's `next-method-p' just returned nil when called in an
-  ;; invalid context.
-  (message "next-method-p called outside of a primary or around method")
-  nil)
-
-;;;###autoload
-(defun eieio-defmethod (method args)
-  "Obsolete work part of an old version of the `defmethod' macro."
-  (declare (obsolete cl-defmethod "24.1"))
-  (eval `(defmethod ,method ,@args))
-  method)
-
-;;;###autoload
-(defun eieio-defgeneric (method doc-string)
-  "Obsolete work part of an old version of the `defgeneric' macro."
-  (declare (obsolete cl-defgeneric "24.1"))
-  (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
-  ;; Return the method
-  'method)
-
-;;;###autoload
-(defun eieio-defclass (cname superclasses slots options)
-  (declare (obsolete eieio-defclass-internal "25.1"))
-  (eval `(defclass ,cname ,superclasses ,slots ,@options)))
-
-
-;; Local Variables:
-;; generated-autoload-file: "eieio-loaddefs.el"
-;; End:
-
-(provide 'eieio-compat)
-
-;;; eieio-compat.el ends here