lisp/calc/calc-undo.el

   1 ;;; calc-undo.el --- undo functions for Calc
   2
   3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 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? "
  81                                    (calc-var-name (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 (defun calc-redo (n)
  94   (interactive "p")
  95   (when calc-executing-macro
  96     (error "Use C-x e, not X, to run a keyboard macro that uses Redo"))
  97   (if (<= n 0)
  98       (calc-undo (- n))
  99     (calc-wrapper
 100      (when (null (nthcdr (1- n) calc-redo-list))
 101        (error "Unable to redo"))
 102      (setq calc-redo-list
 103            (prog1
 104                (nthcdr n calc-redo-list)
 105              (let ((saved-stack-top calc-stack-top))
 106                (let ((calc-stack-top 0))
 107                  (calc-handle-redos calc-redo-list n))
 108                (setq calc-stack-top saved-stack-top))))
 109      (message "Redo!"))))
 110
 111 (defun calc-handle-redos (cl n)
 112   (when (> n 0)
 113     (let ((old-undo calc-undo-list))
 114       (setq calc-undo-list nil)
 115       (calc-handle-undo (car cl))
 116       (setq calc-undo-list (append calc-undo-list old-undo)))
 117     (calc-handle-redos (cdr cl) (1- n))))
 118
 119 (defun calc-last-args (n)
 120   (interactive "p")
 121   (when calc-executing-macro
 122     (error "Use C-x e, not X, to run a keyboard macro that uses last-args"))
 123   (calc-wrapper
 124    (let ((urec (calc-find-last-x calc-undo-list n)))
 125      (if urec
 126          (calc-handle-last-x urec)
 127        (error "Not enough undo information available")))))
 128
 129 (defun calc-handle-last-x (list)
 130   (when list
 131     (let ((action (car list)))
 132       (if (eq (car action) 'pop)
 133           (calc-pop-push-record-list 0 "larg"
 134                                      (delq 'top-of-stack (nth 2 action))))
 135       (calc-handle-last-x (cdr list)))))
 136
 137 (defun calc-find-last-x (ul n)
 138   (when ul
 139     (if (calc-undo-does-pushes (car ul))
 140         (if (<= n 1)
 141             (car ul)
 142           (calc-find-last-x (cdr ul) (1- n)))
 143       (calc-find-last-x (cdr ul) n))))
 144
 145 (defun calc-undo-does-pushes (list)
 146   (and list
 147        (or (eq (car (car list)) 'pop)
 148            (calc-undo-does-pushes (cdr list)))))
 149
 150 (provide 'calc-undo)
 151
 152 ;;; arch-tag: eeb485d2-fb3d-454a-9d79-450af1f50d6c
 153 ;;; calc-undo.el ends here