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  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.2
   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   (defmacro cl-defmethod (name args &rest body)
  88     (let ((qualifiers nil))
  89       (while (not (listp args))
  90         (push args qualifiers)
  91         (setq args (pop body)))
  92       (let ((arg1 (car args)))
  93         (when (eq (car-safe (car (cdr-safe arg1))) 'subclass)
  94           ;; There's no exact equivalent to `subclass', but :static
  95           ;; provides a superset which should work just as well in practice.
  96           (push :static qualifiers)
  97           (setf (cadr arg1) (cadr (cadr arg1)))))
  98       (let ((docstring (if (and (stringp (car body)) (cdr body)) (pop body))))
  99         `(defmethod ,name ,@qualifiers ,args
 100            ,@(if docstring (list docstring))
 101            ;; We could just alias `cl-call-next-method' to `call-next-method',
 102            ;; and that would work, but then files compiled with this cl-generic
 103            ;; wouldn't work in Emacs-25 any more.
 104            ;; Also we fallback on `labels' if `cl-flet' is not available
 105            ;; (ELPA's cl-lib emulation doesn't provide cl-flet).
 106            ;; We don't always use `labels' because that generates warnings
 107            ;; in newer Emacsen where `cl-flet' is available.
 108            ,@(if qualifiers
 109                  ;; Must be :before or :after, so can't call next-method.
 110                  body
 111                `((,(if (fboundp 'cl-flet) 'cl-flet 'labels)
 112                       ((cl-call-next-method (&rest args)
 113                                             (apply #'call-next-method args))
 114                        (cl-next-method-p () (next-method-p)))
 115                    ,@body))))))))
 116
 117 (provide 'cl-generic)
 118 ;;; cl-generic.el ends here