(gnus-blocked-images): Clarify privacy implications
[emacs.git] / lisp / delsel.el
blobbfccdc6a4c79de8b28547a6538bcb0d8c8ffda29
1 ;;; delsel.el --- delete selection if you insert -*- lexical-binding:t -*-
3 ;; Copyright (C) 1992, 1997-1998, 2001-2018 Free Software Foundation,
4 ;; Inc.
6 ;; Author: Matthieu Devin <devin@lucid.com>
7 ;; Maintainer: emacs-devel@gnu.org
8 ;; Created: 14 Jul 92
9 ;; Keywords: convenience emulations
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
26 ;;; Commentary:
28 ;; This file makes the active region be pending delete, meaning that
29 ;; text inserted while the region is active will replace the region contents.
30 ;; This is a popular behavior of personal computers text editors.
32 ;; Interface:
34 ;; Commands which will delete the selection need a 'delete-selection
35 ;; property on their symbols; commands which insert text but don't
36 ;; have this property won't delete the selection. It can be one of
37 ;; the values:
38 ;; `yank'
39 ;; For commands which do a yank; ensures the region about to be
40 ;; deleted isn't immediately yanked back, which would make the
41 ;; command a no-op.
42 ;; `supersede'
43 ;; Delete the active region and ignore the current command,
44 ;; i.e. the command will just delete the region. This is for
45 ;; commands that normally delete small amounts of text, like
46 ;; a single character -- they will instead delete the whole
47 ;; active region.
48 ;; `kill'
49 ;; `kill-region' is used on the selection, rather than
50 ;; `delete-region'. (Text selected with the mouse will typically
51 ;; be yankable anyhow.)
52 ;; t
53 ;; The normal case: delete the active region prior to executing
54 ;; the command which will insert replacement text.
55 ;; FUNCTION
56 ;; For commands which need to dynamically determine this behavior.
57 ;; FUNCTION should take no argument and return one of the above
58 ;; values, or nil. In the latter case, FUNCTION should itself
59 ;; do with the active region whatever is appropriate."
61 ;;; Code:
63 (defvar delete-selection-save-to-register nil
64 "If non-nil, deleted region text is stored in this register.
65 Value must be the register (key) to use.")
67 ;;;###autoload
68 (defalias 'pending-delete-mode 'delete-selection-mode)
70 ;;;###autoload
71 (define-minor-mode delete-selection-mode
72 "Toggle Delete Selection mode.
73 Interactively, with a prefix argument, enable
74 Delete Selection mode if the prefix argument is positive,
75 and disable it otherwise. If called from Lisp, toggle
76 the mode if ARG is `toggle', disable the mode if ARG is
77 a non-positive integer, and enable the mode otherwise
78 \(including if ARG is omitted or nil or a positive integer).
80 When Delete Selection mode is enabled, typed text replaces the selection
81 if the selection is active. Otherwise, typed text is just inserted at
82 point regardless of any selection.
84 See `delete-selection-helper' and `delete-selection-pre-hook' for
85 information on adapting behavior of commands in Delete Selection mode."
86 :global t :group 'editing-basics
87 (if (not delete-selection-mode)
88 (remove-hook 'pre-command-hook 'delete-selection-pre-hook)
89 (add-hook 'pre-command-hook 'delete-selection-pre-hook)))
91 (defvar delsel--replace-text-or-position nil)
93 (defun delete-active-region (&optional killp)
94 "Delete the active region.
95 If KILLP in not-nil, the active region is killed instead of deleted."
96 (cond
97 (killp
98 ;; Don't allow `kill-region' to change the value of `this-command'.
99 (let (this-command)
100 (kill-region (point) (mark) t)))
101 (delete-selection-save-to-register
102 (set-register delete-selection-save-to-register
103 (funcall region-extract-function t))
104 (setq delsel--replace-text-or-position
105 (cons (current-buffer)
106 (and (consp buffer-undo-list) (car buffer-undo-list)))))
108 (funcall region-extract-function 'delete-only))))
110 (defun delete-selection-repeat-replace-region (arg)
111 "Repeat replacing text of highlighted region with typed text.
112 Search for the next stretch of text identical to the region last replaced
113 by typing text over it and replaces it with the same stretch of text.
114 With ARG, repeat that many times. `C-u' means until end of buffer."
115 (interactive "P")
116 (let ((old-text (and delete-selection-save-to-register
117 (get-register delete-selection-save-to-register)))
118 (count (if (consp arg) (point-max)
119 (prefix-numeric-value current-prefix-arg))))
120 (if (not (and old-text
121 (> (length old-text) 0)
122 (or (stringp delsel--replace-text-or-position)
123 (buffer-live-p (car delsel--replace-text-or-position)))))
124 (message "No known previous replacement")
125 ;; If this is the first use after overwriting regions,
126 ;; find the replacement text by looking at the undo list.
127 (when (consp delsel--replace-text-or-position)
128 (let ((buffer (car delsel--replace-text-or-position))
129 (elt (cdr delsel--replace-text-or-position)))
130 (setq delsel--replace-text-or-position nil)
131 (with-current-buffer buffer
132 (save-restriction
133 (widen)
134 ;; Find the text that replaced the region via the undo list.
135 (let ((ul buffer-undo-list) u s e)
136 (when elt
137 (while (consp ul)
138 (setq u (car ul) ul (cdr ul))
139 (cond
140 ((eq u elt) ;; got it
141 (setq ul nil))
142 ((and (consp u) (integerp (car u)) (integerp (cdr u)))
143 (if (and s (= (cdr u) s))
144 (setq s (car u))
145 (setq s (car u) e (cdr u)))))))
146 (cond ((and s e (<= s e) (= s (mark t)))
147 (setq delsel--replace-text-or-position
148 (filter-buffer-substring s e))
149 (set-text-properties
150 0 (length delsel--replace-text-or-position)
151 nil delsel--replace-text-or-position))
152 ((and (null s) (eq u elt)) ;; Nothing inserted.
153 (setq delsel--replace-text-or-position ""))
155 (message "Cannot locate replacement text"))))))))
156 (while (and (> count 0)
157 delsel--replace-text-or-position
158 (search-forward old-text nil t))
159 (replace-match delsel--replace-text-or-position nil t)
160 (setq count (1- count))))))
162 (defun delete-selection-helper (type)
163 "Delete selection according to TYPE:
164 `yank'
165 For commands which do a yank; ensures the region about to be
166 deleted isn't immediately yanked back, which would make the
167 command a no-op.
168 `supersede'
169 Delete the active region and ignore the current command,
170 i.e. the command will just delete the region. This is for
171 commands that normally delete small amounts of text, like
172 a single character -- they will instead delete the whole
173 active region.
174 `kill'
175 `kill-region' is used on the selection, rather than
176 `delete-region'. (Text selected with the mouse will
177 typically be yankable anyhow.)
178 FUNCTION
179 For commands which need to dynamically determine this
180 behavior. FUNCTION should take no argument and return a
181 value acceptable as TYPE, or nil. In the latter case,
182 FUNCTION should itself do with the active region whatever is
183 appropriate.
184 Other non-nil values
185 The normal case: delete the active region prior to executing
186 the command which will insert replacement text."
187 (condition-case data
188 (cond ((eq type 'kill) ;Deprecated, backward compatibility.
189 (delete-active-region t)
190 (if (and overwrite-mode
191 (eq this-command 'self-insert-command))
192 (let ((overwrite-mode nil))
193 (self-insert-command
194 (prefix-numeric-value current-prefix-arg))
195 (setq this-command 'ignore))))
196 ((eq type 'yank)
197 ;; Before a yank command, make sure we don't yank the
198 ;; head of the kill-ring that really comes from the
199 ;; currently active region we are going to delete.
200 ;; That would make yank a no-op.
201 (when (and (string= (buffer-substring-no-properties
202 (point) (mark))
203 (car kill-ring))
204 (fboundp 'mouse-region-match)
205 (mouse-region-match))
206 (current-kill 1))
207 (let ((pos (copy-marker (region-beginning))))
208 (delete-active-region)
209 ;; If the region was, say, rectangular, make sure we yank
210 ;; from the top, to "replace".
211 (goto-char pos)))
212 ((eq type 'supersede)
213 (let ((empty-region (= (point) (mark))))
214 (delete-active-region)
215 (unless empty-region
216 (setq this-command 'ignore))))
217 ((functionp type) (delete-selection-helper (funcall type)))
218 (type
219 (delete-active-region)
220 (if (and overwrite-mode
221 (eq this-command 'self-insert-command))
222 (let ((overwrite-mode nil))
223 (self-insert-command
224 (prefix-numeric-value current-prefix-arg))
225 (setq this-command 'ignore)))))
226 ;; If ask-user-about-supersession-threat signals an error,
227 ;; stop safe_run_hooks from clearing out pre-command-hook.
228 (file-supersession (message "%s" (cadr data)) (ding))
229 (text-read-only
230 ;; This signal may come either from `delete-active-region' or
231 ;; `self-insert-command' (when `overwrite-mode' is non-nil).
232 ;; To avoid clearing out `pre-command-hook' we handle this case
233 ;; by issuing a simple message. Note, however, that we do not
234 ;; handle all related problems: When read-only text ends before
235 ;; the end of the region, the latter is not deleted but any
236 ;; subsequent insertion will succeed. We could avoid this case
237 ;; by doing a (setq this-command 'ignore) here. This would,
238 ;; however, still not handle the case where read-only text ends
239 ;; precisely where the region starts: In that case the deletion
240 ;; would succeed but the subsequent insertion would fail with a
241 ;; text-read-only error. To handle that case we would have to
242 ;; investigate text properties at both ends of the region and
243 ;; skip the deletion when inserting text is forbidden there.
244 (message "Text is read-only") (ding))))
246 (defun delete-selection-pre-hook ()
247 "Function run before commands that delete selections are executed.
248 Commands which will delete the selection need a `delete-selection'
249 property on their symbol; commands which insert text but don't
250 have this property won't delete the selection.
251 See `delete-selection-helper'."
252 (when (and delete-selection-mode (use-region-p)
253 (not buffer-read-only))
254 (delete-selection-helper (and (symbolp this-command)
255 (get this-command 'delete-selection)))))
257 (defun delete-selection-uses-region-p ()
258 "Return t when `delete-selection-mode' should not delete the region.
260 The `self-insert-command' could be the current command or may be
261 called by the current command. If this function returns nil,
262 then `delete-selection' is allowed to delete the region.
264 This function is intended for use as the value of the
265 `delete-selection' property of a command, and shouldn't be used
266 for anything else. In particular, `self-insert-command' has this
267 function as its `delete-selection' property, so that \"electric\"
268 self-insert commands that act on the region could adapt themselves
269 to `delete-selection-mode'."
270 (not (run-hook-with-args-until-success
271 'self-insert-uses-region-functions)))
273 (put 'self-insert-command 'delete-selection 'delete-selection-uses-region-p)
275 (put 'insert-char 'delete-selection t)
276 (put 'quoted-insert 'delete-selection t)
278 (put 'yank 'delete-selection 'yank)
279 (put 'clipboard-yank 'delete-selection 'yank)
280 (put 'insert-register 'delete-selection t)
281 ;; delete-backward-char and delete-forward-char already delete the selection by
282 ;; default, but not delete-char.
283 (put 'delete-char 'delete-selection 'supersede)
285 (put 'reindent-then-newline-and-indent 'delete-selection t)
286 (put 'newline-and-indent 'delete-selection t)
287 (put 'newline 'delete-selection t)
288 (put 'electric-newline-and-maybe-indent 'delete-selection t)
289 (put 'open-line 'delete-selection t)
291 ;; This is very useful for canceling a selection in the minibuffer without
292 ;; aborting the minibuffer.
293 (defun minibuffer-keyboard-quit ()
294 "Abort recursive edit.
295 In Delete Selection mode, if the mark is active, just deactivate it;
296 then it takes a second \\[keyboard-quit] to abort the minibuffer."
297 (interactive)
298 (if (and delete-selection-mode (region-active-p))
299 (setq deactivate-mark t)
300 (abort-recursive-edit)))
302 (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit)
303 (define-key minibuffer-local-ns-map "\C-g" 'minibuffer-keyboard-quit)
304 (define-key minibuffer-local-completion-map "\C-g" 'minibuffer-keyboard-quit)
305 (define-key minibuffer-local-must-match-map "\C-g" 'minibuffer-keyboard-quit)
306 (define-key minibuffer-local-isearch-map "\C-g" 'minibuffer-keyboard-quit)
308 (defun delsel-unload-function ()
309 "Unload the Delete Selection library."
310 (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
311 (define-key minibuffer-local-ns-map "\C-g" 'abort-recursive-edit)
312 (define-key minibuffer-local-completion-map "\C-g" 'abort-recursive-edit)
313 (define-key minibuffer-local-must-match-map "\C-g" 'abort-recursive-edit)
314 (define-key minibuffer-local-isearch-map "\C-g" 'abort-recursive-edit)
315 (dolist (sym '(self-insert-command insert-char quoted-insert yank
316 clipboard-yank insert-register newline-and-indent
317 reindent-then-newline-and-indent newline open-line))
318 (put sym 'delete-selection nil))
319 ;; continue standard unloading
320 nil)
322 (provide 'delsel)
324 ;;; delsel.el ends here