From: Eli Zaretskii Date: Sat, 7 Jun 2025 09:15:33 +0000 (+0300) Subject: Teach checkdoc about (:this that) in cl-defun X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fecbf8f3f00290f43b211d78cdcdbe69719fe5d6;p=emacs.git Teach checkdoc about (:this that) in cl-defun * lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine): Support more complex keyword args. (Bug#78543) (cherry picked from commit 9629ade0b0366d62202419f37b467fe0e6caf227) --- diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 821a0fcb485..cfe35cf996f 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1665,24 +1665,31 @@ function,command,variable,option or symbol." ms1)))))) ;; Addendum: Make sure they appear in the doc in the same ;; order that they are found in the arg list. - (let ((args (nthcdr 4 fp)) - (last-pos 0) - (found 1) - (order (and (nth 3 fp) (car (nth 3 fp)))) - (nocheck (append '("&optional" "&rest" "&key" "&aux" - "&context" "&environment" "&whole" - "&body" "&allow-other-keys" "nil") - (nth 3 fp))) + (let* ((args (nthcdr 4 fp)) + (this-arg (car args)) + (this-arg (if (string-prefix-p ":" this-arg) + (substring this-arg 1) + this-arg)) + (last-pos 0) + (found 1) + (order (and (nth 3 fp) (car (nth 3 fp)))) + (nocheck (append '("&optional" "&rest" "&key" "&aux" + "&context" "&environment" "&whole" + "&body" "&allow-other-keys" "nil") + (nth 3 fp))) (inopts nil)) (while (and args found (> found last-pos)) (if (or (member (car args) nocheck) - (string-match "\\`_" (car args))) + (string-match "\\`_" this-arg)) (setq args (cdr args) + this-arg (if (string-prefix-p ":" (car args)) + (substring (car args) 1) + (car args)) inopts t) (setq last-pos found found (save-excursion (re-search-forward - (concat "\\<" (upcase (car args)) + (concat "\\<" (upcase this-arg) ;; Require whitespace OR ;; ITEMth OR ;; ITEMs @@ -1695,7 +1702,7 @@ function,command,variable,option or symbol." ms1)))))) ;; and see if the user wants to capitalize it. (if (save-excursion (re-search-forward - (concat "\\<\\(" (car args) + (concat "\\<\\(" this-arg ;; Require whitespace OR ;; ITEMth OR ;; ITEMs @@ -1705,10 +1712,15 @@ function,command,variable,option or symbol." ms1)))))) (match-beginning 1) (match-end 1) (format-message "If this is the argument `%s', it should appear as %s. Fix?" - (car args) (upcase (car args))) - (upcase (car args)) t) + this-arg (upcase this-arg)) + (upcase this-arg) t) (setq found (match-beginning 1)))))) - (if found (setq args (cdr args))))) + (if found (setq args + (cdr args) + this-arg (if (string-prefix-p ":" + (car args)) + (substring (car args) 1) + (car args)))))) (if (not found) ;; It wasn't found at all! Offer to attach this new symbol ;; to the end of the documentation string. @@ -1721,7 +1733,7 @@ function,command,variable,option or symbol." ms1)))))) (goto-char e) (forward-char -1) (insert "\n" (if inopts "Optional a" "A") - "rgument " (upcase (car args)) + "rgument " (upcase this-arg) " ") (insert (read-string "Describe: ")) (if (not (save-excursion (forward-char -1) @@ -1732,7 +1744,7 @@ function,command,variable,option or symbol." ms1)))))) (checkdoc-create-error (format-message "Argument `%s' should appear (as %s) in the doc string" - (car args) (upcase (car args))) + (car args) (upcase this-arg)) s (marker-position e)))) (if (or (and order (eq order 'yes)) (and (not order) checkdoc-arguments-in-order-flag))