Mercurial > hg > xemacs-beta
diff lisp/packages/pending-del.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 0293115a14e9 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/packages/pending-del.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,121 @@ +;; pending-del.el --- Making insertions replace any selected text. + +;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. + +;; Author: Matthieu Devin <devin@lucid.com>, 14 Jul 92. + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs 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. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Synched up with: Not in FSF. + +;;; Code: + +(defvar pending-delete-verbose + 1 + "*nil disables on/off messages for pending-del mode +1 suppresses messages on loading +t enables all messages") + +(defun delete-active-region (&optional killp) + (if (and (not buffer-read-only) + (extentp zmacs-region-extent) + (eq (current-buffer) (extent-buffer zmacs-region-extent)) + (extent-start-position zmacs-region-extent) + (<= (extent-start-position zmacs-region-extent) (point)) + (<= (point) (extent-end-position zmacs-region-extent))) + (progn + (if killp + (kill-region (extent-start-position zmacs-region-extent) + (extent-end-position zmacs-region-extent)) + (delete-region (extent-start-position zmacs-region-extent) + (extent-end-position zmacs-region-extent))) + (zmacs-deactivate-region) + t))) + +(defun pending-delete-pre-hook () + (let ((type (and (symbolp this-command) + (get this-command 'pending-delete)))) + (cond ((eq type 'kill) + (delete-active-region t)) + ((eq type 'supersede) + (if (delete-active-region ()) + (setq this-command '(lambda () (interactive))))) + (type + (delete-active-region ()))))) + +(put 'self-insert-command 'pending-delete t) + +(put 'yank 'pending-delete t) +(put 'x-yank-clipboard-selection 'pending-delete t) + +(put 'delete-backward-char 'pending-delete 'supersede) +(put 'backward-delete-char-untabify 'pending-delete 'supersede) +(put 'delete-char 'pending-delete 'supersede) +(put 'c-electric-delete 'pending-delete 'supersede) + +;; Don't delete for these. They're more problematic than helpful. +;; +;; (put 'newline-and-indent 'pending-delete t) +;; (put 'newline 'pending-delete t) +;; (put 'open-line 'pending-delete t) + +(put 'insert-register 'pending-delete t) + +;;;###autoload +(defun pending-delete-on (verbose) + "Turn on pending delete. +When it is ON, typed text replaces the selection if the selection is active. +When it is OFF, typed text is just inserted at point." + (interactive "P") + (add-hook 'pre-command-hook 'pending-delete-pre-hook) + (and verbose + (message "Pending delete is ON, use M-x pending-delete to turn it OFF"))) + +;;;###autoload +(defun pending-delete-off (verbose) + "Turn off pending delete. +When it is ON, typed text replaces the selection if the selection is active. +When it is OFF, typed text is just inserted at point." + (interactive "P") + (remove-hook 'pre-command-hook 'pending-delete-pre-hook) + (and verbose (message "pending delete is OFF"))) + +;;;###autoload +(defun pending-delete (&optional arg) + "Toggle automatic deletion of the selected region. +With a positive argument, turns it on. +With a non-positive argument, turns it off. +When active, typed text replaces the selection." + (interactive "P") + (let* ((was-on (not (not (memq 'pending-delete-pre-hook pre-command-hook)))) + (on-p (if (null arg) + (not was-on) + (> (prefix-numeric-value arg) 0)))) + (cond ((eq on-p was-on) + nil) + (on-p + (pending-delete-on pending-delete-verbose)) + (t + (pending-delete-off pending-delete-verbose))))) + +;; Add pending-del mode. Assume that if we load it then we obviously wanted +;; it on, even if it is already on. +(pending-delete-on (eq pending-delete-verbose t)) + +(provide 'pending-del) + +;;; pending-del.el ends here