unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 64ed2bbad6b7a8f7c9cac5585760c970c4db6a46 5711 bytes (raw)
name: lisp/gnus/gnus-undo.el 	 # note: path name is non-authoritative(*)

  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
 
;;; gnus-undo.el --- minor mode for undoing in Gnus  -*- lexical-binding: t; -*-

;; Copyright (C) 1996-2021 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 of the License, 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.  If not, see <https://www.gnu.org/licenses/>.

;;; 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:

(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)

(defcustom gnus-undo-mode nil
  ;; FIXME: This is a buffer-local minor mode which requires running
  ;; code upon activation/deactivation, so defining it as a defcustom
  ;; doesn't seem very useful: setting it to non-nil via Customize
  ;; probably won't do the right thing.
  "Minor mode for undoing in Gnus buffers."
  :type 'boolean)

(defcustom gnus-undo-mode-hook nil
  "Hook called in all `gnus-undo-mode' buffers."
  :type 'hook)

;;; 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
  (let ((map (make-sparse-keymap)))
    (gnus-define-keys 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)
    map))

(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])))

(define-minor-mode gnus-undo-mode
  "Minor mode for providing `undo' in Gnus buffers.

\\{gnus-undo-mode-map}"
  :keymap gnus-undo-mode-map
  (setq-local gnus-undo-actions nil)
  (setq-local 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-hook 'post-command-hook #'gnus-undo-boundary nil t)))

;;; 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."
  (when gnus-undo-mode
    (gnus-undo-register-1
     `(lambda () ,form))))

(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."
  ;; FIXME: A numeric argument should serve as a repeat count.
  (interactive "p")
  (unless gnus-undo-mode
    (error "Undoing is not enabled in this buffer"))
  (message "%s" last-command)
  (unless (and (eq last-command 'gnus-undo)
               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)

;;; gnus-undo.el ends here

debug log:

solving 64ed2bbad6 ...
found 64ed2bbad6 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).