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