diff options
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 26 | ||||
| -rw-r--r-- | lisp/progmodes/elisp-mode.el | 5 | ||||
| -rw-r--r-- | test/lisp/progmodes/elisp-mode-tests.el | 47 |
3 files changed, 59 insertions, 19 deletions
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index b7c8395f71..d5612f4eb1 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -446,6 +446,12 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (setq methods (cdr methods))) methods) +(defun cl--generic-load-hist-format (name qualifiers specializers) + ;; FIXME: This function is used in elisp-mode.el and + ;; elisp-mode-tests.el, but I still decided to use an internal name + ;; because these uses should be removed or moved into cl-generic.el. + `(,name ,qualifiers . ,specializers)) + ;;;###autoload (defun cl-generic-define-method (name qualifiers args uses-cnm function) (pcase-let* @@ -486,8 +492,9 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (cons method mt) ;; Keep the ordering; important for methods with :extra qualifiers. (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) - (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) - ,qualifiers . ,specializers)) + (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format + (cl--generic-name generic) + qualifiers specializers)) current-load-list :test #'equal) ;; FIXME: Try to avoid re-constructing a new function if the old one ;; is still valid (e.g. still empty method cache)? @@ -864,18 +871,22 @@ Can only be used from within the lexical body of a primary or around method." (defun cl--generic-search-method (met-name) "For `find-function-regexp-alist'. Searches for a cl-defmethod. -MET-NAME is a cons (SYMBOL . SPECIALIZERS)." +MET-NAME is as returned by `cl--generic-load-hist-format'." (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+" (regexp-quote (format "%s" (car met-name))) "\\_>"))) (or (re-search-forward (concat base-re "[^&\"\n]*" + (mapconcat (lambda (qualifier) + (regexp-quote (format "%S" qualifier))) + (cadr met-name) + "[ \t\n]*") (mapconcat (lambda (specializer) (regexp-quote (format "%S" (if (consp specializer) (nth 1 specializer) specializer)))) - (remq t (cdr met-name)) + (remq t (cddr met-name)) "[ \t\n]*)[^&\"\n]*")) nil t) (re-search-forward base-re nil t)))) @@ -932,9 +943,10 @@ MET-NAME is a cons (SYMBOL . SPECIALIZERS)." (let* ((info (cl--generic-method-info method))) ;; FIXME: Add hyperlinks for the types as well. (insert (format "%s%S" (nth 0 info) (nth 1 info))) - (let* ((met-name `(,function - ,(cl--generic-method-qualifiers method) - . ,(cl--generic-method-specializers method))) + (let* ((met-name (cl--generic-load-hist-format + function + (cl--generic-method-qualifiers method) + (cl--generic-method-specializers method))) (file (find-lisp-object-file-name met-name 'cl-defmethod))) (when file (insert (substitute-command-keys " in `")) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index f3607911aa..2fbd60db0d 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -712,7 +712,10 @@ non-nil result supercedes the xrefs produced by (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly (specializers (cl--generic-method-specializers method)) (non-default nil) - (met-name (cons symbol specializers)) + (met-name (cl--generic-load-hist-format + symbol + (cl--generic-method-qualifiers method) + specializers)) (file (find-lisp-object-file-name met-name 'cl-defmethod))) (dolist (item specializers) ;; default method has all 't' in specializers diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index a7562a00c8..12e61cf8d1 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -347,7 +347,9 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-no-default xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-no-default nil '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -360,7 +362,10 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-co-located-default xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-co-located-default nil + '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -373,11 +378,16 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-separate-default (arg1 arg2))" (xref-make-elisp-location - '(xref-elisp-generic-separate-default t t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-separate-default nil '(t t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-separate-default xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-separate-default nil + '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -386,11 +396,16 @@ to (xref-elisp-test-descr-to-target xref)." (list (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic (arg1 arg2))" (xref-make-elisp-location - '(xref-elisp-generic-implicit-generic t t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-implicit-generic nil '(t t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-implicit-generic xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-implicit-generic nil + '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -409,23 +424,33 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-elisp-location)))" (xref-make-elisp-location - '(xref-location-marker xref-elisp-location) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-elisp-location)) + 'cl-defmethod (expand-file-name "../../../lisp/progmodes/elisp-mode.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-file-location)))" (xref-make-elisp-location - '(xref-location-marker xref-file-location) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-file-location)) + 'cl-defmethod (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-buffer-location)))" (xref-make-elisp-location - '(xref-location-marker xref-buffer-location) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-buffer-location)) + 'cl-defmethod (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-bogus-location)))" (xref-make-elisp-location - '(xref-location-marker xref-bogus-location) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-bogus-location)) + 'cl-defmethod (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-etags-location)))" (xref-make-elisp-location - '(xref-location-marker xref-etags-location) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-etags-location)) + 'cl-defmethod (expand-file-name "../../../lisp/progmodes/etags.el" emacs-test-dir))) )) |