diff options
| author | Richard M. Stallman | 1993-03-09 05:27:35 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1993-03-09 05:27:35 +0000 |
| commit | b0dbaa217bd8f5c183dc22fbf25a31911e3e5b25 (patch) | |
| tree | 8ab67dd230455e65e70a9ddf24dda2708538a20b | |
| parent | e31b61e6147b2054f4bb4935874e87ee324345b7 (diff) | |
| download | emacs-b0dbaa217bd8f5c183dc22fbf25a31911e3e5b25.tar.gz emacs-b0dbaa217bd8f5c183dc22fbf25a31911e3e5b25.zip | |
Initial revision
| -rw-r--r-- | lisp/delsel.el | 118 |
1 files changed, 118 insertions, 0 deletions
diff --git a/lisp/delsel.el b/lisp/delsel.el new file mode 100644 index 00000000000..3ae1f295236 --- /dev/null +++ b/lisp/delsel.el | |||
| @@ -0,0 +1,118 @@ | |||
| 1 | ;;; Pending delete selection | ||
| 2 | ;;; Copyright (C) 1992 Free Software Foundation, Inc. | ||
| 3 | ;;; Created: 14 Jul 92, Matthieu Devin <devin@lucid.com> | ||
| 4 | ;;; Last change 18-Feb-93, devin. | ||
| 5 | |||
| 6 | ;;; This file is part of GNU Emacs. | ||
| 7 | |||
| 8 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 9 | ;;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;;; the Free Software Foundation; either version 2, or (at your option) | ||
| 11 | ;;; any later version. | ||
| 12 | |||
| 13 | ;;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 14 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;;; You should have received a copy of the GNU General Public License | ||
| 19 | ;;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 20 | ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 21 | |||
| 22 | |||
| 23 | ;;; This files makes the active region be pending delete, meaning that | ||
| 24 | ;;; text inserted while the region is active will replace the region contents. | ||
| 25 | ;;; This is a popular behavior of personal computers text editors. | ||
| 26 | |||
| 27 | (defun delete-active-region (&optional killp) | ||
| 28 | (if (and (not buffer-read-only) | ||
| 29 | (extentp primary-selection-extent) | ||
| 30 | (eq (current-buffer) (extent-buffer primary-selection-extent)) | ||
| 31 | (< 0 (extent-start-position primary-selection-extent)) | ||
| 32 | (< 0 (extent-end-position primary-selection-extent))) | ||
| 33 | (progn | ||
| 34 | (if killp | ||
| 35 | (kill-region (extent-start-position primary-selection-extent) | ||
| 36 | (extent-end-position primary-selection-extent)) | ||
| 37 | (delete-region (extent-start-position primary-selection-extent) | ||
| 38 | (extent-end-position primary-selection-extent))) | ||
| 39 | (zmacs-deactivate-region) | ||
| 40 | t))) | ||
| 41 | |||
| 42 | (defun pending-delete-pre-hook () | ||
| 43 | (let ((type (and (symbolp this-command) | ||
| 44 | (get this-command 'pending-delete)))) | ||
| 45 | (cond ((eq type 'kill) | ||
| 46 | (delete-active-region t)) | ||
| 47 | ((eq type 'supersede) | ||
| 48 | (if (delete-active-region ()) | ||
| 49 | (setq this-command '(lambda () (interactive))))) | ||
| 50 | (type | ||
| 51 | (delete-active-region ()))))) | ||
| 52 | |||
| 53 | (put 'self-insert-command 'pending-delete t) | ||
| 54 | |||
| 55 | (put 'yank 'pending-delete t) | ||
| 56 | (put 'x-yank-clipboard-selection 'pending-delete t) | ||
| 57 | |||
| 58 | (put 'delete-backward-char 'pending-delete 'supersede) | ||
| 59 | (put 'backward-delete-char-untabify 'pending-delete 'supersede) | ||
| 60 | (put 'delete-char 'pending-delete 'supersede) | ||
| 61 | |||
| 62 | (put 'newline-and-indent 'pending-delete 't) | ||
| 63 | (put 'newline 'pending-delete t) | ||
| 64 | (put 'open-line 'pending-delete t) | ||
| 65 | |||
| 66 | (defun pending-delete-mode () | ||
| 67 | "Toggle the state of pending-delete mode. | ||
| 68 | When ON, typed text replaces the selection if the selection is active. | ||
| 69 | When OFF, typed text is just inserted at point." | ||
| 70 | (interactive) | ||
| 71 | (if (memq 'pending-delete-pre-hook pre-command-hook) | ||
| 72 | (progn | ||
| 73 | (remove-hook 'pre-command-hook 'pending-delete-pre-hook) | ||
| 74 | (message "pending delete is OFF")) | ||
| 75 | (progn | ||
| 76 | (add-hook 'pre-command-hook 'pending-delete-pre-hook) | ||
| 77 | (message | ||
| 78 | "Pending delete is ON, use M-x pending-delete to turn it OFF")))) | ||
| 79 | |||
| 80 | (pending-delete-mode) | ||
| 81 | |||
| 82 | ;; This new definition of control-G makes the first control-G disown the | ||
| 83 | ;; selection and the second one signal a QUIT. | ||
| 84 | ;; This is very useful for cancelling a selection in the minibuffer without | ||
| 85 | ;; aborting the minibuffer. | ||
| 86 | ;; It has actually nothing to do with pending-delete but its more necessary | ||
| 87 | ;; with pending delete because pending delete users use the selection more. | ||
| 88 | (defun keyboard-quit () | ||
| 89 | "Signal a `quit' condition. | ||
| 90 | If this character is typed while lisp code is executing, it will be treated | ||
| 91 | as an interrupt. | ||
| 92 | If this character is typed at top-level, this simply beeps. | ||
| 93 | |||
| 94 | In Transient Mark mode, if the mark is active, just deactivate it." | ||
| 95 | (interactive) | ||
| 96 | (if (and transient-mark-mode mark-active) | ||
| 97 | (progn | ||
| 98 | ;; Don't beep if just deactivating the region. | ||
| 99 | (setq mark-active nil) | ||
| 100 | (run-hooks 'deactivate-mark-hook)) | ||
| 101 | (signal 'quit nil))) | ||
| 102 | |||
| 103 | (defun minibuffer-keyboard-quit () | ||
| 104 | "Abort recursive edit. | ||
| 105 | In Transient Mark mode, if the mark is active, just deactivate it." | ||
| 106 | (interactive) | ||
| 107 | (if (and transient-mark-mode mark-active) | ||
| 108 | (progn | ||
| 109 | ;; Don't beep if just deactivating the region. | ||
| 110 | (setq mark-active nil) | ||
| 111 | (run-hooks 'deactivate-mark-hook)) | ||
| 112 | (abort-recursive-edit))) | ||
| 113 | |||
| 114 | (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) | ||
| 115 | |||
| 116 | (provide 'pending-del) | ||
| 117 | |||
| 118 | ;; End of pending-del.el. | ||