Mercurial > hg > xemacs-beta

comparison lisp/packages/pending-del.el @ 173:8eaf7971accc r20-3b13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 28f395d8dc7a
children 2d532a89d707
comparison
equal deleted inserted replaced
172:a38aed19690b 173:8eaf7971accc
1 ;; pending-del.el --- Making insertions replace any selected text. 1 ;; pending-del.el --- Making insertions replace any selected text.
2 2
3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
4 4
5 ;; Author: Matthieu Devin <devin@lucid.com>, 14 Jul 92. 5 ;; Author: Matthieu Devin <devin@lucid.com>, 14 Jul 92.
6 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
7 ;; Version 2.1
6 8
7 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
8 10
9 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; 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 12 ;; under the terms of the GNU General Public License as published by
19 ;; You should have received a copy of the GNU General Public License 21 ;; 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 22 ;; along with XEmacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
23 25
24 ;;; Synched up with: Not in FSF. 26 ;;; Synched up with: 19.34 (distributed as delsel.el in FSF)
25 27
28 ;;; Commentary:
29
30 ;; Much of this code was revamped by Hrvoje Niksic, July 1997, with
31 ;; version number set to 2.x.
32
33 ;; Pending-del is now a minor mode, with all the normal toggle
34 ;; functions. It should be somewhat faster, too.
35
36
26 ;;; Code: 37 ;;; Code:
27 38
28 (defvar pending-delete-verbose 39 (defvar pending-delete-mode nil
29 1 40 "Non-nil when Pending Delete mode is enabled.
30 "*nil disables on/off messages for pending-del mode 41 In Pending Delete mode, typed text replaces the selected region.")
31 1 suppresses messages on loading
32 t enables all messages")
33 42
34 (defun delete-active-region (&optional killp) 43 (add-minor-mode 'pending-delete-mode " PenDel")
35 (if (and (not buffer-read-only) 44
36 (extentp zmacs-region-extent) 45
37 (eq (current-buffer) (extent-buffer zmacs-region-extent)) 46 (defun pending-delete-active-region (&optional killp)
38 (extent-start-position zmacs-region-extent) 47 (when (and (region-active-p)
39 (<= (extent-start-position zmacs-region-extent) (point)) 48 (eq (extent-object zmacs-region-extent) (current-buffer))
40 (<= (point) (extent-end-position zmacs-region-extent))) 49 (not buffer-read-only))
41 (progn 50 ;; Here we used to check whether the point lies between the
42 (if killp 51 ;; beginning and end of the extent. I don't see how it is
43 (kill-region (extent-start-position zmacs-region-extent) 52 ;; necessary, as the C code makes sure that this is so; it only
44 (extent-end-position zmacs-region-extent)) 53 ;; slow things down.
45 (delete-region (extent-start-position zmacs-region-extent) 54 (if killp
46 (extent-end-position zmacs-region-extent))) 55 (kill-region (region-beginning) (region-end))
47 (zmacs-deactivate-region) 56 (delete-region (region-beginning) (region-end)))
48 t))) 57 (zmacs-deactivate-region)
58 t))
49 59
50 (defun pending-delete-pre-hook () 60 (defun pending-delete-pre-hook ()
51 ;; don't ever signal an error in pre-command-hook!
52 (condition-case e 61 (condition-case e
53 (let ((type (and (symbolp this-command) 62 (let ((type (and (symbolp this-command)
54 (get this-command 'pending-delete)))) 63 (get this-command 'pending-delete))))
55 (cond ((eq type 'kill) 64 (cond ((eq type 'kill)
56 (delete-active-region t)) 65 (pending-delete-active-region t))
57 ((eq type 'supersede) 66 ((eq type 'supersede)
58 (if (delete-active-region ()) 67 (if (pending-delete-active-region ())
59 (setq this-command '(lambda () (interactive))))) 68 (setq this-command (lambda () (interactive)))))
60 (type 69 (type
61 (delete-active-region ())))) 70 (pending-delete-active-region ()))))
62 (error 71 (error
63 (warn "Error caught in `pending-delete-pre-hook': %s" e)))) 72 (warn "Error caught in `pending-delete-pre-hook': %s"
73 (error-message-string e)))))
64 74
75
65 (put 'self-insert-command 'pending-delete t) 76 (put 'self-insert-command 'pending-delete t)
66 77
67 (put 'yank 'pending-delete t) 78 (put 'yank 'pending-delete t)
68 (put 'x-yank-clipboard-selection 'pending-delete t) 79 (put 'x-yank-clipboard-selection 'pending-delete t)
80 (put 'toolbar-paste 'pending-delete t)
69 81
70 (put 'delete-backward-char 'pending-delete 'supersede) 82 (put 'delete-backward-char 'pending-delete 'supersede)
71 (put 'backward-delete-char-untabify 'pending-delete 'supersede) 83 (put 'backward-delete-char-untabify 'pending-delete 'supersede)
72 (put 'delete-char 'pending-delete 'supersede) 84 (put 'delete-char 'pending-delete 'supersede)
73 (put 'c-electric-delete 'pending-delete 'supersede) 85 (put 'c-electric-delete 'pending-delete 'supersede)
84 ;; (put 'newline 'pending-delete t) 96 ;; (put 'newline 'pending-delete t)
85 ;; (put 'open-line 'pending-delete t) 97 ;; (put 'open-line 'pending-delete t)
86 98
87 (put 'insert-register 'pending-delete t) 99 (put 'insert-register 'pending-delete t)
88 100
101
89 ;;;###autoload 102 ;;;###autoload
90 (defun pending-delete-on (verbose) 103 (defun turn-on-pending-delete (&optional ignored)
91 "Turn on pending delete. 104 "Turn on pending delete minor mode unconditionally."
92 When it is ON, typed text replaces the selection if the selection is active. 105 (interactive)
93 When it is OFF, typed text is just inserted at point." 106 (pending-delete-mode 1))
94 (interactive "P")
95 (add-hook 'pre-command-hook 'pending-delete-pre-hook)
96 (and verbose
97 (message "Pending delete is ON, use M-x pending-delete to turn it OFF")))
98 107
99 ;;;###autoload 108 ;;;###autoload
100 (defun pending-delete-off (verbose) 109 (defun turn-off-pending-delete (&optional ignored)
101 "Turn off pending delete. 110 "Turn off pending delete minor mode unconditionally."
102 When it is ON, typed text replaces the selection if the selection is active. 111 (interactive)
103 When it is OFF, typed text is just inserted at point." 112 (pending-delete-mode 0))
104 (interactive "P")
105 (remove-hook 'pre-command-hook 'pending-delete-pre-hook)
106 (and verbose (message "pending delete is OFF")))
107 113
108 ;;;###autoload 114 ;;;###autoload
109 (defun pending-delete (&optional arg) 115 (defun pending-delete-mode (&optional arg)
110 "Toggle automatic deletion of the selected region. 116 "Toggle Pending Delete minor mode.
117 When the pending delete is on, typed text replaces the selection.
111 With a positive argument, turns it on. 118 With a positive argument, turns it on.
112 With a non-positive argument, turns it off. 119 With a non-positive argument, turns it off."
113 When active, typed text replaces the selection."
114 (interactive "P") 120 (interactive "P")
115 (let* ((was-on (not (not (memq 'pending-delete-pre-hook pre-command-hook)))) 121 (setq pending-delete-mode
116 (on-p (if (null arg) 122 (if (null arg) (not pending-delete-mode)
117 (not was-on) 123 (> (prefix-numeric-value arg) 0)))
118 (> (prefix-numeric-value arg) 0)))) 124 (if pending-delete-mode
119 (cond ((eq on-p was-on) 125 (add-hook 'pre-command-hook 'pending-delete-pre-hook)
120 nil) 126 (remove-hook 'pre-command-hook 'pending-delete-pre-hook))
121 (on-p 127 (force-mode-line-update))
122 (pending-delete-on pending-delete-verbose)) 128
123 (t 129
124 (pending-delete-off pending-delete-verbose))))) 130 ;; Backward compatibility:
125 131 ;;;###autoload
126 ;; Add pending-del mode. Assume that if we load it then we obviously wanted 132 (define-obsolete-function-alias 'pending-delete-on 'turn-on-pending-delete)
127 ;; it on, even if it is already on. 133 ;;;###autoload
128 (pending-delete-on (eq pending-delete-verbose t)) 134 (define-obsolete-function-alias 'pending-delete-off 'turn-off-pending-delete)
135
136 ;; FSF compatibility:
137 ;;;###autoload
138 (define-compatible-function-alias 'delete-selection-mode 'pending-delete-mode)
139
140 ;; Compatibility and convenience:
141 ;;;###autoload
142 (defalias 'pending-delete 'pending-delete-mode)
143
144
145 ;; The following code used to turn the mode on unconditionally.
146 ;; However, this is a very bad idea -- since pending-del is
147 ;; autoloaded, (turn-on-pending-delete) is as easy to add to `.emacs'
148 ;; as (require 'pending-del) used to be.
149
150 ;(pending-delete-on (eq pending-delete-verbose t))
129 151
130 (provide 'pending-del) 152 (provide 'pending-del)
131 153
132 ;;; pending-del.el ends here 154 ;;; pending-del.el ends here