Function: edmacro-format-keys
edmacro-format-keys is a byte-compiled function defined in
edmacro.el.gz.
Signature
(edmacro-format-keys MACRO &optional VERBOSE)
Source Code
;; Defined in /usr/src/emacs/lisp/edmacro.el.gz
;;; Formatting a keyboard macro as human-readable text.
(defun edmacro-format-keys (macro &optional verbose)
(setq macro (edmacro-fix-menu-commands macro))
(let* ((maps (current-active-maps))
(pkeys '(end-macro ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?\C-u
?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4 ?\M-5 ?\M-6
?\M-7 ?\M-8 ?\M-9))
(mdigs (nthcdr 13 pkeys))
(maxkey (if edmacro-eight-bits 255 127))
(case-fold-search nil)
(res-words '("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))
(when (stringp macro)
(cl-loop for i below (length macro) do
(when (>= (aref rest-mac i) 128)
(cl-incf (aref rest-mac i) (- ?\M-\^@ 128)))))
(while (not (eq (aref rest-mac 0) 'end-macro))
(let* ((prefix
(or (and (integerp (aref rest-mac 0))
(memq (aref rest-mac 0) mdigs)
(memq (key-binding (cl-subseq rest-mac 0 1))
'(digit-argument negative-argument))
(let ((i 1))
(while (memq (aref rest-mac i) (cdr mdigs))
(cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "M-" (cl-subseq rest-mac 0 i) " ")
(cl-callf cl-subseq rest-mac i)))))
(and (eq (aref rest-mac 0) ?\C-u)
(eq (key-binding [?\C-u]) 'universal-argument)
(let ((i 1))
(while (eq (aref rest-mac i) ?\C-u)
(cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (cl-loop repeat i concat "C-u ")
(cl-callf cl-subseq rest-mac i)))))
(and (eq (aref rest-mac 0) ?\C-u)
(eq (key-binding [?\C-u]) 'universal-argument)
(let ((i 1))
(when (eq (aref rest-mac i) ?-)
(cl-incf i))
(while (memq (aref rest-mac i)
'(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
(cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ")
(cl-callf cl-subseq rest-mac i)))))))
(bind-len (apply #'max 1
(cl-loop for map in maps
for b = (lookup-key map rest-mac)
when b collect b)))
(key (cl-subseq rest-mac 0 bind-len))
(fkey nil) tlen tkey
(bind (or (cl-loop for map in maps for b = (lookup-key map key)
thereis (and (not (integerp b)) b))
(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))
(cl-loop for map in maps
for b = (lookup-key map fkey)
when (and (not (integerp b)) b)
do (setq bind-len tlen key tkey)
and return b
finally do (setq fkey nil)))))
(first (aref key 0))
(text
(cl-loop for i from bind-len below (length rest-mac)
for ch = (aref rest-mac i)
while (and (integerp ch)
(> ch 32) (< ch maxkey) (/= ch 92)
(eq (key-binding (char-to-string ch))
'self-insert-command)
(or (> i (- (length rest-mac) 2))
(not (eq ch (aref rest-mac (+ i 1))))
(not (eq ch (aref rest-mac (+ i 2))))))
finally return i))
desc)
(if (stringp bind) (setq bind nil))
(cond ((and (eq bind #'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)))
(when (string-match "^[ACHMsS]-." desc)
(setq text 2)
(cl-callf substring desc 0 2))
(not (string-match
"^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
desc))))
(when (or (string-match "^\\^.$" desc)
(member desc res-words))
(setq desc (mapconcat #'char-to-string desc " ")))
(when verbose
(setq bind (format "%s * %d" bind text)))
(setq bind-len text))
((and (eq bind #'execute-extended-command)
(> text bind-len)
(memq (aref rest-mac text) '(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
(lambda (ch)
(cond
((integerp ch)
(concat
(cl-loop for pf across "ACHMsS"
for bit in '( ?\A-\0 ?\C-\0 ?\H-\0
?\M-\0 ?\s-\0 ?\S-\0)
when (/= (logand ch bit) 0)
concat (format "%c-" pf))
(let ((ch2 (logand ch (1- (ash 1 18)))))
(cond ((<= ch2 32)
(pcase ch2
(0 "NUL") (9 "TAB") (10 "LFD")
(13 "RET") (27 "ESC") (32 "SPC")
(_
(format "C-%c"
(+ (if (<= ch2 26) 96 64)
ch2)))))
((= ch2 127) "DEL")
((<= ch2 maxkey) (char-to-string ch2))
(t (format "\\%o" ch2))))))
((symbolp ch)
(format "<%s>" ch))
(t
(error "Unrecognized item in macro: %s" ch))))
(or fkey key) " "))))
(if prefix
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
(unless (string-search " " desc)
(let ((times 1) (pos bind-len))
(while (not (cl-mismatch rest-mac rest-mac
:start1 0 :end1 bind-len
:start2 pos :end2 (+ bind-len pos)))
(cl-incf times)
(cl-incf pos bind-len))
(when (> times 1)
(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
(unless (equal res "") (cl-callf concat res "\n"))
(cl-callf concat res desc)
(when (and bind (or (stringp bind) (symbolp bind)))
(cl-callf concat res
(make-string (max (- 3 (/ (length desc) 8)) 1) 9)
";; " (if (stringp bind) bind (symbol-name bind))))
(setq len 0))
(if (and (> (+ len (length desc) 2) 72) (not one-line))
(progn
(cl-callf concat res "\n ")
(setq len 1))
(unless (equal res "")
(cl-callf concat res " ")
(cl-incf len)))
(cl-callf concat res desc)
(cl-incf len (length desc)))))
res))