parent-names))
(slotdescs (append
parent-slots
+ ;; FIXME: Catch duplicate slot names.
(mapcar (lambda (field)
(cl--make-slot-descriptor field nil nil
'((:read-only . t))))
;; FIXME: Provide the fields in the order specified by `type'.
(let* ((class (cl--find-class type))
(slots (oclosure--class-slots class))
+ (prebody '())
(slotbinds (nreverse
(mapcar (lambda (slot)
(list (cl--slot-descriptor-name slot)))
(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 OClosures.
+ (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"!
(oclosure--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))
;; letters and digits, provided that we inhibit the keymap while
;; executing the macro later on (but that's controversial...)
+(oclosure-define 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."
;; 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)))))
+ (oclosure-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.
;; 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)