Update copyright year to 2016
[gnus] / lisp / gnus-undo.el
1 ;;; gnus-undo.el --- minor mode for undoing in Gnus
2
3 ;; Copyright (C) 1996-2016 Free Software Foundation, Inc.
4
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;; This package allows arbitrary undoing in Gnus buffers.  As all the
26 ;; Gnus buffers aren't very text-oriented (what is in the buffers is
27 ;; just some arbitrary representation of the actual data), normal Emacs
28 ;; undoing doesn't work at all for Gnus.
29 ;;
30 ;; This package works by letting Gnus register functions for reversing
31 ;; actions, and then calling these functions when the user pushes the
32 ;; `undo' key.  As with normal `undo', there it is possible to set
33 ;; undo boundaries and so on.
34 ;;
35 ;; Internally, the undo sequence is represented by the
36 ;; `gnus-undo-actions' list, where each element is a list of functions
37 ;; to be called, in sequence, to undo some action.  (An "action" is a
38 ;; collection of functions.)
39 ;;
40 ;; For instance, a function for killing a group will call
41 ;; `gnus-undo-register' with a function that un-kills the group.  This
42 ;; package will put that function into an action.
43
44 ;;; Code:
45
46 (eval-when-compile (require 'cl))
47 (eval-when-compile
48   (when (featurep 'xemacs)
49     (require 'easy-mmode))) ; for `define-minor-mode'
50
51 (require 'gnus-util)
52 (require 'gnus)
53
54 (defgroup gnus-undo nil
55   "Undoing in Gnus buffers."
56   :group 'gnus)
57
58 (defcustom gnus-undo-limit 2000
59   "The number of undoable actions recorded."
60   :type 'integer
61   :group 'gnus-undo)
62
63 (defcustom gnus-undo-mode nil
64   ;; FIXME: This is a buffer-local minor mode which requires running
65   ;; code upon activation/deactivation, so defining it as a defcustom
66   ;; doesn't seem very useful: setting it to non-nil via Customize
67   ;; probably won't do the right thing.
68   "Minor mode for undoing in Gnus buffers."
69   :type 'boolean
70   :group 'gnus-undo)
71
72 (defcustom gnus-undo-mode-hook nil
73   "Hook called in all `gnus-undo-mode' buffers."
74   :type 'hook
75   :group 'gnus-undo)
76
77 ;;; Internal variables.
78
79 (defvar gnus-undo-actions nil)
80 (defvar gnus-undo-boundary t)
81 (defvar gnus-undo-last nil)
82 (defvar gnus-undo-boundary-inhibit nil)
83
84 ;;; Minor mode definition.
85
86 (defvar gnus-undo-mode-map
87   (let ((map (make-sparse-keymap)))
88     (gnus-define-keys 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     map))
95
96 (defun gnus-undo-make-menu-bar ()
97   ;; This is disabled for the time being.
98   (when nil
99     (define-key-after (current-local-map) [menu-bar file gnus-undo]
100       (cons "Undo" 'gnus-undo-actions)
101       [menu-bar file whatever])))
102
103 (define-minor-mode gnus-undo-mode
104   "Minor mode for providing `undo' in Gnus buffers.
105
106 \\{gnus-undo-mode-map}"
107   :keymap gnus-undo-mode-map
108   (set (make-local-variable 'gnus-undo-actions) nil)
109   (set (make-local-variable 'gnus-undo-boundary) t)
110   (when gnus-undo-mode
111     ;; Set up the menu.
112     (when (gnus-visual-p 'undo-menu 'menu)
113       (gnus-undo-make-menu-bar))
114     (gnus-make-local-hook 'post-command-hook)
115     (add-hook 'post-command-hook 'gnus-undo-boundary nil t)))
116
117 ;;; Interface functions.
118
119 (defun gnus-disable-undo (&optional buffer)
120   "Disable undoing in the current buffer."
121   (interactive)
122   (save-excursion
123     (when buffer
124       (set-buffer buffer))
125     (gnus-undo-mode -1)))
126
127 (defun gnus-undo-boundary ()
128   "Set Gnus undo boundary."
129   (if gnus-undo-boundary-inhibit
130       (setq gnus-undo-boundary-inhibit nil)
131     (setq gnus-undo-boundary t)))
132
133 (defun gnus-undo-force-boundary ()
134   "Set Gnus undo boundary."
135   (setq gnus-undo-boundary-inhibit nil
136         gnus-undo-boundary t))
137
138 (defun gnus-undo-register (form)
139   "Register FORMS as something to be performed to undo a change.
140 FORMS may use backtick quote syntax."
141   (when gnus-undo-mode
142     (gnus-undo-register-1
143      `(lambda ()
144         ,form))))
145
146 (put 'gnus-undo-register 'lisp-indent-function 0)
147 (put 'gnus-undo-register 'edebug-form-spec '(body))
148
149 (defun gnus-undo-register-1 (function)
150   "Register FUNCTION as something to be performed to undo a change."
151   (when gnus-undo-mode
152     (cond
153      ;; We are on a boundary, so we create a new action.
154      (gnus-undo-boundary
155       (push (list function) gnus-undo-actions)
156       (setq gnus-undo-boundary nil))
157      ;; Prepend the function to an old action.
158      (gnus-undo-actions
159       (setcar gnus-undo-actions (cons function (car gnus-undo-actions))))
160      ;; Initialize list.
161      (t
162       (setq gnus-undo-actions (list (list function)))))
163     ;; Limit the length of the undo list.
164     (let ((next (nthcdr gnus-undo-limit gnus-undo-actions)))
165       (when next
166         (setcdr next nil)))
167     ;; We are not at a boundary...
168     (setq gnus-undo-boundary-inhibit t)))
169
170 (defun gnus-undo (n)
171   "Undo some previous changes in Gnus buffers.
172 Repeat this command to undo more changes.
173 A numeric argument serves as a repeat count."
174   (interactive "p")
175   (unless gnus-undo-mode
176     (error "Undoing is not enabled in this buffer"))
177   (message "%s" last-command)
178   (when (or (not (eq last-command 'gnus-undo))
179             (not gnus-undo-last))
180     (setq gnus-undo-last gnus-undo-actions))
181   (let ((action (pop gnus-undo-last)))
182     (unless action
183       (error "Nothing further to undo"))
184     (setq gnus-undo-actions (delq action gnus-undo-actions))
185     (setq gnus-undo-boundary t)
186     (mapc 'funcall action)))
187
188 (provide 'gnus-undo)
189
190 ;;; gnus-undo.el ends here