lisp/calc/calc-undo.el

   1 ;;; calc-undo.el --- undo functions for Calc
   2
   3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
   4
   5 ;; Author: David Gillespie <daveg@synaptics.com>
   6 ;; Maintainers: D. Goel <deego@gnufans.org>
   7 ;;              Colin Walters <walters@debian.org>
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY.  No author or distributor
  13 ;; accepts responsibility to anyone for the consequences of using it
  14 ;; or for whether it serves any particular purpose or works at all,
  15 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  16 ;; License for full details.
  17
  18 ;; Everyone is granted permission to copy, modify and redistribute
  19 ;; GNU Emacs, but only under the conditions described in the
  20 ;; GNU Emacs General Public License.   A copy of this license is
  21 ;; supposed to have been given to you along with GNU Emacs so you
  22 ;; can know your rights and responsibilities.  It should be in a
  23 ;; file named COPYING.  Among other things, the copyright notice
  24 ;; and this notice must be preserved on all copies.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 ;; This file is autoloaded from calc-ext.el.
  31 (require 'calc-ext)
  32
  33 (require 'calc-macs)
  34
  35 (defun calc-Need-calc-undo () nil)
  36
  37
  38 ;;; Undo.
  39
  40 (defun calc-undo (n)
  41   (interactive "p")
  42   (when calc-executing-macro
  43     (error "Use C-x e, not X, to run a keyboard macro that uses Undo"))
  44   (if (<= n 0)
  45       (if (< n 0)
  46           (calc-redo (- n))
  47         (calc-last-args 1))
  48     (calc-wrapper
  49      (when (null (nthcdr (1- n) calc-undo-list))
  50        (error "No further undo information available"))
  51      (setq calc-undo-list
  52            (prog1
  53                (nthcdr n calc-undo-list)
  54              (let ((saved-stack-top calc-stack-top))
  55                (let ((calc-stack-top 0))
  56                  (calc-handle-undos calc-undo-list n))
  57                (setq calc-stack-top saved-stack-top))))
  58      (message "Undo!"))))
  59
  60 (defun calc-handle-undos (cl n)
  61   (when (> n 0)
  62     (let ((old-redo calc-redo-list))
  63       (setq calc-undo-list nil)
  64       (calc-handle-undo (car cl))
  65       (setq calc-redo-list (append calc-undo-list old-redo)))
  66     (calc-handle-undos (cdr cl) (1- n))))
  67
  68 (defun calc-handle-undo (list)
  69   (when list
  70        (let ((action (car list)))
  71          (cond
  72           ((eq (car action) 'push)
  73            (calc-pop-stack 1 (nth 1 action) t))
  74           ((eq (car action) 'pop)
  75            (calc-push-list (nth 2 action) (nth 1 action)))
  76           ((eq (car action) 'set)
  77            (calc-record-undo (list 'set (nth 1 action)
  78                                    (symbol-value (nth 1 action))))
  79            (set (nth 1 action) (nth 2 action)))
  80           ((eq (car action) 'store)
  81            (let ((v (intern (nth 1 action))))
  82              (calc-record-undo (list 'store (nth 1 action)
  83                                      (and (boundp v) (symbol-value v))))
  84              (if (y-or-n-p (format "Un-store variable %s? " (nth 1 action)))
  85                  (progn
  86                    (if (nth 2 action)
  87                        (set v (nth 2 action))
  88                      (makunbound v))
  89                    (calc-refresh-evaltos v)))))
  90           ((eq (car action) 'eval)
  91            (calc-record-undo (append (list 'eval (nth 2 action) (nth 1 action))
  92                                      (cdr (cdr (cdr action)))))
  93            (apply (nth 1 action) (cdr (cdr (cdr action))))))
  94          (calc-handle-undo (cdr list)))))
  95
  96 (defun calc-redo (n)
  97   (interactive "p")
  98   (when calc-executing-macro
  99     (error "Use C-x e, not X, to run a keyboard macro that uses Redo"))
 100   (if (<= n 0)
 101       (calc-undo (- n))
 102     (calc-wrapper
 103      (when (null (nthcdr (1- n) calc-redo-list))
 104        (error "Unable to redo"))
 105      (setq calc-redo-list
 106            (prog1
 107                (nthcdr n calc-redo-list)
 108              (let ((saved-stack-top calc-stack-top))
 109                (let ((calc-stack-top 0))
 110                  (calc-handle-redos calc-redo-list n))
 111                (setq calc-stack-top saved-stack-top))))
 112      (message "Redo!"))))
 113
 114 (defun calc-handle-redos (cl n)
 115   (when (> n 0)
 116     (let ((old-undo calc-undo-list))
 117       (setq calc-undo-list nil)
 118       (calc-handle-undo (car cl))
 119       (setq calc-undo-list (append calc-undo-list old-undo)))
 120     (calc-handle-redos (cdr cl) (1- n))))
 121
 122 (defun calc-last-args (n)
 123   (interactive "p")
 124   (when calc-executing-macro
 125     (error "Use C-x e, not X, to run a keyboard macro that uses last-args"))
 126   (calc-wrapper
 127    (let ((urec (calc-find-last-x calc-undo-list n)))
 128      (if urec
 129          (calc-handle-last-x urec)
 130        (error "Not enough undo information available")))))
 131
 132 (defun calc-handle-last-x (list)
 133   (when list
 134     (let ((action (car list)))
 135       (if (eq (car action) 'pop)
 136           (calc-pop-push-record-list 0 "larg"
 137                                      (delq 'top-of-stack (nth 2 action))))
 138       (calc-handle-last-x (cdr list)))))
 139
 140 (defun calc-find-last-x (ul n)
 141   (when ul
 142     (if (calc-undo-does-pushes (car ul))
 143         (if (<= n 1)
 144             (car ul)
 145           (calc-find-last-x (cdr ul) (1- n)))
 146       (calc-find-last-x (cdr ul) n))))
 147
 148 (defun calc-undo-does-pushes (list)
 149   (and list
 150        (or (eq (car (car list)) 'pop)
 151            (calc-undo-does-pushes (cdr list)))))
 152
 153 ;;; calc-undo.el ends here