1;;; gnus-undo.el --- minor mode for undoing in Gnus
2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Keywords: news
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;; This package allows arbitrary undoing in Gnus buffers.  As all the
29;; Gnus buffers aren't very text-oriented (what is in the buffers is
30;; just some arbitrary representation of the actual data), normal Emacs
31;; undoing doesn't work at all for Gnus.
32;;
33;; This package works by letting Gnus register functions for reversing
34;; actions, and then calling these functions when the user pushes the
35;; `undo' key.  As with normal `undo', there it is possible to set
36;; undo boundaries and so on.
37;;
38;; Internally, the undo sequence is represented by the
39;; `gnus-undo-actions' list, where each element is a list of functions
40;; to be called, in sequence, to undo some action.  (An "action" is a
41;; collection of functions.)
42;;
43;; For instance, a function for killing a group will call
44;; `gnus-undo-register' with a function that un-kills the group.  This
45;; package will put that function into an action.
46
47;;; Code:
48
49(eval-when-compile (require 'cl))
50
51(require 'gnus-util)
52(require 'gnus)
53(require 'custom)
54
55(defgroup gnus-undo nil
56  "Undoing in Gnus buffers."
57  :group 'gnus)
58
59(defcustom gnus-undo-limit 2000
60  "The number of undoable actions recorded."
61  :type 'integer
62  :group 'gnus-undo)
63
64(defcustom gnus-undo-mode nil
65  "Minor mode for undoing in Gnus buffers."
66  :type 'boolean
67  :group 'gnus-undo)
68
69(defcustom gnus-undo-mode-hook nil
70  "Hook called in all `gnus-undo-mode' buffers."
71  :type 'hook
72  :group 'gnus-undo)
73
74;;; Internal variables.
75
76(defvar gnus-undo-actions nil)
77(defvar gnus-undo-boundary t)
78(defvar gnus-undo-last nil)
79(defvar gnus-undo-boundary-inhibit nil)
80
81;;; Minor mode definition.
82
83(defvar gnus-undo-mode-map nil)
84
85(unless gnus-undo-mode-map
86  (setq gnus-undo-mode-map (make-sparse-keymap))
87
88  (gnus-define-keys gnus-undo-mode-map
89    "\M-\C-_"     gnus-undo
90    "\C-_"        gnus-undo
91    "\C-xu"       gnus-undo
92    ;; many people are used to type `C-/' on X terminals and get `C-_'.
93    [(control /)] gnus-undo))
94
95(defun gnus-undo-make-menu-bar ()
96  ;; This is disabled for the time being.
97  (when nil
98    (define-key-after (current-local-map) [menu-bar file gnus-undo]
99      (cons "Undo" 'gnus-undo-actions)
100      [menu-bar file whatever])))
101
102(defun gnus-undo-mode (&optional arg)
103  "Minor mode for providing `undo' in Gnus buffers.
104
105\\{gnus-undo-mode-map}"
106  (interactive "P")
107  (set (make-local-variable 'gnus-undo-mode)
108       (if (null arg) (not gnus-undo-mode)
109	 (> (prefix-numeric-value arg) 0)))
110  (set (make-local-variable 'gnus-undo-actions) nil)
111  (set (make-local-variable 'gnus-undo-boundary) t)
112  (when gnus-undo-mode
113    ;; Set up the menu.
114    (when (gnus-visual-p 'undo-menu 'menu)
115      (gnus-undo-make-menu-bar))
116    (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
117    (gnus-make-local-hook 'post-command-hook)
118    (add-hook 'post-command-hook 'gnus-undo-boundary nil t)
119    (gnus-run-hooks 'gnus-undo-mode-hook)))
120
121;;; Interface functions.
122
123(defun gnus-disable-undo (&optional buffer)
124  "Disable undoing in the current buffer."
125  (interactive)
126  (save-excursion
127    (when buffer
128      (set-buffer buffer))
129    (gnus-undo-mode -1)))
130
131(defun gnus-undo-boundary ()
132  "Set Gnus undo boundary."
133  (if gnus-undo-boundary-inhibit
134      (setq gnus-undo-boundary-inhibit nil)
135    (setq gnus-undo-boundary t)))
136
137(defun gnus-undo-force-boundary ()
138  "Set Gnus undo boundary."
139  (setq gnus-undo-boundary-inhibit nil
140	gnus-undo-boundary t))
141
142(defun gnus-undo-register (form)
143  "Register FORMS as something to be performed to undo a change.
144FORMS may use backtick quote syntax."
145  (when gnus-undo-mode
146    (gnus-undo-register-1
147     `(lambda ()
148	,form))))
149
150(put 'gnus-undo-register 'lisp-indent-function 0)
151(put 'gnus-undo-register 'edebug-form-spec '(body))
152
153(defun gnus-undo-register-1 (function)
154  "Register FUNCTION as something to be performed to undo a change."
155  (when gnus-undo-mode
156    (cond
157     ;; We are on a boundary, so we create a new action.
158     (gnus-undo-boundary
159      (push (list function) gnus-undo-actions)
160      (setq gnus-undo-boundary nil))
161     ;; Prepend the function to an old action.
162     (gnus-undo-actions
163      (setcar gnus-undo-actions (cons function (car gnus-undo-actions))))
164     ;; Initialize list.
165     (t
166      (setq gnus-undo-actions (list (list function)))))
167    ;; Limit the length of the undo list.
168    (let ((next (nthcdr gnus-undo-limit gnus-undo-actions)))
169      (when next
170	(setcdr next nil)))
171    ;; We are not at a boundary...
172    (setq gnus-undo-boundary-inhibit t)))
173
174(defun gnus-undo (n)
175  "Undo some previous changes in Gnus buffers.
176Repeat this command to undo more changes.
177A numeric argument serves as a repeat count."
178  (interactive "p")
179  (unless gnus-undo-mode
180    (error "Undoing is not enabled in this buffer"))
181  (message "%s" last-command)
182  (when (or (not (eq last-command 'gnus-undo))
183	    (not gnus-undo-last))
184    (setq gnus-undo-last gnus-undo-actions))
185  (let ((action (pop gnus-undo-last)))
186    (unless action
187      (error "Nothing further to undo"))
188    (setq gnus-undo-actions (delq action gnus-undo-actions))
189    (setq gnus-undo-boundary t)
190    (while action
191      (funcall (pop action)))))
192
193(provide 'gnus-undo)
194
195;;; arch-tag: 0d787bc7-787d-499a-837f-211d2cb07f2e
196;;; gnus-undo.el ends here
197