Function: calc-execute-kbd-macro

calc-execute-kbd-macro is an autoloaded and byte-compiled function defined in calc-prog.el.gz.

Signature

(calc-execute-kbd-macro MAC ARG &rest PREFIX)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-prog.el.gz
(defun calc-execute-kbd-macro (mac arg &rest prefix)
  (if calc-keep-args-flag
      (calc-keep-args))
  (if (and (vectorp mac) (> (length mac) 0) (stringp (aref mac 0)))
      (setq mac (or (aref mac 1)
		    (aset mac 1 (progn (and (fboundp 'edit-kbd-macro)
					    (edit-kbd-macro nil))
				       (edmacro-parse-keys (aref mac 0)))))))
  (if (< (prefix-numeric-value arg) 0)
      (execute-kbd-macro mac (- (prefix-numeric-value arg)))
    (if calc-executing-macro
	(execute-kbd-macro mac arg)
      (calc-slow-wrapper
       (let ((old-stack-whole (copy-sequence calc-stack))
	     (old-stack-top calc-stack-top)
	     (old-buffer-size (buffer-size))
	     (old-refresh-count calc-refresh-count))
	 (unwind-protect
	     (let ((calc-executing-macro mac))
	       (execute-kbd-macro mac arg))
	   (calc-select-buffer)
	   (let ((new-stack (reverse calc-stack))
		 (old-stack (reverse old-stack-whole)))
	     (while (and new-stack old-stack
			 (equal (car new-stack) (car old-stack)))
	       (setq new-stack (cdr new-stack)
		     old-stack (cdr old-stack)))
	     (or (equal prefix '(nil))
		 (calc-record-list (if (> (length new-stack) 1)
				       (mapcar 'car new-stack)
				     '(""))
				   (or (car prefix) "kmac")))
	     (calc-record-undo (list 'set 'saved-stack-top old-stack-top))
	     (and old-stack
		  (calc-record-undo (list 'pop 1 (mapcar 'car old-stack))))
	     (let ((calc-stack old-stack-whole)
		   (calc-stack-top 0))
	       (calc-cursor-stack-index (length old-stack)))
	     (if (and (= old-buffer-size (buffer-size))
		      (= old-refresh-count calc-refresh-count))
		 (let ((buffer-read-only nil))
		   (delete-region (point) (point-max))
		   (while new-stack
		     (calc-record-undo (list 'push 1))
		     (insert (math-format-stack-value (car new-stack)) "\n")
		     (setq new-stack (cdr new-stack)))
		   (calc-renumber-stack))
	       (while new-stack
		 (calc-record-undo (list 'push 1))
		 (setq new-stack (cdr new-stack)))
	       (calc-refresh))
	     (calc-record-undo (list 'set 'saved-stack-top 0)))))))))