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