Evaluate eql specializers
* lisp/emacs-lisp/cl-generic.el (cl-generic-generalizers): Evaluate forms that are eql specializers. Provide backward compatibility with a warning. * test/lisp/emacs-lisp/cl-generic-tests.el: Add a test. * lisp/emacs-lisp/bindat.el (bindat--type): Adhere to the new rule. * lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op): Adhere to the new rule. * lisp/emacs-lisp/map.el (map-into): Adhere to the new rule. * lisp/emacs-lisp/radix-tree.el (map-into): Adhere to the new rule. * lisp/frame.el (cl-generic-define-context-rewriter): Adhere to the new rule. * lisp/gnus/gnus-search.el (gnus-search-transform-expression): Adhere to the new rule. * lisp/image/image-converter.el (image-converter--probe image-converter--convert): Adhere to the new rule. * lisp/mail/smtpmail.el (smtpmail-try-auth-method): Adhere to the new rule. * lisp/progmodes/elisp-mode.el (xref-backend-definitions) (xref-backend-apropos): Adhere to the new rule. * lisp/progmodes/etags.el (xref-backend-identifier-at-point) (xref-backend-identifier-completion-table) (xref-backend-identifier-completion-ignore-case) (xref-backend-definitions)(xref-backend-apropos): Adhere to the new rule. * test/lisp/emacs-lisp/checkdoc-tests.el (checkdoc-cl-defmethod-with-types-ok) (checkdoc-cl-defmethod-qualified-ok) (checkdoc-cl-defmethod-with-extra-qualifier-ok): Adhere to the new rule. * etc/NEWS: Describe the change.
This commit is contained in:
akater
Stefan Monnier
parent
88577aed3a
commit
6535fd1fa9
14 changed files with 77 additions and 51 deletions
5
etc/NEWS
5
etc/NEWS
|
|
@ -810,6 +810,11 @@ work as before.
|
|||
It is now defined as a generalized variable that can be used with
|
||||
'setf' to modify the value stored in a given class slot.
|
||||
|
||||
---
|
||||
*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated.
|
||||
This corresponds to the behaviour of defmethod in Common Lisp Object System.
|
||||
A warning is issued when old style is used.
|
||||
|
||||
** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
|
||||
The mode provides refined highlighting of built-in functions, types,
|
||||
and variables.
|
||||
|
|
|
|||
|
|
@ -657,33 +657,33 @@ The port (if any) is omitted. IP can be a string, as well."
|
|||
OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
|
||||
is the name of a variable that will hold the value we need to pack.")
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql byte)))
|
||||
(cl-defmethod bindat--type (op (_ (eql 'byte)))
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-u8))
|
||||
(`(length . ,_) `(cl-incf bindat-idx 1))
|
||||
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql uint)) n)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
|
||||
(if (eq n 8) (bindat--type op 'byte)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-uint ,n))
|
||||
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
|
||||
(`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql uintr)) n)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
|
||||
(if (eq n 8) (bindat--type op 'byte)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-uintr ,n))
|
||||
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
|
||||
(`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql str)) len)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'str)) len)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-str ,len))
|
||||
(`(length . ,_) `(cl-incf bindat-idx ,len))
|
||||
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-strz ,len))
|
||||
(`(length ,val)
|
||||
|
|
@ -701,25 +701,25 @@ is the name of a variable that will hold the value we need to pack.")
|
|||
(bindat--pack-str ,len . ,args)
|
||||
(bindat--pack-strz . ,args))))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql bits)) len)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-bits ,len))
|
||||
(`(length . ,_) `(cl-incf bindat-idx ,len))
|
||||
(`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
|
||||
|
||||
(cl-defmethod bindat--type (_op (_ (eql fill)) len)
|
||||
(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
|
||||
`(progn (cl-incf bindat-idx ,len) nil))
|
||||
|
||||
(cl-defmethod bindat--type (_op (_ (eql align)) len)
|
||||
(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
|
||||
`(progn (cl-callf bindat--align bindat-idx ,len) nil))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql type)) exp)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
|
||||
(bindat--pcase op
|
||||
('unpack `(funcall (bindat--type-ue ,exp)))
|
||||
(`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
|
||||
(`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
|
||||
(unless type (setq type '(byte)))
|
||||
(let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
|
||||
(bindat--pcase op
|
||||
|
|
@ -743,10 +743,10 @@ is the name of a variable that will hold the value we need to pack.")
|
|||
`(dotimes (bindat--i ,count)
|
||||
(funcall ,fun (elt ,val bindat--i)))))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql unit)) val)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
|
||||
(pcase op ('unpack val) (_ nil)))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql struct)) &rest args)
|
||||
(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
|
||||
(apply #'bindat--type op args))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
|
||||
|
|
|
|||
|
|
@ -1158,7 +1158,12 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
|
|||
(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
|
||||
"Support for (eql VAL) specializers.
|
||||
These match if the argument is `eql' to VAL."
|
||||
(puthash (cadr specializer) specializer cl--generic-eql-used)
|
||||
(let ((form (cadr specializer)))
|
||||
(puthash (if (or (not (symbolp form)) (macroexp-const-p form))
|
||||
(eval form t)
|
||||
(message "Quoting obsolete `eql' form: %S" specializer)
|
||||
form)
|
||||
specializer cl--generic-eql-used))
|
||||
(list cl--generic-eql-generalizer))
|
||||
|
||||
(cl--generic-prefill-dispatchers 0 (eql nil))
|
||||
|
|
@ -1269,6 +1274,11 @@ Used internally for the (major-mode MODE) context specializers."
|
|||
(cl-generic-define-context-rewriter major-mode (mode &rest modes)
|
||||
`(major-mode ,(if (consp mode)
|
||||
;;E.g. could be (eql ...)
|
||||
;; WARNING: unsure whether this
|
||||
;; “could be (eql ...)” commentary (or code)
|
||||
;; should be adjusted
|
||||
;; following the (planned) changes to eql specializer.
|
||||
;; Bug #47327
|
||||
(progn (cl-assert (null modes)) mode)
|
||||
`(derived-mode ,mode . ,modes))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1731,7 +1731,7 @@ contains a circular object."
|
|||
|
||||
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
|
||||
;; Keep matching until one spec fails.
|
||||
(edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
|
||||
|
||||
|
|
@ -1755,7 +1755,7 @@ contains a circular object."
|
|||
"Handle &foo spec operators.
|
||||
&foo spec operators operate on all the subsequent SPECS.")
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
|
||||
;; Repeatedly use specs until failure.
|
||||
(let (edebug-best-error
|
||||
edebug-error-point)
|
||||
|
|
@ -1768,7 +1768,7 @@ contains a circular object."
|
|||
(edebug-&optional-wrapper c (or s specs) rh)))))
|
||||
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
|
||||
;; Keep matching until one spec succeeds, and return its results.
|
||||
;; If none match, fail.
|
||||
;; This needs to be optimized since most specs spend time here.
|
||||
|
|
@ -1792,7 +1792,7 @@ contains a circular object."
|
|||
(apply #'edebug-no-match cursor "Expected one of" original-specs))
|
||||
))
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
|
||||
"Compute the specs for `&interpose SPEC FUN ARGS...'.
|
||||
Extracts the head of the data by matching it against SPEC,
|
||||
and then matches the rest by calling (FUN HEAD PF ARGS...)
|
||||
|
|
@ -1817,7 +1817,7 @@ a sequence of elements."
|
|||
(append instrumented-head (edebug-match cursor newspecs)))
|
||||
,@args))))
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '¬)) cursor specs)
|
||||
;; If any specs match, then fail
|
||||
(if (null (catch 'no-match
|
||||
(let ((edebug-gate nil))
|
||||
|
|
@ -1829,7 +1829,7 @@ a sequence of elements."
|
|||
;; This means nothing matched, so it is OK.
|
||||
nil) ;; So, return nothing
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
|
||||
;; Following specs must look like (<name> <spec>) ...
|
||||
;; where <name> is the name of a keyword, and spec is its spec.
|
||||
;; This really doesn't save much over the expanded form and takes time.
|
||||
|
|
@ -1842,7 +1842,7 @@ a sequence of elements."
|
|||
(car (cdr pair))))
|
||||
specs))))
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
|
||||
;; Signal an error, using the following string in the spec as argument.
|
||||
(let ((error-string (car specs))
|
||||
(edebug-error-point (edebug-before-offset cursor)))
|
||||
|
|
@ -1942,7 +1942,7 @@ a sequence of elements."
|
|||
(defun edebug-match-function (_cursor)
|
||||
(error "Use function-form instead of function in edebug spec"))
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
|
||||
;; Match a defining form.
|
||||
;; Normally, &define is interpreted specially other places.
|
||||
;; This should only be called inside of a spec list to match the remainder
|
||||
|
|
@ -1958,7 +1958,7 @@ a sequence of elements."
|
|||
;; Stop backtracking here (Bug#41988).
|
||||
(setq edebug-gate t)))
|
||||
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
|
||||
(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
|
||||
"Compute the name for `&name SPEC FUN` spec operator.
|
||||
|
||||
The full syntax of that operator is:
|
||||
|
|
|
|||
|
|
@ -407,15 +407,15 @@ See `map-into' for all supported values of TYPE."
|
|||
"Convert MAP into a map of TYPE.")
|
||||
|
||||
;; FIXME: I wish there was a way to avoid this η-redex!
|
||||
(cl-defmethod map-into (map (_type (eql list)))
|
||||
(cl-defmethod map-into (map (_type (eql 'list)))
|
||||
"Convert MAP into an alist."
|
||||
(map-pairs map))
|
||||
|
||||
(cl-defmethod map-into (map (_type (eql alist)))
|
||||
(cl-defmethod map-into (map (_type (eql 'alist)))
|
||||
"Convert MAP into an alist."
|
||||
(map-pairs map))
|
||||
|
||||
(cl-defmethod map-into (map (_type (eql plist)))
|
||||
(cl-defmethod map-into (map (_type (eql 'plist)))
|
||||
"Convert MAP into a plist."
|
||||
(let (plist)
|
||||
(map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
|
||||
|
|
@ -510,7 +510,7 @@ KEYWORD-ARGS are forwarded to `make-hash-table'."
|
|||
map)
|
||||
ht))
|
||||
|
||||
(cl-defmethod map-into (map (_type (eql hash-table)))
|
||||
(cl-defmethod map-into (map (_type (eql 'hash-table)))
|
||||
"Convert MAP into a hash-table with keys compared with `equal'."
|
||||
(map--into-hash map (list :size (map-length map) :test #'equal)))
|
||||
|
||||
|
|
|
|||
|
|
@ -240,7 +240,7 @@ PREFIX is only used internally."
|
|||
(declare-function map-apply "map" (function map))
|
||||
|
||||
(defun radix-tree-from-map (map)
|
||||
;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
|
||||
;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
|
||||
(require 'map)
|
||||
(let ((rt nil))
|
||||
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
|
||||
|
|
|
|||
|
|
@ -36,7 +36,11 @@ as its argument.")
|
|||
(cl-generic-define-context-rewriter window-system (value)
|
||||
;; If `value' is a `consp', it's probably an old-style specializer,
|
||||
;; so just use it, and anyway `eql' isn't very useful on cons cells.
|
||||
`(window-system ,(if (consp value) value `(eql ,value))))
|
||||
`(window-system ,(if (consp value) value
|
||||
;; WARNING: unsure whether this eql expression
|
||||
;; is actually an eql specializer.
|
||||
;; Bug #47327
|
||||
`(eql ',value))))
|
||||
|
||||
(cl-defmethod frame-creation-function (params &context (window-system nil))
|
||||
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
|
||||
|
|
|
|||
|
|
@ -980,7 +980,7 @@ Responsible for handling and, or, and parenthetical expressions.")
|
|||
|
||||
;; Most search engines use implicit ANDs.
|
||||
(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
|
||||
(_expr (eql and)))
|
||||
(_expr (eql 'and)))
|
||||
nil)
|
||||
|
||||
;; Most search engines use explicit infixed ORs.
|
||||
|
|
|
|||
|
|
@ -133,7 +133,7 @@ data is returned as a string."
|
|||
(list value)
|
||||
value)))
|
||||
|
||||
(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
|
||||
(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
|
||||
"Check whether the system has GraphicsMagick installed."
|
||||
(with-temp-buffer
|
||||
(let ((command (image-converter--value type :command))
|
||||
|
|
@ -151,7 +151,7 @@ data is returned as a string."
|
|||
(push (downcase (match-string 1)) formats)))
|
||||
(nreverse formats)))))
|
||||
|
||||
(cl-defmethod image-converter--probe ((type (eql imagemagick)))
|
||||
(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
|
||||
"Check whether the system has ImageMagick installed."
|
||||
(with-temp-buffer
|
||||
(let ((command (image-converter--value type :command))
|
||||
|
|
@ -171,7 +171,7 @@ data is returned as a string."
|
|||
(push (downcase (match-string 1)) formats)))
|
||||
(nreverse formats))))
|
||||
|
||||
(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
|
||||
(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
|
||||
"Check whether the system has ffmpeg installed."
|
||||
(with-temp-buffer
|
||||
(let ((command (image-converter--value type :command))
|
||||
|
|
@ -212,12 +212,12 @@ Only suffixes that map to `image-mode' are returned."
|
|||
'image-mode)
|
||||
collect suffix))
|
||||
|
||||
(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
|
||||
(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
|
||||
image-format)
|
||||
"Convert using GraphicsMagick."
|
||||
(image-converter--convert-magick type source image-format))
|
||||
|
||||
(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
|
||||
(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
|
||||
image-format)
|
||||
"Convert using ImageMagick."
|
||||
(image-converter--convert-magick type source image-format))
|
||||
|
|
@ -249,7 +249,7 @@ Only suffixes that map to `image-mode' are returned."
|
|||
;; error message.
|
||||
(buffer-string))))
|
||||
|
||||
(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
|
||||
(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
|
||||
image-format)
|
||||
"Convert using ffmpeg."
|
||||
(let ((command (image-converter--value type :command)))
|
||||
|
|
|
|||
|
|
@ -596,7 +596,7 @@ USER and PASSWORD should be non-nil."
|
|||
(error "Mechanism %S not implemented" mech))
|
||||
|
||||
(cl-defmethod smtpmail-try-auth-method
|
||||
(process (_mech (eql cram-md5)) user password)
|
||||
(process (_mech (eql 'cram-md5)) user password)
|
||||
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
|
||||
(when (eq (car ret) 334)
|
||||
(let* ((challenge (substring (cadr ret) 4))
|
||||
|
|
@ -618,13 +618,13 @@ USER and PASSWORD should be non-nil."
|
|||
(smtpmail-command-or-throw process encoded)))))
|
||||
|
||||
(cl-defmethod smtpmail-try-auth-method
|
||||
(process (_mech (eql login)) user password)
|
||||
(process (_mech (eql 'login)) user password)
|
||||
(smtpmail-command-or-throw process "AUTH LOGIN")
|
||||
(smtpmail-command-or-throw process (base64-encode-string user t))
|
||||
(smtpmail-command-or-throw process (base64-encode-string password t)))
|
||||
|
||||
(cl-defmethod smtpmail-try-auth-method
|
||||
(process (_mech (eql plain)) user password)
|
||||
(process (_mech (eql 'plain)) user password)
|
||||
;; We used to send an empty initial request, and wait for an
|
||||
;; empty response, and then send the password, but this
|
||||
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
|
||||
|
|
|
|||
|
|
@ -696,7 +696,7 @@ Each function should return a list of xrefs, or nil; the first
|
|||
non-nil result supersedes the xrefs produced by
|
||||
`elisp--xref-find-definitions'.")
|
||||
|
||||
(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
|
||||
(cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
|
||||
(require 'find-func)
|
||||
;; FIXME: use information in source near point to filter results:
|
||||
;; (dvc-log-edit ...) - exclude 'feature
|
||||
|
|
@ -875,7 +875,7 @@ non-nil result supersedes the xrefs produced by
|
|||
|
||||
(declare-function xref-apropos-regexp "xref" (pattern))
|
||||
|
||||
(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
|
||||
(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
|
||||
(apply #'nconc
|
||||
(let ((regexp (xref-apropos-regexp pattern))
|
||||
lst)
|
||||
|
|
@ -893,7 +893,8 @@ non-nil result supersedes the xrefs produced by
|
|||
(facep sym)))
|
||||
'strict))
|
||||
|
||||
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
|
||||
(cl-defmethod xref-backend-identifier-completion-table ((_backend
|
||||
(eql 'elisp)))
|
||||
elisp--xref-identifier-completion-table)
|
||||
|
||||
(cl-defstruct (xref-elisp-location
|
||||
|
|
|
|||
|
|
@ -2062,19 +2062,21 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
|
|||
;;;###autoload
|
||||
(defun etags--xref-backend () 'etags)
|
||||
|
||||
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
|
||||
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags)))
|
||||
(find-tag--default))
|
||||
|
||||
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
|
||||
(cl-defmethod xref-backend-identifier-completion-table ((_backend
|
||||
(eql 'etags)))
|
||||
(tags-lazy-completion-table))
|
||||
|
||||
(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql etags)))
|
||||
(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend
|
||||
(eql 'etags)))
|
||||
(find-tag--completion-ignore-case))
|
||||
|
||||
(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
|
||||
(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
|
||||
(etags--xref-find-definitions symbol))
|
||||
|
||||
(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
|
||||
(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
|
||||
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
|
||||
|
||||
(defun etags--xref-find-definitions (pattern &optional regexp?)
|
||||
|
|
|
|||
|
|
@ -49,27 +49,27 @@
|
|||
(with-temp-buffer
|
||||
(emacs-lisp-mode)
|
||||
;; this method matches if A is the symbol `smthg' and if b is a list:
|
||||
(insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
|
||||
(insert "(cl-defmethod foo ((a (eql 'smthg)) (b list)) \"Return A+B.\")")
|
||||
(checkdoc-defun)))
|
||||
|
||||
(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
|
||||
"Checkdoc should be happy with a `cl-defmethod' using qualifiers."
|
||||
(with-temp-buffer
|
||||
(emacs-lisp-mode)
|
||||
(insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")")
|
||||
(insert "(cl-defmethod test :around ((a (eql 'smthg))) \"Return A.\")")
|
||||
(checkdoc-defun)))
|
||||
|
||||
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
|
||||
"Checkdoc should be happy with a :extra qualified `cl-defmethod'."
|
||||
(with-temp-buffer
|
||||
(emacs-lisp-mode)
|
||||
(insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return A.\")")
|
||||
(insert "(cl-defmethod foo :extra \"foo\" ((a (eql 'smthg))) \"Return A.\")")
|
||||
(checkdoc-defun))
|
||||
|
||||
(with-temp-buffer
|
||||
(emacs-lisp-mode)
|
||||
(insert
|
||||
"(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return A.\")")
|
||||
"(cl-defmethod foo :extra \"foo\" :after ((a (eql 'smthg))) \"Return A.\")")
|
||||
(checkdoc-defun)))
|
||||
|
||||
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
|
||||
|
|
|
|||
|
|
@ -56,7 +56,11 @@
|
|||
(should (equal (cl--generic-1 'a nil) '(a)))
|
||||
(should (equal (cl--generic-1 4 nil) '("quatre" 4)))
|
||||
(should (equal (cl--generic-1 5 nil) '("cinq" 5)))
|
||||
(should (equal (cl--generic-1 6 nil) '("six" a))))
|
||||
(should (equal (cl--generic-1 6 nil) '("six" a)))
|
||||
(defvar cl--generic-fooval 41)
|
||||
(cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y)
|
||||
"forty-two")
|
||||
(should (equal (cl--generic 42 nil) "forty-two")))
|
||||
|
||||
(cl-defstruct cl-generic-struct-parent a b)
|
||||
(cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c)
|
||||
|
|
|
|||
Loading…
Reference in a new issue