1;;; calc-undo.el --- undo functions for Calc -*- lexical-binding:t -*- 2 3;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc. 4 5;; Author: David Gillespie <daveg@synaptics.com> 6 7;; This file is part of GNU Emacs. 8 9;; GNU Emacs is free software: you can redistribute it and/or modify 10;; it under the terms of the GNU General Public License as published by 11;; the Free Software Foundation, either version 3 of the License, or 12;; (at your option) any later version. 13 14;; GNU Emacs is distributed in the hope that it will be useful, 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17;; GNU General Public License for more details. 18 19;; You should have received a copy of the GNU General Public License 20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 21 22;;; Commentary: 23 24;;; Code: 25 26;; This file is autoloaded from calc-ext.el. 27 28(require 'calc-ext) 29(require 'calc-macs) 30 31;;; Undo. 32 33;;;###autoload 34(defun calc-undo (n) 35 (interactive "p") 36 (when calc-executing-macro 37 (error "Use C-x e, not X, to run a keyboard macro that uses Undo")) 38 (if (<= n 0) 39 (if (< n 0) 40 (calc-redo (- n)) 41 (calc-last-args 1)) 42 (calc-wrapper 43 (when (null (nthcdr (1- n) calc-undo-list)) 44 (error "No further undo information available")) 45 (setq calc-undo-list 46 (prog1 47 (nthcdr n calc-undo-list) 48 (let ((saved-stack-top calc-stack-top)) 49 (let ((calc-stack-top 0)) 50 (calc-handle-undos calc-undo-list n)) 51 (setq calc-stack-top saved-stack-top)))) 52 (message "Undo!")))) 53 54(defun calc-handle-undos (cl n) 55 (when (> n 0) 56 (let ((old-redo calc-redo-list)) 57 (setq calc-undo-list nil) 58 (calc-handle-undo (car cl)) 59 (setq calc-redo-list (append calc-undo-list old-redo))) 60 (calc-handle-undos (cdr cl) (1- n)))) 61 62(defun calc-handle-undo (list) 63 (when list 64 (let ((action (car list))) 65 (cond 66 ((eq (car action) 'push) 67 (calc-pop-stack 1 (nth 1 action) t)) 68 ((eq (car action) 'pop) 69 (calc-push-list (nth 2 action) (nth 1 action))) 70 ((eq (car action) 'set) 71 (calc-record-undo (list 'set (nth 1 action) 72 (symbol-value (nth 1 action)))) 73 (set (nth 1 action) (nth 2 action))) 74 ((eq (car action) 'store) 75 (let ((v (intern (nth 1 action)))) 76 (calc-record-undo (list 'store (nth 1 action) 77 (and (boundp v) (symbol-value v)))) 78 (if (y-or-n-p (format "Un-store variable %s? " 79 (calc-var-name (nth 1 action)))) 80 (progn 81 (if (nth 2 action) 82 (set v (nth 2 action)) 83 (makunbound v)) 84 (calc-refresh-evaltos v))))) 85 ((eq (car action) 'eval) 86 (calc-record-undo (append (list 'eval (nth 2 action) (nth 1 action)) 87 (cdr (cdr (cdr action))))) 88 (apply (nth 1 action) (cdr (cdr (cdr action)))))) 89 (calc-handle-undo (cdr list))))) 90 91(defun calc-redo (n) 92 (interactive "p") 93 (when calc-executing-macro 94 (error "Use C-x e, not X, to run a keyboard macro that uses Redo")) 95 (if (<= n 0) 96 (calc-undo (- n)) 97 (calc-wrapper 98 (when (null (nthcdr (1- n) calc-redo-list)) 99 (error "Unable to redo")) 100 (setq calc-redo-list 101 (prog1 102 (nthcdr n calc-redo-list) 103 (let ((saved-stack-top calc-stack-top)) 104 (let ((calc-stack-top 0)) 105 (calc-handle-redos calc-redo-list n)) 106 (setq calc-stack-top saved-stack-top)))) 107 (message "Redo!")))) 108 109(defun calc-handle-redos (cl n) 110 (when (> n 0) 111 (let ((old-undo calc-undo-list)) 112 (setq calc-undo-list nil) 113 (calc-handle-undo (car cl)) 114 (setq calc-undo-list (append calc-undo-list old-undo))) 115 (calc-handle-redos (cdr cl) (1- n)))) 116 117(defun calc-last-args (n) 118 (interactive "p") 119 (when calc-executing-macro 120 (error "Use C-x e, not X, to run a keyboard macro that uses last-args")) 121 (calc-wrapper 122 (let ((urec (calc-find-last-x calc-undo-list n))) 123 (if urec 124 (calc-handle-last-x urec) 125 (error "Not enough undo information available"))))) 126 127(defun calc-handle-last-x (list) 128 (when list 129 (let ((action (car list))) 130 (if (eq (car action) 'pop) 131 (calc-pop-push-record-list 0 "larg" 132 (delq 'top-of-stack (nth 2 action)))) 133 (calc-handle-last-x (cdr list))))) 134 135(defun calc-find-last-x (ul n) 136 (when ul 137 (if (calc-undo-does-pushes (car ul)) 138 (if (<= n 1) 139 (car ul) 140 (calc-find-last-x (cdr ul) (1- n))) 141 (calc-find-last-x (cdr ul) n)))) 142 143(defun calc-undo-does-pushes (list) 144 (and list 145 (or (eq (car (car list)) 'pop) 146 (calc-undo-does-pushes (cdr list))))) 147 148(provide 'calc-undo) 149 150;;; calc-undo.el ends here 151