From d65534d254b3965ea82a9300c12c5c07f88818b7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 27 Dec 2021 01:57:25 -0500 Subject: [PATCH] * lisp/emacs-list/eieio-compat.el: Really move to obsolete --- lisp/emacs-lisp/eieio-compat.el | 278 -------------------------------- 1 file changed, 278 deletions(-) delete mode 100644 lisp/emacs-lisp/eieio-compat.el diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el deleted file mode 100644 index a5f37500092..00000000000 --- 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 -;; 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 . - -;;; 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 -- 2.39.2