[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/fcr 463e621: * lisp/kmacro.el: Use FCR instead of messing with i
From: |
Stefan Monnier |
Subject: |
scratch/fcr 463e621: * lisp/kmacro.el: Use FCR instead of messing with internals |
Date: |
Mon, 13 Dec 2021 16:44:08 -0500 (EST) |
branch: scratch/fcr
commit 463e621c29c9e236e538a2b4e9be1da2976c9c7e
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* 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 29900a9..be92cd0 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 112fdbd..dd9687b 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 3f492a8..211f0ab 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 "#<kmacro " stream)
+ (require 'macros)
+ (declare-function macros--insert-vector-macro "macros" (definition))
+ (pcase-let ((`(,vecdef ,counter ,format)
+ (kmacro-extract-lambda object)))
+ (princ
+ (with-temp-buffer
+ (macros--insert-vector-macro vecdef)
+ (buffer-string))
+ stream)
+ (princ " " stream)
+ (prin1 counter stream)
+ (princ " " stream)
+ (prin1 format 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 ecd3d5f..51108e0 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"))
+ "#<kmacro [?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 9dc5e8c..b6161c3 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)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/fcr 463e621: * lisp/kmacro.el: Use FCR instead of messing with internals,
Stefan Monnier <=