cgit.sxemacs.org Git - packages/blob - xemacs-packages/calc/calc-undo.el

   1 ;; Calculator for GNU Emacs, part II [calc-undo.el]
   2 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
   3 ;; Written by Dave Gillespie, daveg@synaptics.com.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is distributed in the hope that it will be useful,
   8 ;; but WITHOUT ANY WARRANTY.  No author or distributor
   9 ;; accepts responsibility to anyone for the consequences of using it
  10 ;; or for whether it serves any particular purpose or works at all,
  11 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12 ;; License for full details.
  13
  14 ;; Everyone is granted permission to copy, modify and redistribute
  15 ;; GNU Emacs, but only under the conditions described in the
  16 ;; GNU Emacs General Public License.   A copy of this license is
  17 ;; supposed to have been given to you along with GNU Emacs so you
  18 ;; can know your rights and responsibilities.  It should be in a
  19 ;; file named COPYING.  Among other things, the copyright notice
  20 ;; and this notice must be preserved on all copies.
  21
  22
  23
  24 ;; This file is autoloaded from calc-ext.el.
  25 (require 'calc-ext)
  26
  27 (require 'calc-macs)
  28
  29 (defun calc-Need-calc-undo () nil)
  30
  31
  32 ;;; Undo.
  33
  34 (defun calc-undo (n)
  35   (interactive "p")
  36   (and 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      (if (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
  55 (defun calc-handle-undos (cl n)
  56   (if (> n 0)
  57       (progn
  58         (let ((old-redo calc-redo-list))
  59           (setq calc-undo-list nil)
  60           (calc-handle-undo (car cl))
  61           (setq calc-redo-list (append calc-undo-list old-redo)))
  62         (calc-handle-undos (cdr cl) (1- n))))
  63 )
  64
  65 (defun calc-handle-undo (list)
  66   (and 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? " (nth 1 action)))
  82                  (progn
  83                    (if (nth 2 action)
  84                        (set v (nth 2 action))
  85                      (makunbound v))
  86                    (calc-refresh-evaltos v)))))
  87           ((eq (car action) 'eval)
  88            (calc-record-undo (append (list 'eval (nth 2 action) (nth 1 action))
  89                                      (cdr (cdr (cdr action)))))
  90            (apply (nth 1 action) (cdr (cdr (cdr action))))))
  91          (calc-handle-undo (cdr list))))
  92 )
  93
  94 (defun calc-redo (n)
  95   (interactive "p")
  96   (and 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      (if (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
 113 (defun calc-handle-redos (cl n)
 114   (if (> n 0)
 115       (progn
 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
 123 (defun calc-last-args (n)
 124   (interactive "p")
 125   (and calc-executing-macro
 126        (error "Use C-x e, not X, to run a keyboard macro that uses last-args."))
 127   (calc-wrapper
 128    (let ((urec (calc-find-last-x calc-undo-list n)))
 129      (if urec
 130          (calc-handle-last-x urec)
 131        (error "Not enough undo information available"))))
 132 )
 133
 134 (defun calc-handle-last-x (list)
 135   (and list
 136        (let ((action (car list)))
 137          (if (eq (car action) 'pop)
 138              (calc-pop-push-record-list 0 "larg"
 139                                         (delq 'top-of-stack (nth 2 action))))
 140          (calc-handle-last-x (cdr list))))
 141 )
 142
 143 (defun calc-find-last-x (ul n)
 144   (and ul
 145        (if (calc-undo-does-pushes (car ul))
 146            (if (<= n 1)
 147                (car ul)
 148              (calc-find-last-x (cdr ul) (1- n)))
 149          (calc-find-last-x (cdr ul) n)))
 150 )
 151
 152 (defun calc-undo-does-pushes (list)
 153   (and list
 154        (or (eq (car (car list)) 'pop)
 155            (calc-undo-does-pushes (cdr list))))
 156 )
 157
 158
 159