code.delx.au - gnu-emacs-elpa/blob - packages/cl-generic/cl-generic.el

   1 ;;; cl-generic.el --- Forward cl-generic compatibility for Emacs<25
   2
   3 ;; Copyright (C) 2015, 2016  Free Software Foundation, Inc
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6 ;; vcomment: Emacs-25's version is 1.0 so this has to stay below.
   7 ;; Version: 0.3
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This is a forward compatibility package, which provides (a subset of) the
  25 ;; features of the cl-generic package introduced in Emacs-25, for use on
  26 ;; previous emacsen.
  27
  28 ;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's
  29 ;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to
  30 ;; Emacs≥25, the built-in version of the file will take precedence, otherwise
  31 ;; you could get into trouble (although we try to hack our way around the
  32 ;; problem in case it happens).
  33
  34 ;; AFAIK, the main incompatibilities between cl-generic and EIEIO's defmethod
  35 ;;  are:
  36 ;; - EIEIO does not support multiple dispatch.  We ignore this difference here
  37 ;;   and rely on EIEIO to detect and signal the problem.
  38 ;; - EIEIO only supports primary, :before, and :after qualifiers.  We ignore
  39 ;;   this difference here and rely on EIEIO to detect and signal the problem.
  40 ;; - EIEIO does not support specializers other than classes.  We ignore this
  41 ;;   difference here and rely on EIEIO to detect and signal the problem.
  42 ;; - EIEIO uses :static instead of (subclass <foo>) and :static methods match
  43 ;;   both class arguments as well as object argument of that class.  Here we
  44 ;;   turn (subclass <foo>) into a :static qualifier and ignore the semantic
  45 ;;   difference, hoping noone will notice.
  46 ;; - EIEIO's defgeneric does not reset the function.  We ignore this difference
  47 ;;   and hope for the best.
  48 ;; - EIEIO uses `call-next-method' and `next-method-p' while cl-defmethod uses
  49 ;;   `cl-next-method-p' and `cl-call-next-method' (simple matter of renaming).
  50 ;;   We handle that by renaming the calls in the `cl-defmethod' macro.
  51 ;; - The errors signaled are slightly different.  We make
  52 ;;   cl-no-applicable-method into a "parent" error of no-method-definition,
  53 ;;   which should cover the usual cases.
  54 ;; - EIEIO's no-next-method and no-applicable-method have different calling
  55 ;;   conventions from cl-generic's.  We don't try to handle this, so just
  56 ;;   refrain from trying to call (or add methods to) `cl-no-next-method' or
  57 ;;   `cl-no-applicable-method'.
  58 ;; - EIEIO's `call-next-method' and `next-method-p' have dynamic scope whereas
  59 ;;   cl-generic's `cl-next-method-p' and `cl-call-next-method' are lexically
  60 ;;   scoped.  The cl-defmethod here handles the common subset between the two.
  61
  62 ;;; Code:
  63
  64 ;; We need to handle the situation where this package is used with an Emacs
  65 ;; that comes with a real cl-generic (i.e. ≥25.1).
  66
  67 ;; First line of defense: try to make sure the built-in cl-lib comes earlier in
  68 ;; load-path so we never get loaded:
  69 ;;;###autoload (let ((d (file-name-directory #$)))
  70 ;;;###autoload   (when (member d load-path)
  71 ;;;###autoload     (setq load-path (append (remove d load-path) (list d)))))
  72
  73 (require 'cl-lib nil 'noerror)
  74
  75 ;; In Emacs≥25, cl-lib autoloads cl-defmethod and friends.
  76
  77 (unless (fboundp 'cl-defmethod)
  78   (require 'eieio)
  79   (require 'cl)                         ;For `labels'.
  80
  81   (defalias 'cl-defgeneric 'defgeneric)
  82
  83   ;; Compatibility with code which tries to catch
  84   ;; `cl-no-applicable-method' errors.
  85   (push 'cl-no-applicable-method (get 'no-method-definition 'error-conditions))
  86
  87   (defalias 'cl-generic-apply #'apply)
  88
  89   (defmacro cl-defmethod (name args &rest body)
  90     (let ((qualifiers nil))
  91       (while (not (listp args))
  92         (push args qualifiers)
  93         (setq args (pop body)))
  94       (let ((docstring (if (and (stringp (car body)) (cdr body)) (pop body))))
  95         ;; Backward compatibility for `no-next-method' and
  96         ;; `no-applicable-method', which have slightly different calling
  97         ;; convention than their cl-generic counterpart.
  98         (pcase name
  99           (`cl-no-next-method
 100            (setq name 'no-next-method)
 101            (setq args (cddr args)))
 102           (`cl-no-applicable-method
 103            (setq name 'no-applicable-method)
 104            (setq args `(,(nth 1 args) ,(nth 0 args)
 105                         ,(make-symbol "_ignore") . ,(nthcdr 2 args)))))
 106         (let ((arg1 (car args)))
 107           (when (eq (car-safe (car (cdr-safe arg1))) 'subclass)
 108             ;; There's no exact equivalent to `subclass', but :static
 109             ;; provides a superset which should work just as well in practice.
 110             (push :static qualifiers)
 111             (setf (cadr arg1) (cadr (cadr arg1)))))
 112
 113         `(defmethod ,name ,@qualifiers ,args
 114            ,@(if docstring (list docstring))
 115            ;; We could just alias `cl-call-next-method' to `call-next-method',
 116            ;; and that would work, but then files compiled with this cl-generic
 117            ;; wouldn't work in Emacs-25 any more.
 118            ;; Also we fallback on `labels' if `cl-flet' is not available
 119            ;; (ELPA's cl-lib emulation doesn't provide cl-flet).
 120            ;; We don't always use `labels' because that generates warnings
 121            ;; in newer Emacsen where `cl-flet' is available.
 122            ,@(if qualifiers
 123                  ;; Must be :before or :after, so can't call next-method.
 124                  body
 125                `((,(if (fboundp 'cl-flet) 'cl-flet 'labels)
 126                       ((cl-call-next-method (&rest args)
 127                                             (apply #'call-next-method args))
 128                        (cl-next-method-p () (next-method-p)))
 129                   ,@body))))))))
 130
 131 (provide 'cl-generic)
 132 ;;; cl-generic.el ends here