old-fashioned-undo.el

Download

;;; old-fashioned-undo.el --- Undo/Redo in very simple, and old fashioned way.

;; Copyright (C) 2001-2003, 2010, 2013 K-talo Miyazaki, all rights reserved.
;; Author: K-talo Miyazaki <Keitaro dot Miyazaki at gmail dot com>
;; Created: Fri Nov 19 14:13:19 2010 JST
;; Keywords: emulation wp
;; Revision: $Id: 3440ab0bde58a26852d3f12858b2885e48e3014b $
;; URL: 
;; GitHub: http://github.com/k-talo/old-fashioned-undo.el
;; Version: 6.0

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; NOTE
;;
;; This library is just tested on Emacs 24.3.1 on Ubuntu 10.04
;; and Mac OS X 10.8.3, and won't be run with any version of XEmacs.

;;; Commentary:
;;
;; Overview
;; ========
;;
;; This library provides minor mode `old-fashioned-undo-mode' which
;; makes `undo' and `redo' command working in an old fashioned way.
;;
;; The default `undo/redo' commands provided by emacs records each 
;; `undo/redo' operations on `buffer-undo-list'. This behavior may
;; make undo/redo operations perfect, but I feel this behavior is
;; too much verbose and little bit annoying.
;;
;; The undo/redo command provided this library never records
;; `undo/redo' operation on `buffer-undo-list' so that we can
;; `undo/redo' in intuitive way.
;;
;; Additionally, while `old-fashioned-undo-mode' is on, the number
;; of pending `undo/redo' operation will be displayed in the
;; minibuffer when each `undo/redo' command is executed.
;;
;;
;; INSTALLING
;; ==========
;; To install this library, save this file to a directory in your
;; `load-path' (you can view the current `load-path' using "C-h v
;; load-path RET" within Emacs), then add the following line to your
;; .emacs startup file:
;;
;;    (require 'old-fashioned-undo)
;;    (old-fashioned-undo-mode t)
;;
;;
;; USING
;; =====
;; To toggle old-fashioned-undo feature, just type:
;;
;;   `M-x old-fashioned-undo-mode RET'
;;
;;
;; Key map Examples
;; ================
;; (global-set-key [(control z)] 'undo)
;; (global-set-key [(control Z)] 'redo)
;;
;;
;; KNOWN PROBLEMS
;; ==============
;; - Cursor position won't be set properly after undo/redo when cua-mode
;;   is on.

;;; Change Log:
;; v6.0 04/04/2013  Renamed to `old-fashioned-undo.el'.
;; v5.2 02/04/2012  Fixed compiler errors.
;;                  Fixed errors which occurs to XEmacs.
;; v5.1 12/27/2010  Fixed compiler errors and a typo.
;; v5.0 11/19/2010  Renamed to `linear-undo.el'.
;;                  Heavily arranged codes.
;;                  Moved repository from subversion to git.
;; v4.0 10/14/2010  Moved codes regarding to highlighting modified text to
;;                  new library `volatile-highlights.el'.
;; v3.1 10/17/2003  Arranged name of functions and variables.
;;                  (No bug fix and new feature.)
;; v3.0 10/12/2003  emacs21 support.
;; v2.7 10/07/2001  Fixed a bug that undo/redo elements is not counted properly
;;                  when saving information exists in the buffer-undo/redo-list.
;; v2.6 10/06/2001  Fixed a bug that highlights are not removed when frame
;;                  is switched just after undo/redo command.
;;                  (Just make 'old-fashioned-undo/buffer-highlight-list' global variable.)
;; v2.5 10/05/2001  Made optional variable customizable.
;;                  I think all of the feature, that I wanted when I started
;;                  to write this library, are implemented in this version.
;; v2.4 10/05/2001  Inhibit unintended cursor movement by undo/redo.
;; v2.3 10/05/2001  Remove highlights automatically.
;; v2.2 10/04/2001  Display count of undo/redo elements which remains in
;;                  buffer-undo/redo-list.
;;                  New option `allow-remove-boundary-p'.
;;                  Fixed a few bugs.
;; v2.1 10/04/2001  New function 'old-fashioned-undo/lst/get-next'.
;;                  (to prepare for implementing new feature, counting
;;                   undo/redo elements in buffer-undo/redo-list.)
;;                  Fixed a few bugs.
;; v2.0 10/03/2001  Highlight text which is inserted by undo/redo command.
;;                  (very experimental)
;;                  Codes are heavily modified.
;; v1.2 10/02/2001  Fixed some bugs.
;; v1.1 09/29/2001  Menu-bar support.
;; v1.0 09/28/2001  Initial version.


;;; Code:
(eval-when-compile
  (require 'cl))

(defvar old-fashioned-undo/version "6.0")
(defun old-fashioned-undo/version ()
  (interactive)
  (message "old-fashioned-undo version %s" old-fashioned-undo/version))

 
;;;============================================================================
;;;
;;;  Private Variables.
;;;
;;;============================================================================

(eval-and-compile
  (defconst old-fashioned-undo/.xemacsp (string-match "XEmacs" emacs-version)
    "A flag if the emacs is xemacs or not."))

 
;;;============================================================================
;;;
;;;  Suppress compiler warnings regarding to emacs/xemacs private functions.
;;;
;;;============================================================================
(eval-when-compile
  (dolist (func (cond (old-fashioned-undo/.xemacsp
                       '(minibufferp
                         define-key-after))
                      (t
                       '(add-menu-button
                         delete-menu-button
                         delete-menu-item))))
      (when (not (fboundp func))
        (setf (symbol-function func) (lambda (&rest args))))))

(eval-and-compile
  (cond
   ;; XEmacs
   (old-fashioned-undo/.xemacsp
    (defun old-fashioned-undo/.minibufferp (buf)
      (string-match "^ \\*Minibuf-[0-9]+\\*$"
                    (cond
                     ((stringp buf)
                      buf)
                     ((bufferp buf)
                      (buffer-name buf))
                     (t
                      (error "Wrong type argument bufferp %S" 123))))))
   ;; GNU Emacs
   (t
    (defun old-fashioned-undo/.minibufferp (buf)
      (funcall 'minibufferp buf)))))

;;  
;;; ===========================================================================
;;;
;;;  Customazable things.
;;;
;;; ===========================================================================

(defgroup old-fashioned-undo nil
  "Undo/Redo in an old fashioned way."
  :tag "Old Fashioned Undo"
  :group 'undo)

(defcustom old-fashioned-undo/allow-remove-boundary-p nil
  "Usually, `undo' command with numeric argument removes undo boundaries
in a series of the undo operation from `buffer-undo-list'.

When `nil' is set to this variable, undo buouaries will not removed
even if prefix argument is passed or not."
  :type 'boolean
  :group 'old-fashioned-undo)

 
;;; ===========================================================================
;;;
;;;  Variables
;;;
;;; ===========================================================================

;; We use original `buffer-undo-list' in this library.

(defvar old-fashioned-undo/buffer-redo-list nil
  "List of redo entries in current buffer.

See also `buffer-undo-list'.")
(make-variable-buffer-local 'old-fashioned-undo/buffer-redo-list)

(defvar old-fashioned-undo/.last-buffer-undo-list nil
  "Private variable to detect if a buffer is edited or not
after last undo/redo command.")
(make-variable-buffer-local 'old-fashioned-undo/.last-buffer-undo-list)

 
;;; ===========================================================================
;;;
;;;  Commands
;;;
;;; ===========================================================================

;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/undo &optional arg) => VOID
;; ----------------------------------------------------------------------------
(defun old-fashioned-undo/undo (&optional arg)
  "Undo in an old fashioned way."
  (interactive "*p")
  (old-fashioned-undo/undo-aux :count (or arg 1) :by-chunk-p t))

;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/undo-1 &optional arg) => VOID
;; ----------------------------------------------------------------------------
(defun old-fashioned-undo/undo-1 (&optional arg)
  "Undo just one element in an old fashioned way."
  (interactive "*p")
  (old-fashioned-undo/undo-aux :count (or arg 1) :by-chunk-p nil))

;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/redo &optional arg)
;; ----------------------------------------------------------------------------
(defun old-fashioned-undo/redo (&optional arg)
  "Redo in an old fashioned way."
  (interactive "*p")
  (old-fashioned-undo/redo-aux :count (or arg 1) :by-chunk-p t))

;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/redo-1 &optional arg)
;; ----------------------------------------------------------------------------
(defun old-fashioned-undo/redo-1 (&optional arg)
  "Redo just one element in an old fashioned way."
  (interactive "*p")
  (old-fashioned-undo/redo-aux :count (or arg 1) :by-chunk-p nil))

 
;;; ===========================================================================
;;;
;;;  Functions
;;;
;;; ===========================================================================

 
;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/undo-aux &key count by-chunk-p) => VOID
;; ----------------------------------------------------------------------------
(defun* old-fashioned-undo/undo-aux (&key count by-chunk-p)
  "Auxiliary function for `old-fashioned-undo/undo' and `old-fashioned-undo/undo-1'."
  
  (if (eq buffer-undo-list t)
      (error "No undo information in this buffer"))
  
  ;; When `buffer-undo-list' is empty, quit with error message.
  (or buffer-undo-list
      (error "No further undo information"))
  
  ;; Unknown error.
  (or (null (car buffer-undo-list))
      (error "Can't undo! Something is wrong with `buffer-undo-list'!"))
  
  ;; Display message.
  (when (not (old-fashioned-undo/.minibufferp (window-buffer (selected-window))))
    (message "Undo..."))
  
  (let ((buf-modefied-since-last-undo-p
         (not (eq buffer-undo-list old-fashioned-undo/.last-buffer-undo-list)))
        (orig-modefied-p (buffer-modified-p))
        (recent-save (recent-auto-save-p)))
    
    ;; When buffer is modified since last undo or redo,
    ;; reset the `buffer-redo-list'.
    (and buf-modefied-since-last-undo-p
         (setq old-fashioned-undo/buffer-redo-list nil))
    
    ;; Do the undo operation.
    (old-fashioned-undo/run-primitive-undo :count count
                                    :undo-lst-name 'buffer-undo-list
                                    :redo-lst-name 'old-fashioned-undo/buffer-redo-list
                                    :by-chunk-p by-chunk-p)
    
    ;; Save current undo state for next undo/redo operation.
    (setq old-fashioned-undo/.last-buffer-undo-list buffer-undo-list)
    
    ;; Remove auto-save file when it has no meanings.
    (and orig-modefied-p (not (buffer-modified-p))
         (delete-auto-save-file-if-necessary recent-save)))
  
  (old-fashioned-undo/display-finish-info :cmd-name "Undo" :count count :by-chunk-p by-chunk-p))

 
;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/redo-aux &key count by-chunk-p) => VOID
;; ----------------------------------------------------------------------------
(defun* old-fashioned-undo/redo-aux (&key count by-chunk-p)
  "Auxiliary function for `old-fashioned-undo/redo' and `old-fashioned-undo/redo-1'."

  (if (eq buffer-undo-list t)
      (error "No redo information in this buffer"))
  
  ;; When `old-fashioned-undo/buffer-redo-list' is empty, quit with error message.
  (or old-fashioned-undo/buffer-redo-list
      (error "No further redo information"))
  
  ;; Unknown error.
  (or (null (car old-fashioned-undo/buffer-redo-list))
      (error "Can't redo! Something is wrong with the `old-fashioned-undo/buffer-redo-list'!"))

  ;; Display message.
  (when (not (old-fashioned-undo/.minibufferp (window-buffer (selected-window))))
      (message "Redo..."))

  (let ((buf-modefied-since-last-undo-p
         (not (eq buffer-undo-list old-fashioned-undo/.last-buffer-undo-list)))
        (orig-modefied-p (buffer-modified-p))
        (recent-save (recent-auto-save-p)))
    
    ;; When buffer is modified since last undo or redo,
    ;; quit with error message.
    (and buf-modefied-since-last-undo-p
         (progn (setq old-fashioned-undo/buffer-redo-list nil)
                (error "Buffer modified since last undo/redo, cannot redo")))
    
    ;; Do the redo operation.
    (old-fashioned-undo/run-primitive-undo :count count
                                    :undo-lst-name 'old-fashioned-undo/buffer-redo-list
                                    :redo-lst-name 'buffer-undo-list
                                    :by-chunk-p by-chunk-p)

    ;; Save current undo state for next undo/redo operation.
    (setq old-fashioned-undo/.last-buffer-undo-list buffer-undo-list)
    
    ;; Remove auto-save file when it has no meanings.
    (and orig-modefied-p (not (buffer-modified-p))
         (delete-auto-save-file-if-necessary recent-save)))

  (old-fashioned-undo/display-finish-info :cmd-name "Redo" :count count :by-chunk-p by-chunk-p))

 
;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/display-finish-info COMMAND_NAME REPEAT_COUNT) => VOID
;; ----------------------------------------------------------------------------
(defun* old-fashioned-undo/display-finish-info (&key cmd-name count by-chunk-p)
  "Display the number of pending undo/redo."
  (or (eq (selected-window) (minibuffer-window))
      (message "%s%s%s! [Undo: %d%s / Redo: %d%s]"
               ;; Name of current command.
               cmd-name
                 
               ;; When undoing by one element, append "-1" to the command name.
               (if by-chunk-p "" "-1")
                 
               ;; When the prefix argument is greater than 1,
               ;; display the number.
               (if (> count 1) (format "(%s)" count) "")

               ;; Display count of the undo chunks remaining.
               (old-fashioned-undo/lst/get-count buffer-undo-list
                                          :chunk-p t)
                 
               ;; Display count of undo elements remaining.
               (if (not by-chunk-p)
                 (format "(%d)"
                         (old-fashioned-undo/lst/get-count buffer-undo-list
                                                    :chunk-p nil))
                 "")

               ;; Display count of the redo chunks remaining.
               (old-fashioned-undo/lst/get-count old-fashioned-undo/buffer-redo-list
                                          :chunk-p t)

               ;; Display count of redo elements remaining.
               (if (not by-chunk-p)
                   (format "(%d)"
                           (old-fashioned-undo/lst/get-count old-fashioned-undo/buffer-redo-list
                                                      :chunk-p nil))
                 ""))))

 
;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/run-primitive-undo COUNT SYM_LIST_1 SYM_LIST_2) => VOID
;; ----------------------------------------------------------------------------
(defun* old-fashioned-undo/run-primitive-undo (&key count undo-lst-name redo-lst-name by-chunk-p)
  "Execute undo/redo by primitive-undo."
  ;; Prepare for undo/redo BY ONE STEP.
  (when (not by-chunk-p)
    (old-fashioned-undo/lst/split (symbol-value undo-lst-name) :limit count))
    
  (let ((chunk-lst-to-redo (old-fashioned-undo/run-primitive-undo-aux :count count
                                                               :undo-lst-name undo-lst-name)))
    ;; Remove `POSITION' elements in canceling chunks, because a comment
    ;; in 'simple.el' says:
    ;;
    ;;   ;; Don't specify a position in the undo record for the undo command.
    ;;   ;; Instead, undoing this should move point to where the change is.
    ;;
    ;; This prevents from unintended movement of point caused by undo operations.
    ;; (This block is added in v2.4)
    (setq chunk-lst-to-redo 
          (remove-if #'integerp chunk-lst-to-redo))
    ;; XXX: Experimental 2010/11/5
    (setq chunk-lst-to-redo
          (remove-if (lambda (elt) (markerp (car elt))) chunk-lst-to-redo))
    
    ;; Push `chunk-lst-to-redo' to `redo-lst'.
    (set (symbol-value 'redo-lst-name)
         (nconc chunk-lst-to-redo
                (symbol-value redo-lst-name)))))

 
;; ----------------------------------------------------------------------------
;;  (old-fashioned-undo/run-primitive-undo-aux &key count undo-lst-name by-chunk-p)
;;                                                         => chunk-lst-to-redo
;; ----------------------------------------------------------------------------
(defun* old-fashioned-undo/run-primitive-undo-aux (&key count undo-lst-name by-chunk-p)
  ""
  (flet ((1st-is-not-boundary (lst)
                              (not (null (car lst))))
         (ldiff! (lst sublst)
                 ;; Remove SUBLIST from LIST then return LIST.
                 ;; 
                 ;; Use this function like nconc:
                 ;; (setq list (old-fashioned-undo/ldiff! list sublist))
                 (let ((idx 0))
                   (while (and (consp (nthcdr idx lst)) (not (eq (nthcdr idx lst) sublst)))
                     (setq idx (1+ idx)))
                   (setf (nthcdr idx lst) nil)
                   lst)))
    (let ((chunk-lst-to-redo nil)
          (inhibit-quit nil)
          orig-buffer-undo-list
          new-undo-lst)
    
      ;; Remember current state of the `buffer-undo-list'.
      ;; to detect a chunk which redoes current undo operation later,
      (setq orig-buffer-undo-list buffer-undo-list)
    
      ;; Execute the undo operation by `primitive-undo'.
      (setq new-undo-lst
            (primitive-undo
             (if old-fashioned-undo/allow-remove-boundary-p count 1)
             (cdr (symbol-value undo-lst-name))))

      ;; Due to the side effect of the operation `primitive-undo',
      ;; a chunk, which cancells current undo operation, will be
      ;; prepended to the `buffer-undo-list'.
      ;;
      ;; We pick that chunk from the `buffer-undo-list' and prepend to
      ;; `chunk-lst-to-redo'.
      (setq chunk-lst-to-redo
            (nconc (ldiff! buffer-undo-list orig-buffer-undo-list)
                   chunk-lst-to-redo))
      (setq buffer-undo-list orig-buffer-undo-list)
        
      ;; Push a boundary to `chunk-lst-to-redo' if necessary.
      (when (1st-is-not-boundary chunk-lst-to-redo)
        (push nil chunk-lst-to-redo))

      ;; Update value of `undo-lst'.
      (set (symbol-value 'undo-lst-name)
           new-undo-lst)
        
      ;; Push a bundary to `undo-lst' if necessary.
      (when (1st-is-not-boundary (symbol-value undo-lst-name))
        (push nil (symbol-value undo-lst-name)))

      ;; Continue running premitive-undo by recursive call.
      (when (and (not old-fashioned-undo/allow-remove-boundary-p)
                 (< 1 count)
                 (symbol-value undo-lst-name)) ;`undo-lst' is not empty.
        (setq chunk-lst-to-redo
              (nconc (old-fashioned-undo/run-primitive-undo-aux :count (1- count)
                                                         :undo-lst-name undo-lst-name
                                                         :by-chunk-p by-chunk-p)
                     chunk-lst-to-redo)))
        
      chunk-lst-to-redo)))

 
;;; ===========================================================================
;;;
;;;  old-fashioned-undo/lst: Manipulate Buffer Undo List.
;;;
;;; ===========================================================================

 
;; -----------------------------------------------------------------------------
;;  (old-fashioned-undo/lst/split lst &key limit) => num-of-inserted-bounds
;; -----------------------------------------------------------------------------
(defun* old-fashioned-undo/lst/split (lst &key limit)
  "Split LST by inserting boundary between each elements
from 1st to (1+ LIMIT)th element.

Returns number of boundary inserted to the LST."
    (let ((next-chunk (old-fashioned-undo/lst/get-next lst :chunk-p nil))
          (num-inserted 0))
      
      (when (< 0 limit)
        (when next-chunk ;;The lst is not empty
          (when (car next-chunk)  ;;The next-element is not boundary
            ;; Push boundary to the next-chunk like:
            ;;   (xth-elm ...) => (nil xth-elm ...)
            (setcdr next-chunk
                    (cons (car next-chunk) (cdr next-chunk)))
            (setcar next-chunk nil)
            (incf num-inserted))
          (setq num-inserted (+ num-inserted
                                (old-fashioned-undo/lst/split next-chunk
                                                       :limit (1- limit))))))
      num-inserted))

 
;; -----------------------------------------------------------------------------
;;  (old-fashioned-undo/lst/get-count LST &KEY CHUNK-P) => NUM
;; -----------------------------------------------------------------------------
(defun old-fashioned-undo/lst/get-count (lst &key chunk-p)
  "Count undo/redo elements in LST.

When non-nil value is set to the argument CHUNK-P,
count chunks in the LST instead of elements."
  (let ((ret-val 0)
        (cur-node lst)
        (done nil))
    (or (eq cur-node nil)
        (while (not done)
          (setq ret-val (1+ ret-val))
          (setq cur-node (old-fashioned-undo/lst/get-next cur-node :chunk-p chunk-p))
          (if (eq cur-node nil) ;; All of chunks are processed.
              (setq done t))))
    ret-val))

 
;; -----------------------------------------------------------------------------
;;  (old-fashioned-undo/lst/get-next LST &KEY CHUNK-P) => LST
;; -----------------------------------------------------------------------------
(defun* old-fashioned-undo/lst/get-next (lst &key chunk-p)
  "Find a sub list which starts with a next undo/redo element from the LST.

When non-nil value is set to the argument CHUNK-P,
find sub list which starts a next undo/redo chunk instead of a element.

Returns nil when no next element or chunk exists."
  (let ((cur-node lst)
        (done nil))
    (while (not done)
      (cond
       ;; Stop scanning at the end of buffer-undo/redo-list.
       ((eq cur-node nil)
        (setq done t))
      
       ;; Stop scanning at the end of buffer-undo/redo-list.
       ((eq (cdr cur-node) nil)
        (setq cur-node nil)
        (setq done t))
       
       ;; Skip an element which INDICATES THAT AN UNMODIFIED
       ;; BUFFER BECAME MODIFIED.
       ((eq (car-safe (car (cdr cur-node))) t)
        (setq cur-node (cdr cur-node)))
       
       ;; Skip the first element when it is a BOUNDARY.
       ((eq (car cur-node) nil)
        (setq cur-node (cdr cur-node)))
       
       ;; Skip an element when it is a PREVIOUS VALUE OF POINT.
       ((integerp (car (cdr cur-node)))
        (setq cur-node (cdr cur-node)))
       
       ;; Skip an element when it is a MARKER and ADJUSTMENT pair.
       ((and (markerp  (car (car (cdr cur-node))))
             (integerp (cdr (car (cdr cur-node)))))
        (setq cur-node (cdr cur-node)))
       
       ;; Stop scanning when the NEXT ELEMENT IS A BOUNDARY.
       ((eq (car (cdr cur-node)) nil)
        (setq cur-node (cdr cur-node))
        (setq done t))

       ;; Other than above.
       (t (setq cur-node (cdr cur-node))
          ;; When the argument `chunk-p' is
          ;; set, skip just one element.
          (when (not chunk-p)
            (setq done t)))))

    cur-node))


 
;;; ===========================================================================
;;;
;;;  Menus
;;;
;;; ===========================================================================

(if (string-match "XEmacs" emacs-version)
    ;; XEmacs
    (progn
      (delete-menu-item '("Edit" "Undo"))
      (delete-menu-item '("Edit" "Redo"))
      (add-menu-button '("Edit")
               ["Undo" undo
            :active buffer-undo-list]
               "Cut")
      (add-menu-button '("Edit")
               ["Redo" redo
            :active (and old-fashioned-undo/buffer-redo-list
                     (eq buffer-undo-list
                     old-fashioned-undo/.last-buffer-undo-list))]
               "Cut"))
  ;; GNU Emacs
  (define-key menu-bar-edit-menu [undo]
  '(menu-item "Undo" undo
          :enable (and (not buffer-read-only)
               buffer-undo-list)
          :help "Undo last operation"))
  
  (define-key-after menu-bar-edit-menu [redo]
    '(menu-item "Redo" redo
        :enable (and (not buffer-read-only)
                 (and old-fashioned-undo/buffer-redo-list
                  (eq buffer-undo-list
                      old-fashioned-undo/.last-buffer-undo-list)))
        :help "Redo last operation") 'undo))

 
;;; ===========================================================================
;;;
;;;  Define Minor Mode.
;;;
;;; ===========================================================================

(easy-mmode-define-minor-mode
 old-fashioned-undo-mode "Minor mode for old fashioned undo/redo."
 :global t
 :init-value nil
 :lighter " OFU"
 (if (or (not (boundp 'old-fashioned-undo-mode))
         old-fashioned-undo-mode)
     (progn
       ;; Override embedded functions. (Evil hack)
       (setf (symbol-function 'undo)
             (symbol-function 'old-fashioned-undo/undo))
       (setf (symbol-function 'redo)
             (symbol-function 'old-fashioned-undo/redo))

       ;; Initialize variables
       (setq old-fashioned-undo/buffer-redo-list nil))
   (progn
     ;; Restore original undo functions.
     (setf (symbol-function 'undo)
           (symbol-function 'old-fashioned-undo/orig-undo))
     (if (fboundp 'old-fashioned-undo/orig-redo)
         (setf (symbol-function 'redo)
               (symbol-function 'old-fashioned-undo/orig-redo))
       (fmakunbound 'redo)))))

(when (not (featurep 'old-fashioned-undo))
  ;; Save original functions.
  (when (not (fboundp 'old-fashioned-undo/orig-undo))
    (setf (symbol-function 'old-fashioned-undo/orig-undo)
            (symbol-function 'undo)))
  (when (and (fboundp 'redo)
             (not (fboundp 'old-fashioned-undo/orig-redo)))
    (setf (symbol-function 'old-fashioned-undo/orig-redo)
            (symbol-function 'redo))))

(provide 'old-fashioned-undo)


;;; old-fashioned-undo.el ends here