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