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