bug#14903: 24.3.50; keyboard macros are broken in trunk (cl-mismatch error)

bug#14903: 24.3.50; keyboard macros are broken in trunk (cl-mismatch error)

[Vitalie Spinu]

To reproduce C-x ( and record arbitrary macro. Then try C-x e e

I am getting:

   Debugger entered--Lisp error: (error "Bad keyword argument 0")
     signal(error ("Bad keyword argument 0"))
     error("Bad keyword argument %s" 0)
     cl-mismatch([101 end-macro] [101 end-macro] 0 1 1 2)
     (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos)))
     (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (setq times (1+ times)) (setq pos (+ pos bind-len)))
     (let ((times 1) (pos bind-len)) (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (setq times (1+ times)) (setq pos (+ pos bind-len))) (if (> times 1) (progn (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times)))))
     (if (string-match " " desc) nil (let ((times 1) (pos bind-len)) (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (setq times (1+ times)) (setq pos (+ pos bind-len))) (if (> times 1) (progn (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))))
     (let* ((prefix (or (and (integerp (aref rest-mac 0)) (memq (aref rest-mac 0) mdigs) (memq (key-binding (cl-subseq rest-mac 0 1)) (quote (digit-argument negative-argument))) (let ((i 1)) (while (memq ... ...) (setq i ...)) (and (not ...) (prog1 ... ...)))) (and (eq (aref rest-mac 0) 21) (eq (key-binding [21]) (quote universal-argument)) (let ((i 1)) (while (eq ... 21) (setq i ...)) (and (not ...) (prog1 ... ...)))) (and (eq (aref rest-mac 0) 21) (eq (key-binding [21]) (quote universal-argument)) (let ((i 1)) (if (eq ... 45) (progn ...)) (while (memq ... ...) (setq i ...)) (and (not ...) (prog1 ... ...)))))) (bind-len (apply (quote max) 1 (progn (let* ((--cl-var-- maps) (map nil) (b nil) (--cl-var-- nil)) (while (consp --cl-var--) (setq map ...) (setq b ...) (if b ...) (setq --cl-var-- ...)) (nreverse --cl-var--))))) (key (cl-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (progn (let* ((--cl-var-- maps) (map nil) (b nil) (--cl-flag-- t) --cl-var--) (while (and ... ...) (setq --cl-var-- ...)) --cl-var--)) (and (setq fkey (lookup-key local-function-key-map rest-mac)) (setq tlen fkey tkey (cl-subseq rest-mac 0 tlen) fkey (lookup-key local-function-key-map tkey)) (progn (let* (... ... ... ... --cl-var--) (while ... ...) (if --cl-var-- ... --cl-var--)))))) (first (aref key 0)) (text (progn (let* ((i bind-len) (--cl-var-- (length rest-mac)) (ch nil)) (while (and (< i --cl-var--) (progn ... ...)) (setq i (+ i 1))) i))) desc) (if (stringp bind) (setq bind nil)) (cond ((and (eq bind (quote self-insert-command)) (not prefix) (> text 1) (integerp first) (> first 32) (<= first maxkey) (/= first 92) (progn (if (> text 30) (setq text 30)) (setq desc (concat (cl-subseq rest-mac 0 text))) (if (string-match "^[ACHMsS]-." desc) (progn (setq text 2) (setq desc ...))) (not (string-match "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." desc)))) (if (or (string-match "^\\^.$" desc) (member desc res-words)) (progn (setq desc (mapconcat (quote char-to-string) desc " ")))) (if verbose (progn (setq bind (format "%s * %d" bind text)))) (setq bind-len text)) ((and (eq bind (quote execute-extended-command)) (> text bind-len) (memq (aref rest-mac text) (quote (return 13))) (progn (setq desc (concat (cl-subseq rest-mac bind-len text))) (commandp (intern-soft desc)))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) (setq bind-len (1+ text))) (t (setq desc (mapconcat (function (lambda (ch) (cond ... ... ...))) (or fkey key) " ")))) (if prefix (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) (if (string-match " " desc) nil (let ((times 1) (pos bind-len)) (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (setq times (1+ times)) (setq pos (+ pos bind-len))) (if (> times 1) (progn (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times)))))) (setq rest-mac (cl-subseq rest-mac bind-len)) (if verbose (progn (if (equal res "") nil (setq res (concat res "\n"))) (setq res (concat res desc)) (if (and bind (or (stringp bind) (symbolp bind))) (progn (setq res (concat res (make-string ... 9) ";; " (if ... bind ...))))) (setq len 0)) (if (and (> (+ len (length desc) 2) 72) (not one-line)) (progn (setq res (concat res "\n ")) (setq len 1)) (if (equal res "") nil (setq res (concat res " ")) (setq len (1+ len)))) (setq res (concat res desc)) (setq len (+ len (length desc)))))
     (while (not (eq (aref rest-mac 0) (quote end-macro))) (let* ((prefix (or (and (integerp (aref rest-mac 0)) (memq (aref rest-mac 0) mdigs) (memq (key-binding ...) (quote ...)) (let (...) (while ... ...) (and ... ...))) (and (eq (aref rest-mac 0) 21) (eq (key-binding [21]) (quote universal-argument)) (let (...) (while ... ...) (and ... ...))) (and (eq (aref rest-mac 0) 21) (eq (key-binding [21]) (quote universal-argument)) (let (...) (if ... ...) (while ... ...) (and ... ...))))) (bind-len (apply (quote max) 1 (progn (let* (... ... ... ...) (while ... ... ... ... ...) (nreverse --cl-var--))))) (key (cl-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (progn (let* (... ... ... ... --cl-var--) (while ... ...) --cl-var--)) (and (setq fkey (lookup-key local-function-key-map rest-mac)) (setq tlen fkey tkey (cl-subseq rest-mac 0 tlen) fkey (lookup-key local-function-key-map tkey)) (progn (let* ... ... ...))))) (first (aref key 0)) (text (progn (let* ((i bind-len) (--cl-var-- ...) (ch nil)) (while (and ... ...) (setq i ...)) i))) desc) (if (stringp bind) (setq bind nil)) (cond ((and (eq bind (quote self-insert-command)) (not prefix) (> text 1) (integerp first) (> first 32) (<= first maxkey) (/= first 92) (progn (if (> text 30) (setq text 30)) (setq desc (concat ...)) (if (string-match "^[ACHMsS]-." desc) (progn ... ...)) (not (string-match "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." desc)))) (if (or (string-match "^\\^.$" desc) (member desc res-words)) (progn (setq desc (mapconcat ... desc " ")))) (if verbose (progn (setq bind (format "%s * %d" bind text)))) (setq bind-len text)) ((and (eq bind (quote execute-extended-command)) (> text bind-len) (memq (aref rest-mac text) (quote (return 13))) (progn (setq desc (concat ...)) (commandp (intern-soft desc)))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) (setq bind-len (1+ text))) (t (setq desc (mapconcat (function (lambda ... ...)) (or fkey key) " ")))) (if prefix (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) (if (string-match " " desc) nil (let ((times 1) (pos bind-len)) (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (setq times (1+ times)) (setq pos (+ pos bind-len))) (if (> times 1) (progn (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times)))))) (setq rest-mac (cl-subseq rest-mac bind-len)) (if verbose (progn (if (equal res "") nil (setq res (concat res "\n"))) (setq res (concat res desc)) (if (and bind (or (stringp bind) (symbolp bind))) (progn (setq res (concat res ... ";; " ...)))) (setq len 0)) (if (and (> (+ len (length desc) 2) 72) (not one-line)) (progn (setq res (concat res "\n ")) (setq len 1)) (if (equal res "") nil (setq res (concat res " ")) (setq len (1+ len)))) (setq res (concat res desc)) (setq len (+ len (length desc))))))
     (let* ((maps (current-active-maps)) (pkeys (quote (end-macro 48 49 50 51 52 53 54 55 56 57 45 21 134217773 134217776 134217777 134217778 134217779 134217780 134217781 134217782 134217783 134217784 134217785))) (mdigs (nthcdr 13 pkeys)) (maxkey (if edmacro-eight-bits 255 127)) (case-fold-search nil) (res-words (quote ("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM"))) (rest-mac (vconcat macro [end-macro])) (res "") (len 0) (one-line (eq verbose 1))) (if one-line (setq verbose nil)) (if (stringp macro) (progn (progn (let* ((i 0) (--cl-var-- (length macro))) (while (< i --cl-var--) (if (>= ... 128) (progn ...)) (setq i (+ i 1))) nil)))) (while (not (eq (aref rest-mac 0) (quote end-macro))) (let* ((prefix (or (and (integerp ...) (memq ... mdigs) (memq ... ...) (let ... ... ...)) (and (eq ... 21) (eq ... ...) (let ... ... ...)) (and (eq ... 21) (eq ... ...) (let ... ... ... ...)))) (bind-len (apply (quote max) 1 (progn (let* ... ... ...)))) (key (cl-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (progn (let* ... ... --cl-var--)) (and (setq fkey ...) (setq tlen fkey tkey ... fkey ...) (progn ...)))) (first (aref key 0)) (text (progn (let* (... ... ...) (while ... ...) i))) desc) (if (stringp bind) (setq bind nil)) (cond ((and (eq bind (quote self-insert-command)) (not prefix) (> text 1) (integerp first) (> first 32) (<= first maxkey) (/= first 92) (progn (if ... ...) (setq desc ...) (if ... ...) (not ...))) (if (or (string-match "^\\^.$" desc) (member desc res-words)) (progn (setq desc ...))) (if verbose (progn (setq bind ...))) (setq bind-len text)) ((and (eq bind (quote execute-extended-command)) (> text bind-len) (memq (aref rest-mac text) (quote ...)) (progn (setq desc ...) (commandp ...))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) (setq bind-len (1+ text))) (t (setq desc (mapconcat (function ...) (or fkey key) " ")))) (if prefix (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) (if (string-match " " desc) nil (let ((times 1) (pos bind-len)) (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos ...)) (setq times (1+ times)) (setq pos (+ pos bind-len))) (if (> times 1) (progn (setq desc ...) (setq bind-len ...))))) (setq rest-mac (cl-subseq rest-mac bind-len)) (if verbose (progn (if (equal res "") nil (setq res (concat res "\n"))) (setq res (concat res desc)) (if (and bind (or ... ...)) (progn (setq res ...))) (setq len 0)) (if (and (> (+ len ... 2) 72) (not one-line)) (progn (setq res (concat res "\n ")) (setq len 1)) (if (equal res "") nil (setq res (concat res " ")) (setq len (1+ len)))) (setq res (concat res desc)) (setq len (+ len (length desc)))))) res)
     edmacro-format-keys([101] nil)
     format-kbd-macro([101] nil)
     kmacro-call-macro(nil nil)
     kmacro-end-and-call-macro(nil)
     call-interactively(kmacro-end-and-call-macro nil nil)
     command-execute(kmacro-end-and-call-macro)
   
And that is reasonable error given that cl-mismatch call is wrong:

   ╭──────── #564 ─ /home/vitoshka/bin/emacs-trunk/lisp/edmacro.el ──
   │ 	    (while  (not (cl-mismatch rest-mac rest-mac
   │                                       0 bind-len pos (+ bind-len pos)))
   │ 	      (cl-incf times)
   │ 	      (cl-incf pos bind-len))
   ╰──────── #567 ─
   

Commenting this while loop solves the problem for me, but I don't
understand the code even a bit.

    Vitalie


In GNU Emacs 24.3.50.5 (i686-pc-linux-gnu, X toolkit, Xaw scroll bars)
 of 2013-07-18 on vitoshka-OptiPlex-745
Windowing system distributor `The X.Org Foundation', version 11.0.11303000
System Description:	Ubuntu 13.04

Important settings:
  value of $LC_MONETARY: nl_NL.UTF-8
  value of $LC_NUMERIC: nl_NL.UTF-8
  value of $LC_TIME: nl_NL.UTF-8
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix
  default enable-multibyte-characters: t

bug#14903: 24.3.50; keyboard macros are broken in trunk (cl-mismatch error)

[Glenn Morris]

Dupe of already fixed
http://debbugs.gnu.org/cgi/bugreport.cgi?bug=14873