* cl-generic.el: Fix problems introduced by new load-history format
* lisp/emacs-lisp/cl-generic.el (cl--generic-load-hist-format): New function. (cl-generic-define-method, cl--generic-describe): Use it. (cl--generic-search-method): Adjust for new format. * lisp/progmodes/elisp-mode.el (elisp--xref-find-definitions): * test/lisp/progmodes/elisp-mode-tests.el: Use cl--generic-load-hist-format rather than hard-coding cl-generic's internal format.
This commit is contained in:
parent
54a3c0c98f
commit
d0838f201a
3 changed files with 59 additions and 19 deletions
|
@ -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 `"))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
))
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue