Mercurial > hg > xemacs-beta

comparison lisp/packages/pending-del.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;; pending-del.el --- Making insertions replace any selected text.
2
3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
4
5 ;; Author: Matthieu Devin <devin@lucid.com>, 14 Jul 92.
6
7 ;; This file is part of XEmacs.
8
9 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23 ;;; Synched up with: Not in FSF.
24
25 ;;; Code:
26
27 (defvar pending-delete-verbose
28 1
29 "*nil disables on/off messages for pending-del mode
30 1 suppresses messages on loading
31 t enables all messages")
32
33 (defun delete-active-region (&optional killp)
34 (if (and (not buffer-read-only)
35 (extentp zmacs-region-extent)
36 (eq (current-buffer) (extent-buffer zmacs-region-extent))
37 (extent-start-position zmacs-region-extent)
38 (<= (extent-start-position zmacs-region-extent) (point))
39 (<= (point) (extent-end-position zmacs-region-extent)))
40 (progn
41 (if killp
42 (kill-region (extent-start-position zmacs-region-extent)
43 (extent-end-position zmacs-region-extent))
44 (delete-region (extent-start-position zmacs-region-extent)
45 (extent-end-position zmacs-region-extent)))
46 (zmacs-deactivate-region)
47 t)))
48
49 (defun pending-delete-pre-hook ()
50 (let ((type (and (symbolp this-command)
51 (get this-command 'pending-delete))))
52 (cond ((eq type 'kill)
53 (delete-active-region t))
54 ((eq type 'supersede)
55 (if (delete-active-region ())
56 (setq this-command '(lambda () (interactive)))))
57 (type
58 (delete-active-region ())))))
59
60 (put 'self-insert-command 'pending-delete t)
61
62 (put 'yank 'pending-delete t)
63 (put 'x-yank-clipboard-selection 'pending-delete t)
64
65 (put 'delete-backward-char 'pending-delete 'supersede)
66 (put 'backward-delete-char-untabify 'pending-delete 'supersede)
67 (put 'delete-char 'pending-delete 'supersede)
68 (put 'c-electric-delete 'pending-delete 'supersede)
69
70 ;; Don't delete for these. They're more problematic than helpful.
71 ;;
72 ;; (put 'newline-and-indent 'pending-delete t)
73 ;; (put 'newline 'pending-delete t)
74 ;; (put 'open-line 'pending-delete t)
75
76 (put 'insert-register 'pending-delete t)
77
78 ;;;###autoload
79 (defun pending-delete-on (verbose)
80 "Turn on pending delete.
81 When it is ON, typed text replaces the selection if the selection is active.
82 When it is OFF, typed text is just inserted at point."
83 (interactive "P")
84 (add-hook 'pre-command-hook 'pending-delete-pre-hook)
85 (and verbose
86 (message "Pending delete is ON, use M-x pending-delete to turn it OFF")))
87
88 ;;;###autoload
89 (defun pending-delete-off (verbose)
90 "Turn off pending delete.
91 When it is ON, typed text replaces the selection if the selection is active.
92 When it is OFF, typed text is just inserted at point."
93 (interactive "P")
94 (remove-hook 'pre-command-hook 'pending-delete-pre-hook)
95 (and verbose (message "pending delete is OFF")))
96
97 ;;;###autoload
98 (defun pending-delete (&optional arg)
99 "Toggle automatic deletion of the selected region.
100 With a positive argument, turns it on.
101 With a non-positive argument, turns it off.
102 When active, typed text replaces the selection."
103 (interactive "P")
104 (let* ((was-on (not (not (memq 'pending-delete-pre-hook pre-command-hook))))
105 (on-p (if (null arg)
106 (not was-on)
107 (> (prefix-numeric-value arg) 0))))
108 (cond ((eq on-p was-on)
109 nil)
110 (on-p
111 (pending-delete-on pending-delete-verbose))
112 (t
113 (pending-delete-off pending-delete-verbose)))))
114
115 ;; Add pending-del mode. Assume that if we load it then we obviously wanted
116 ;; it on, even if it is already on.
117 (pending-delete-on (eq pending-delete-verbose t))
118
119 (provide 'pending-del)
120
121 ;;; pending-del.el ends here