lisp/calc/calc-undo.el

   1 ;;; calc-undo.el --- undo functions for Calc
   2
   3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007 Free Software Foundation, Inc.
   5
   6 ;; Author: David Gillespie <daveg@synaptics.com>
   7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 ;; This file is autoloaded from calc-ext.el.
  31
  32 (require 'calc-ext)
  33 (require 'calc-macs)
  34
  35 ;;; Undo.
  36
  37 (defun calc-undo (n)
  38   (interactive "p")
  39   (when calc-executing-macro
  40     (error "Use C-x e, not X, to run a keyboard macro that uses Undo"))
  41   (if (<= n 0)
  42       (if (< n 0)
  43           (calc-redo (- n))
  44         (calc-last-args 1))
  45     (calc-wrapper
  46      (when (null (nthcdr (1- n) calc-undo-list))
  47        (error "No further undo information available"))
  48      (setq calc-undo-list
  49            (prog1
  50                (nthcdr n calc-undo-list)
  51              (let ((saved-stack-top calc-stack-top))
  52                (let ((calc-stack-top 0))
  53                  (calc-handle-undos calc-undo-list n))
  54                (setq calc-stack-top saved-stack-top))))
  55      (message "Undo!"))))
  56
  57 (defun calc-handle-undos (cl n)
  58   (when (> n 0)
  59     (let ((old-redo calc-redo-list))
  60       (setq calc-undo-list nil)
  61       (calc-handle-undo (car cl))
  62       (setq calc-redo-list (append calc-undo-list old-redo)))
  63     (calc-handle-undos (cdr cl) (1- n))))
  64
  65 (defun calc-handle-undo (list)
  66   (when 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? "
  82                                    (calc-var-name (nth 1 action))))
  83                  (progn
  84                    (if (nth 2 action)
  85                        (set v (nth 2 action))
  86                      (makunbound v))
  87                    (calc-refresh-evaltos v)))))
  88           ((eq (car action) 'eval)
  89            (calc-record-undo (append (list 'eval (nth 2 action) (nth 1 action))
  90                                      (cdr (cdr (cdr action)))))
  91            (apply (nth 1 action) (cdr (cdr (cdr action))))))
  92          (calc-handle-undo (cdr list)))))
  93
  94 (defun calc-redo (n)
  95   (interactive "p")
  96   (when 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      (when (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 (defun calc-handle-redos (cl n)
 113   (when (> n 0)
 114     (let ((old-undo calc-undo-list))
 115       (setq calc-undo-list nil)
 116       (calc-handle-undo (car cl))
 117       (setq calc-undo-list (append calc-undo-list old-undo)))
 118     (calc-handle-redos (cdr cl) (1- n))))
 119
 120 (defun calc-last-args (n)
 121   (interactive "p")
 122   (when calc-executing-macro
 123     (error "Use C-x e, not X, to run a keyboard macro that uses last-args"))
 124   (calc-wrapper
 125    (let ((urec (calc-find-last-x calc-undo-list n)))
 126      (if urec
 127          (calc-handle-last-x urec)
 128        (error "Not enough undo information available")))))
 129
 130 (defun calc-handle-last-x (list)
 131   (when list
 132     (let ((action (car list)))
 133       (if (eq (car action) 'pop)
 134           (calc-pop-push-record-list 0 "larg"
 135                                      (delq 'top-of-stack (nth 2 action))))
 136       (calc-handle-last-x (cdr list)))))
 137
 138 (defun calc-find-last-x (ul n)
 139   (when ul
 140     (if (calc-undo-does-pushes (car ul))
 141         (if (<= n 1)
 142             (car ul)
 143           (calc-find-last-x (cdr ul) (1- n)))
 144       (calc-find-last-x (cdr ul) n))))
 145
 146 (defun calc-undo-does-pushes (list)
 147   (and list
 148        (or (eq (car (car list)) 'pop)
 149            (calc-undo-does-pushes (cdr list)))))
 150
 151 (provide 'calc-undo)
 152
 153 ;;; arch-tag: eeb485d2-fb3d-454a-9d79-450af1f50d6c
 154 ;;; calc-undo.el ends here