From 50dc42ce1ea504657ccdcf85e9c71a2f27109610 Mon Sep 17 00:00:00 2001 From: akater Date: Sun, 26 Sep 2021 21:33:46 +0000 Subject: [PATCH] Add cl-remove-method --- lisp/emacs-lisp/cl-generic.el | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 1640975b84..7d5c8ddc0d 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -98,7 +98,7 @@ ;; usually be simplified, or even completely skipped. (eval-when-compile (require 'cl-lib)) -(eval-when-compile (require 'cl-macs)) ;For cl--find-class. +(eval-when-compile (require 'cl-macs)) ;For cl--find-class, cl-loop (eval-when-compile (require 'pcase)) (cl-defstruct (cl--generic-generalizer @@ -1255,6 +1255,35 @@ defun cl--generic-struct-specializers (tag &rest _) (cl--generic-prefill-dispatchers 0 integer) (cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer) +(cl-defmethod cl-remove-method ((generic-function cl--generic) method) + "An equivalent of Common Lisp's method for remove-method +specialized on +(COMMON-LISP:STANDARD-GENERIC-FUNCTION COMMON-LISP:METHOD)." + (setf (cl--generic-method-table generic-function) + ;; delq could cause bugs, let's see if it does + (delq method (cl--generic-method-table generic-function))) + + (cl-loop for k being hash-key in cl--generic-combined-method-memoization + when (and (eq generic-function (car k)) + (memq method (cdr k))) + do (remhash k cl--generic-combined-method-memoization)) + + ;; It might make sense to move this + (defalias (cl--generic-name generic-function) + (cl--generic-make-function generic-function)) + ;; to an :after method + ;; but it's not even clear to me whether + ;; having such :after method would be compatible with Common Lisp standard. + generic-function) + +(cl-defmethod cl-remove-method ((generic-function symbol) method) + "For Common Lisp compatibility in Elisp. + +Namely, (cl-remove-method #'f ..) should work correctly but #'f returns symbol in Elisp." + (if-let ((gf (cl--generic generic-function))) + (cl-remove-method gf method) + (error "No generic function named %s" generic-function))) + ;;; Dispatch on major mode. ;; Two parts: -- 2.32.0