From 463e621c29c9e236e538a2b4e9be1da2976c9c7e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 13 Dec 2021 16:43:58 -0500 Subject: [PATCH] * lisp/kmacro.el: Use FCR instead of messing with internals * test/lisp/progmodes/elisp-mode-tests.el (xref-elisp-generic-co-located-default): Silence warnings. * test/lisp/kmacro-tests.el (kmacro-tests--cl-print): New test. * lisp/kmacro.el (kmacro-function): New FCR type. (kmacro-lambda-form): Use it. (kmacro-extract-lambda, kmacro-p): Simplify/rewrite accordingly. (cl-print-object): New method. * lisp/emacs-lisp/fcr.el (fcr-make): Keep interactive specs before the function's code. * lisp/edmacro.el (edmacro-finish-edit): Prefer `kmacro-p`. --- lisp/edmacro.el | 2 +- lisp/emacs-lisp/fcr.el | 8 ++++ lisp/kmacro.el | 60 ++++++++++++++----------- test/lisp/kmacro-tests.el | 5 +++ test/lisp/progmodes/elisp-mode-tests.el | 5 ++- 5 files changed, 53 insertions(+), 27 deletions(-) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 29900a9595c..be92cd03fb4 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -260,7 +260,7 @@ or nil, use a compact 80-column format." (push key keys) (let ((b (key-binding key))) (and b (commandp b) (not (arrayp b)) - (not (kmacro-extract-lambda b)) + (not (kmacro-p b)) (or (not (fboundp b)) (not (or (arrayp (symbol-function b)) (get b 'kmacro)))) diff --git a/lisp/emacs-lisp/fcr.el b/lisp/emacs-lisp/fcr.el index 112fdbdf574..dd9687b6b8b 100644 --- a/lisp/emacs-lisp/fcr.el +++ b/lisp/emacs-lisp/fcr.el @@ -143,6 +143,7 @@ parent-names)) (slotdescs (append parent-slots + ;; FIXME: Catch duplicate slot names. (mapcar (lambda (field) (cl--make-slot-descriptor field nil nil '((:read-only . t)))) @@ -190,6 +191,7 @@ ;; FIXME: Provide the fields in the order specified by `type'. (let* ((class (cl--find-class type)) (slots (fcr--class-slots class)) + (prebody '()) (slotbinds (nreverse (mapcar (lambda (slot) (list (cl--slot-descriptor-name slot))) @@ -208,6 +210,11 @@ (setcdr bind (list temp)) (cons temp (cdr field))))))) fields))) + ;; FIXME: Since we use the docstring internally to store the + ;; type we can't handle actual docstrings. We could fix this by adding + ;; a docstring slot to FCRs. + (while (memq (car-safe (car-safe body)) '(interactive declare)) + (push (pop body) prebody)) ;; FIXME: Optimize temps away when they're provided in the right order! ;; FIXME: Slots not specified in `fields' tend to emit "Variable FOO left ;; uninitialized"! @@ -221,6 +228,7 @@ (fcr--fix-type (lambda ,args (:documentation ',type) + ,@prebody ;; Add dummy code which accesses the field's vars to make sure ;; they're captured in the closure. (if t nil ,@(mapcar #'car fields)) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 3f492a851ea..211f0abd3eb 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -811,6 +811,10 @@ If kbd macro currently being defined end it before activating it." ;; letters and digits, provided that we inhibit the keymap while ;; executing the macro later on (but that's controversial...) +(fcr-defstruct kmacro-function + "Function form of keyboard macros." + mac) + ;;;###autoload (defun kmacro-lambda-form (mac &optional counter format) "Create lambda form for macro bound to symbol or key." @@ -819,34 +823,40 @@ If kbd macro currently being defined end it before activating it." ;; or only `mac' is provided, as a list (MAC COUNTER FORMAT). ;; The first is used from `insert-kbd-macro' and `edmacro-finish-edit', ;; while the second is used from within this file. - (let ((mac (if counter (list mac counter format) mac))) - ;; FIXME: This should be a "funcallable struct"! - (lambda (&optional arg) - "Keyboard macro." - ;; We put an "unused prompt" as a special marker so - ;; `kmacro-extract-lambda' can see it's "one of us". - (interactive "pkmacro") - (if (eq arg 'kmacro--extract-lambda) - (cons 'kmacro--extract-lambda mac) - (kmacro-exec-ring-item mac arg))))) + (fcr-make kmacro-function ((mac (if counter (list mac counter format) mac))) + (&optional arg) + (interactive "p") + (kmacro-exec-ring-item mac arg))) (defun kmacro-extract-lambda (mac) "Extract kmacro from a kmacro lambda form." - (let ((mac (cond - ((eq (car-safe mac) 'lambda) - (let ((e (assoc 'kmacro-exec-ring-item mac))) - (car-safe (cdr-safe (car-safe (cdr-safe e)))))) - ((and (functionp mac) - (equal (interactive-form mac) '(interactive "pkmacro"))) - (let ((r (funcall mac 'kmacro--extract-lambda))) - (and (eq (car-safe r) 'kmacro--extract-lambda) (cdr r))))))) - (and (consp mac) - (= (length mac) 3) - (arrayp (car mac)) - mac))) - -(defalias 'kmacro-p #'kmacro-extract-lambda - "Return non-nil if MAC is a kmacro keyboard macro.") + (when (kmacro-p mac) + (let ((mac (kmacro-function--mac mac))) + (and (consp mac) + (= (length mac) 3) + (arrayp (car mac)) + mac)))) + +(defun kmacro-p (x) + "Return non-nil if MAC is a kmacro keyboard macro." + (cl-typep x 'kmacro-function)) + +(cl-defmethod cl-print-object ((object kmacro-function) stream) + (princ "#" stream))) (defun kmacro-bind-to-key (_arg) "When not defining or executing a macro, offer to bind last macro to a key. diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el index ecd3d5fc22b..51108e033b0 100644 --- a/test/lisp/kmacro-tests.el +++ b/test/lisp/kmacro-tests.el @@ -825,6 +825,11 @@ This is a regression for item 7 in Bug#24991." :macro-result "x") (kmacro-tests-simulate-command '(beginning-of-line)))) +(ert-deftest kmacro-tests--cl-print () + (should (equal (cl-prin1-to-string + (kmacro-lambda-form [?a ?b backspace backspace] 0 "%d")) + "#"))) + (cl-defun kmacro-tests-run-step-edit (macro &key events sequences result macro-result) "Set up and run a test of `kmacro-step-edit-macro'. diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 9dc5e8cadcf..b6161c367e4 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -449,12 +449,15 @@ to (xref-elisp-test-descr-to-target xref)." ;; dispatching code. ) -(cl-defgeneric xref-elisp-generic-co-located-default (arg1 arg2) +(cl-defgeneric xref-elisp-generic-co-located-default (_arg1 _arg2) "Doc string generic co-located-default." "co-located default") (cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2) "Doc string generic co-located-default xref-elisp-root-type." + ;; The test needs the above line to contain "this" and "arg2" + ;; without underscores, so we silence the warning with `ignore'. + (ignore this arg2) "non-default for co-located-default") (cl-defgeneric xref-elisp-generic-separate-default (arg1 arg2) -- 2.39.5