delsel.el 14 KB
Newer Older
1
;;; delsel.el --- delete selection if you insert  -*- lexical-binding:t -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1992, 1997-1998, 2001-2017 Free Software Foundation,
4
;; Inc.
5 6

;; Author: Matthieu Devin <devin@lucid.com>
7
;; Maintainer: emacs-devel@gnu.org
8
;; Created: 14 Jul 92
Dave Love's avatar
Dave Love committed
9
;; Keywords: convenience emulations
Richard M. Stallman's avatar
Richard M. Stallman committed
10

Erik Naggum's avatar
Erik Naggum committed
11
;; This file is part of GNU Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
12

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Erik Naggum's avatar
Erik Naggum committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
17

Erik Naggum's avatar
Erik Naggum committed
18 19 20 21
;; 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
22

Erik Naggum's avatar
Erik Naggum committed
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/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
25

26
;;; Commentary:
Richard M. Stallman's avatar
Richard M. Stallman committed
27

Erik Naggum's avatar
Erik Naggum committed
28 29 30
;; This file makes the active region be pending delete, meaning that
;; text inserted while the region is active will replace the region contents.
;; This is a popular behavior of personal computers text editors.
Richard M. Stallman's avatar
Richard M. Stallman committed
31

Dave Love's avatar
Dave Love committed
32 33 34 35
;; Interface:

;; Commands which will delete the selection need a 'delete-selection
;; 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
Dave Love's avatar
Dave Love committed
37
;; the values:
38
;;  `yank'
Dave Love's avatar
Dave Love committed
39
;;      For commands which do a yank; ensures the region about to be
40 41
;;      deleted isn't immediately yanked back, which would make the
;;      command a no-op.
42
;;  `supersede'
Dave Love's avatar
Dave Love committed
43
;;      Delete the active region and ignore the current command,
44 45 46 47 48 49 50 51
;;      i.e. the command will just delete the region.  This is for
;;      commands that normally delete small amounts of text, like
;;      a single character -- they will instead delete the whole
;;      active region.
;;  `kill'
;;      `kill-region' is used on the selection, rather than
;;      `delete-region'.  (Text selected with the mouse will typically
;;      be yankable anyhow.)
52
;;  t
Dave Love's avatar
Dave Love committed
53 54
;;      The normal case: delete the active region prior to executing
;;      the command which will insert replacement text.
55
;;  FUNCTION
Paul Eggert's avatar
Paul Eggert committed
56
;;      For commands which need to dynamically determine this behavior.
57 58 59
;;      FUNCTION should take no argument and return one of the above
;;      values, or nil.  In the latter case, FUNCTION should itself
;;      do with the active region whatever is appropriate."
60

Dave Love's avatar
Dave Love committed
61
;;; Code:
62

63 64 65 66
(defvar delete-selection-save-to-register nil
  "If non-nil, deleted region text is stored in this register.
Value must be the register (key) to use.")

67 68 69 70
;;;###autoload
(defalias 'pending-delete-mode 'delete-selection-mode)

;;;###autoload
71
(define-minor-mode delete-selection-mode
72
  "Toggle Delete Selection mode.
73 74 75 76 77 78
Interactively, with a prefix argument, enable
Delete Selection mode if the prefix argument is positive,
and disable it otherwise.  If called from Lisp, toggle
the mode if ARG is `toggle', disable the mode if ARG is
a non-positive integer, and enable the mode otherwise
\(including if ARG is omitted or nil or a positive integer).
79

80 81
When Delete Selection mode is enabled, typed text replaces the selection
if the selection is active.  Otherwise, typed text is just inserted at
82
point regardless of any selection.
83 84 85

See `delete-selection-helper' and `delete-selection-pre-hook' for
information on adapting behavior of commands in Delete Selection mode."
86
  :global t :group 'editing-basics
87 88
  (if (not delete-selection-mode)
      (remove-hook 'pre-command-hook 'delete-selection-pre-hook)
89
    (add-hook 'pre-command-hook 'delete-selection-pre-hook)))
90

91 92
(defvar delsel--replace-text-or-position nil)

Richard M. Stallman's avatar
Richard M. Stallman committed
93
(defun delete-active-region (&optional killp)
94 95
  "Delete the active region.
If KILLP in not-nil, the active region is killed instead of deleted."
96 97 98 99 100 101 102 103 104 105 106 107
  (cond
   (killp
    ;; Don't allow `kill-region' to change the value of `this-command'.
    (let (this-command)
      (kill-region (point) (mark) t)))
   (delete-selection-save-to-register
    (set-register delete-selection-save-to-register
                  (funcall region-extract-function t))
    (setq delsel--replace-text-or-position
          (cons (current-buffer)
                (and (consp buffer-undo-list) (car buffer-undo-list)))))
   (t
108
    (funcall region-extract-function 'delete-only))))
Richard M. Stallman's avatar
Richard M. Stallman committed
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
(defun delete-selection-repeat-replace-region (arg)
  "Repeat replacing text of highlighted region with typed text.
Search for the next stretch of text identical to the region last replaced
by typing text over it and replaces it with the same stretch of text.
With ARG, repeat that many times.  `C-u' means until end of buffer."
  (interactive "P")
  (let ((old-text (and delete-selection-save-to-register
                       (get-register delete-selection-save-to-register)))
        (count (if (consp arg) (point-max)
                 (prefix-numeric-value current-prefix-arg))))
    (if (not (and old-text
                  (> (length old-text) 0)
                  (or (stringp delsel--replace-text-or-position)
                      (buffer-live-p (car delsel--replace-text-or-position)))))
        (message "No known previous replacement")
      ;; If this is the first use after overwriting regions,
      ;; find the replacement text by looking at the undo list.
      (when (consp delsel--replace-text-or-position)
        (let ((buffer (car delsel--replace-text-or-position))
              (elt (cdr delsel--replace-text-or-position)))
          (setq delsel--replace-text-or-position nil)
          (with-current-buffer buffer
            (save-restriction
              (widen)
              ;; Find the text that replaced the region via the undo list.
              (let ((ul buffer-undo-list) u s e)
                (when elt
                  (while (consp ul)
                    (setq u (car ul) ul (cdr ul))
                    (cond
                     ((eq u elt) ;; got it
                      (setq ul nil))
                     ((and (consp u) (integerp (car u)) (integerp (cdr u)))
                      (if (and s (= (cdr u) s))
                          (setq s (car u))
                        (setq s (car u) e (cdr u)))))))
                (cond ((and s e (<= s e) (= s (mark t)))
                       (setq delsel--replace-text-or-position
                             (filter-buffer-substring s e))
                       (set-text-properties
                        0 (length delsel--replace-text-or-position)
                        nil delsel--replace-text-or-position))
                      ((and (null s) (eq u elt)) ;; Nothing inserted.
                       (setq delsel--replace-text-or-position ""))
                      (t
                       (message "Cannot locate replacement text"))))))))
      (while (and (> count 0)
                  delsel--replace-text-or-position
                  (search-forward old-text nil t))
        (replace-match delsel--replace-text-or-position nil t)
        (setq count (1- count))))))

162
(defun delete-selection-helper (type)
163 164
  "Delete selection according to TYPE:
 `yank'
165
     For commands which do a yank; ensures the region about to be
166 167
     deleted isn't immediately yanked back, which would make the
     command a no-op.
168
 `supersede'
169
     Delete the active region and ignore the current command,
170 171 172 173
     i.e. the command will just delete the region.  This is for
     commands that normally delete small amounts of text, like
     a single character -- they will instead delete the whole
     active region.
174
 `kill'
175
     `kill-region' is used on the selection, rather than
Lars Ingebrigtsen's avatar
Lars Ingebrigtsen committed
176 177
     `delete-region'.  (Text selected with the mouse will
     typically be yankable anyhow.)
178
 FUNCTION
Lars Ingebrigtsen's avatar
Lars Ingebrigtsen committed
179 180 181 182 183 184 185 186
     For commands which need to dynamically determine this
     behavior.  FUNCTION should take no argument and return a
     value acceptable as TYPE, or nil.  In the latter case,
     FUNCTION should itself do with the active region whatever is
     appropriate.
 Other non-nil values
     The normal case: delete the active region prior to executing
     the command which will insert replacement text."
187
  (condition-case data
188
      (cond ((eq type 'kill)            ;Deprecated, backward compatibility.
189 190 191 192 193 194 195
	     (delete-active-region t)
	     (if (and overwrite-mode
		      (eq this-command 'self-insert-command))
		 (let ((overwrite-mode nil))
		   (self-insert-command
		    (prefix-numeric-value current-prefix-arg))
		   (setq this-command 'ignore))))
196 197 198 199 200 201 202 203 204 205 206
	    ((eq type 'yank)
	     ;; Before a yank command, make sure we don't yank the
	     ;; head of the kill-ring that really comes from the
	     ;; currently active region we are going to delete.
	     ;; That would make yank a no-op.
	     (when (and (string= (buffer-substring-no-properties
				  (point) (mark))
				 (car kill-ring))
			(fboundp 'mouse-region-match)
			(mouse-region-match))
	       (current-kill 1))
207 208 209 210 211
             (let ((pos (copy-marker (region-beginning))))
               (delete-active-region)
               ;; If the region was, say, rectangular, make sure we yank
               ;; from the top, to "replace".
               (goto-char pos)))
212 213 214 215 216
	    ((eq type 'supersede)
	     (let ((empty-region (= (point) (mark))))
	       (delete-active-region)
	       (unless empty-region
		 (setq this-command 'ignore))))
217
	    ((functionp type) (delete-selection-helper (funcall type)))
218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
	    (type
	     (delete-active-region)
	     (if (and overwrite-mode
		      (eq this-command 'self-insert-command))
		 (let ((overwrite-mode nil))
		   (self-insert-command
		    (prefix-numeric-value current-prefix-arg))
		   (setq this-command 'ignore)))))
    ;; If ask-user-about-supersession-threat signals an error,
    ;; stop safe_run_hooks from clearing out pre-command-hook.
    (file-supersession (message "%s" (cadr data)) (ding))
    (text-read-only
     ;; This signal may come either from `delete-active-region' or
     ;; `self-insert-command' (when `overwrite-mode' is non-nil).
     ;; To avoid clearing out `pre-command-hook' we handle this case
     ;; by issuing a simple message.  Note, however, that we do not
     ;; handle all related problems: When read-only text ends before
     ;; the end of the region, the latter is not deleted but any
     ;; subsequent insertion will succeed.  We could avoid this case
     ;; by doing a (setq this-command 'ignore) here.  This would,
     ;; however, still not handle the case where read-only text ends
     ;; precisely where the region starts: In that case the deletion
     ;; would succeed but the subsequent insertion would fail with a
     ;; text-read-only error.  To handle that case we would have to
     ;; investigate text properties at both ends of the region and
     ;; skip the deletion when inserting text is forbidden there.
     (message "Text is read-only") (ding))))

246
(defun delete-selection-pre-hook ()
247 248 249
  "Function run before commands that delete selections are executed.
Commands which will delete the selection need a `delete-selection'
property on their symbol; commands which insert text but don't
250
have this property won't delete the selection.
251 252
See `delete-selection-helper'."
  (when (and delete-selection-mode (use-region-p)
253
	     (not buffer-read-only))
254 255
    (delete-selection-helper (and (symbolp this-command)
                                  (get this-command 'delete-selection)))))
256

257
(defun delete-selection-uses-region-p ()
258 259 260 261 262
  "Return t when `delete-selection-mode' should not delete the region.

The `self-insert-command' could be the current command or may be
called by the current command.  If this function returns nil,
then `delete-selection' is allowed to delete the region.
263 264 265

This function is intended for use as the value of the
`delete-selection' property of a command, and shouldn't be used
266 267 268 269
for anything else.  In particular, `self-insert-command' has this
function as its `delete-selection' property, so that \"electric\"
self-insert commands that act on the region could adapt themselves
to `delete-selection-mode'."
270 271 272 273
  (not (run-hook-with-args-until-success
        'self-insert-uses-region-functions)))

(put 'self-insert-command 'delete-selection 'delete-selection-uses-region-p)
274

275 276 277
(put 'insert-char 'delete-selection t)
(put 'quoted-insert 'delete-selection t)

278
(put 'yank 'delete-selection 'yank)
279
(put 'clipboard-yank 'delete-selection 'yank)
Richard M. Stallman's avatar
Richard M. Stallman committed
280
(put 'insert-register 'delete-selection t)
281 282 283
;; delete-backward-char and delete-forward-char already delete the selection by
;; default, but not delete-char.
(put 'delete-char 'delete-selection 'supersede)
Richard M. Stallman's avatar
Richard M. Stallman committed
284

285
(put 'reindent-then-newline-and-indent 'delete-selection t)
Dave Love's avatar
Dave Love committed
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)
Dave Love's avatar
Dave Love committed
290

Paul Eggert's avatar
Paul Eggert committed
291
;; This is very useful for canceling a selection in the minibuffer without
Richard M. Stallman's avatar
Richard M. Stallman committed
292 293 294
;; aborting the minibuffer.
(defun minibuffer-keyboard-quit ()
  "Abort recursive edit.
Dave Love's avatar
Dave Love committed
295 296
In Delete Selection mode, if the mark is active, just deactivate it;
then it takes a second \\[keyboard-quit] to abort the minibuffer."
Richard M. Stallman's avatar
Richard M. Stallman committed
297
  (interactive)
298
  (if (and delete-selection-mode (region-active-p))
Richard M. Stallman's avatar
Richard M. Stallman committed
299
      (setq deactivate-mark t)
Richard M. Stallman's avatar
Richard M. Stallman committed
300 301
    (abort-recursive-edit)))

302 303 304 305 306 307
(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit)
(define-key minibuffer-local-ns-map "\C-g" 'minibuffer-keyboard-quit)
(define-key minibuffer-local-completion-map "\C-g" 'minibuffer-keyboard-quit)
(define-key minibuffer-local-must-match-map "\C-g" 'minibuffer-keyboard-quit)
(define-key minibuffer-local-isearch-map "\C-g" 'minibuffer-keyboard-quit)

308 309
(defun delsel-unload-function ()
  "Unload the Delete Selection library."
310 311 312 313
  (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
  (define-key minibuffer-local-ns-map "\C-g" 'abort-recursive-edit)
  (define-key minibuffer-local-completion-map "\C-g" 'abort-recursive-edit)
  (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 316 317
  (dolist (sym '(self-insert-command insert-char quoted-insert yank
                 clipboard-yank insert-register newline-and-indent
                 reindent-then-newline-and-indent newline open-line))
318
    (put sym 'delete-selection nil))
319 320
  ;; continue standard unloading
  nil)
321

Richard M. Stallman's avatar
Richard M. Stallman committed
322
(provide 'delsel)
Richard M. Stallman's avatar
Richard M. Stallman committed
323

Richard M. Stallman's avatar
Richard M. Stallman committed
324
;;; delsel.el ends here