home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / calc-2.02d-bin.lha / lib / emacs / site-lisp / calc-undo.el < prev    next >
Encoding:
Text File  |  1996-10-12  |  4.6 KB  |  160 lines
  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.  
  160.