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: Jay Belanger <belanger@truman.edu>
   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
  31 (require 'calc-ext)
  32 (require 'calc-macs)
  33
  34 ;;; Undo.
  35
  36 (defun calc-undo (n)
  37   (interactive "p")
  38   (when calc-executing-macro
  39     (error "Use C-x e, not X, to run a keyboard macro that uses Undo"))
  40   (if (<= n 0)
  41       (if (< n 0)
  42           (calc-redo (- n))
  43         (calc-last-args 1))
  44     (calc-wrapper
  45      (when (null (nthcdr (1- n) calc-undo-list))
  46        (error "No further undo information available"))
  47      (setq calc-undo-list
  48            (prog1
  49                (nthcdr n calc-undo-list)
  50              (let ((saved-stack-top calc-stack-top))
  51                (let ((calc-stack-top 0))
  52                  (calc-handle-undos calc-undo-list n))
  53                (setq calc-stack-top saved-stack-top))))
  54      (message "Undo!"))))
  55
  56 (defun calc-handle-undos (cl n)
  57   (when (> n 0)
  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 (defun calc-handle-undo (list)
  65   (when list
  66        (let ((action (car list)))
  67          (cond
  68           ((eq (car action) 'push)
  69            (calc-pop-stack 1 (nth 1 action) t))
  70           ((eq (car action) 'pop)
  71            (calc-push-list (nth 2 action) (nth 1 action)))
  72           ((eq (car action) 'set)
  73            (calc-record-undo (list 'set (nth 1 action)
  74                                    (symbol-value (nth 1 action))))
  75            (set (nth 1 action) (nth 2 action)))
  76           ((eq (car action) 'store)
  77            (let ((v (intern (nth 1 action))))
  78              (calc-record-undo (list 'store (nth 1 action)
  79                                      (and (boundp v) (symbol-value v))))
  80              (if (y-or-n-p (format "Un-store variable %s? " (nth 1 action)))
  81                  (progn
  82                    (if (nth 2 action)
  83                        (set v (nth 2 action))
  84                      (makunbound v))
  85                    (calc-refresh-evaltos v)))))
  86           ((eq (car action) 'eval)
  87            (calc-record-undo (append (list 'eval (nth 2 action) (nth 1 action))
  88                                      (cdr (cdr (cdr action)))))
  89            (apply (nth 1 action) (cdr (cdr (cdr action))))))
  90          (calc-handle-undo (cdr list)))))
  91
  92 (defun calc-redo (n)
  93   (interactive "p")
  94   (when calc-executing-macro
  95     (error "Use C-x e, not X, to run a keyboard macro that uses Redo"))
  96   (if (<= n 0)
  97       (calc-undo (- n))
  98     (calc-wrapper
  99      (when (null (nthcdr (1- n) calc-redo-list))
 100        (error "Unable to redo"))
 101      (setq calc-redo-list
 102            (prog1
 103                (nthcdr n calc-redo-list)
 104              (let ((saved-stack-top calc-stack-top))
 105                (let ((calc-stack-top 0))
 106                  (calc-handle-redos calc-redo-list n))
 107                (setq calc-stack-top saved-stack-top))))
 108      (message "Redo!"))))
 109
 110 (defun calc-handle-redos (cl n)
 111   (when (> n 0)
 112     (let ((old-undo calc-undo-list))
 113       (setq calc-undo-list nil)
 114       (calc-handle-undo (car cl))
 115       (setq calc-undo-list (append calc-undo-list old-undo)))
 116     (calc-handle-redos (cdr cl) (1- n))))
 117
 118 (defun calc-last-args (n)
 119   (interactive "p")
 120   (when calc-executing-macro
 121     (error "Use C-x e, not X, to run a keyboard macro that uses last-args"))
 122   (calc-wrapper
 123    (let ((urec (calc-find-last-x calc-undo-list n)))
 124      (if urec
 125          (calc-handle-last-x urec)
 126        (error "Not enough undo information available")))))
 127
 128 (defun calc-handle-last-x (list)
 129   (when list
 130     (let ((action (car list)))
 131       (if (eq (car action) 'pop)
 132           (calc-pop-push-record-list 0 "larg"
 133                                      (delq 'top-of-stack (nth 2 action))))
 134       (calc-handle-last-x (cdr list)))))
 135
 136 (defun calc-find-last-x (ul n)
 137   (when ul
 138     (if (calc-undo-does-pushes (car ul))
 139         (if (<= n 1)
 140             (car ul)
 141           (calc-find-last-x (cdr ul) (1- n)))
 142       (calc-find-last-x (cdr ul) n))))
 143
 144 (defun calc-undo-does-pushes (list)
 145   (and list
 146        (or (eq (car (car list)) 'pop)
 147            (calc-undo-does-pushes (cdr list)))))
 148
 149 (provide 'calc-undo)
 150
 151 ;;; arch-tag: eeb485d2-fb3d-454a-9d79-450af1f50d6c
 152 ;;; calc-undo.el ends here