[Emacs-diffs] master fd62486: * lisp/emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error.

[Stefan Monnier]

branch: master
commit fd62486e819056bc9d0f00c09731a45a7f837997
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error.
    (cl--generic-build-combined-method): Use it.
---
 lisp/ChangeLog                |    5 +++++
 lisp/emacs-lisp/cl-generic.el |   18 +++++++++++++-----
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5cceb19..ed4e1ab 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-23  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error.
+       (cl--generic-build-combined-method): Use it.
+
 2015-01-22  Paul Eggert  <address@hidden>
 
        Don't downcase system diagnostics' first letters
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index f214faf..095f1e5 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -462,9 +462,12 @@ for all those different tags in the method-cache.")
         (gethash (cons generic-name mets-by-qual)
                  cl--generic-combined-method-memoization)
       (cond
-       ((null mets-by-qual) (lambda (&rest args)
-                              (apply #'cl-no-applicable-method
-                                     generic-name args)))
+       ((null mets-by-qual)
+        (lambda (&rest args)
+          (apply #'cl-no-applicable-method generic-name args)))
+       ((null (alist-get :primary mets-by-qual))
+        (lambda (&rest args)
+          (apply #'cl-no-primary-method generic-name args)))
        (t
         (let* ((fun (lambda (&rest args)
                       ;; FIXME: CLOS passes as second arg the "calling method".
@@ -475,8 +478,6 @@ for all those different tags in the method-cache.")
                       ;; . QUALIFIER) USE-CNM . FUNCTION) entry from the method
                       ;; table, but the caller wouldn't be able to do much with
                       ;; it anyway.  So we pass nil for now.
-                      ;; FIXME: signal `no-primary-method' if there's
-                      ;; no primary.
                       (apply #'cl-no-next-method generic-name nil args)))
                ;; We use `cdr' to drop the `uses-cnm' annotations.
                (before
@@ -546,6 +547,7 @@ for all those different tags in the method-cache.")
 
 (define-error 'cl-no-method "No method for %S")
 (define-error 'cl-no-next-method "No next method for %S" 'cl-no-method)
+(define-error 'cl-no-primary-method "No primary method for %S" 'cl-no-method)
 (define-error 'cl-no-applicable-method "No applicable method for %S"
   'cl-no-method)
 
@@ -559,6 +561,11 @@ for all those different tags in the method-cache.")
 (cl-defmethod cl-no-applicable-method (generic &rest args)
   (signal 'cl-no-applicable-method `(,generic ,@args)))
 
+(cl-defgeneric cl-no-primary-method (generic &rest args)
+  "Function called when a method call finds no primary method.")
+(cl-defmethod cl-no-primary-method (generic &rest args)
+  (signal 'cl-no-primary-method `(,generic ,@args)))
+
 (defun cl-call-next-method (&rest _args)
   "Function to call the next applicable method.
 Can only be used from within the lexical body of a primary or around method."
@@ -727,6 +734,7 @@ Can only be used from within the lexical body of a primary 
or around method."
 ;;     (foo 'major-mode toto titi)
 ;;
 ;; FIXME: Better would be to do that via dispatch on an "implicit argument".
+;; E.g. (cl-defmethod foo (y z &context (major-mode text-mode)) ...)
 
 ;; (defvar cl--generic-major-modes (make-hash-table :test #'eq))
 ;;