delsel.el - replacement for GNU `delsel.el'

[Drew Adams]

;;; delsel.el --- Delete the region (selection) upon char insertion or DEL.
;; 
;; Emacs Lisp Archive Entry
;; Filename: delsel.el
;; Description: Delete the region (selection) upon char insertion or DEL.
;; Author: Matthieu Devin <address@hidden>
;;      Drew Adams
;; Maintainer: D. ADAMS
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Copyright (C) 1992 Free Software Foundation, Inc.
;; Created: Fri Dec  1 13:51:31 1995
;; Version: $Id: delsel.el,v 1.7 2001/01/10 18:37:00 dadams Exp $
;; Last-Updated: Wed Jan 10 10:27:57 2001
;;           By: dadams
;;     Update #: 192
;; Keywords: abbrev, emulations, local
;; Compatibility: GNU Emacs 20.x
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary: 
;;
;;    Let DEL delete the region; let character insertion replace it.
;;
;;  Makes the active region be pending a deletion, meaning that text
;;  inserted while th region is active will replace the region
;;  contents, and that operations like `delete-backward-char' will
;;  delete the region.
;;
;;  `C-g' is bound here to `minibuffer-keyboard-quit' in each of the
;;  minibuffer-local-*-map's.
;;
;;
;; The original author is Matthieu Devin <address@hidden>.
;; This version was modified by Drew Adams.
;;
;; Main changes here from the original:
;; -----------------------------------
;;
;; 1. Added function `delete-selection-pre-hook-1'.  In fact,
;;    `delete-selection-pre-hook' was renamed to
;;    `delete-selection-pre-hook-1', and a new (`defsubst') version of
;;    `delete-selection-pre-hook' was defined in terms of it.
;;    This allowed change #2 (next). 
;; 2. Fixed bug: `completion.el' was making things like SPC and `.'
;;    lose on self insert here.
;; 3. Will now work in tandem with `completion.el':
;;    a. `delete-active-region': Deletes latest completion only.
;;       During completion, don't delete region when self-insert.
;;    b. `delete-selection-pre-hook': In case of completion, makes
;;       mark active.
;; 4. `minibuffer-keyboard-quit': 
;;    Removes any windows showing *Completions* buffer.
;; 5. `delete-selection-mode': Informs user of new state.
;;
;; NOTE: This does nothing if transient-mark-mode is nil, so in order
;;       to use this you might want to do something like the following:
;; 
;;       (make-variable-buffer-local 'transient-mark-mode)
;;       (put 'transient-mark-mode 'permanent-local t)
;;       (setq-default transient-mark-mode t)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Change log:
;; 
;; RCS $Log: delsel.el,v $
;; RCS Revision 1.7  2001/01/10 18:37:00  dadams
;; RCS 1. Added soft require of frame-cmds.el.
;; RCS 2. Protected remove-windows-on via fboundp.
;; RCS 3. Updated commentary.
;; RCS
;; RCS Revision 1.6  2001/01/08 22:41:36  dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.5  2001/01/08 19:39:26  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.4  2001/01/03 17:33:03  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.3  2001/01/03 00:35:28  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.2  2000/11/28 19:24:11  dadams
;; RCS Optional require's via 3rd arg=t now.
;; RCS
;; RCS Revision 1.1  2000/09/14 15:15:21  dadams
;; RCS Initial revision
;; RCS
; Revision 1.2  1999/03/17  13:05:54  dadams
; 1. Removed require: std-faces.
; 2. Updated to incorporate Emacs 34.1 version.
; 3. Protected calls with test fboundp.
;
; Revision 1.1  1997/03/20  10:31:14  dadams
; Initial revision
;
; Revision 1.13  1996/06/20  11:51:43  dadams
; (trivial)
;
; Revision 1.12  1996/06/19  06:40:02  dadams
; File header Commentary: Explained diffs from GNU version of this file.
;
; Revision 1.11  1996/03/14  13:17:56  dadams
; 1. minibuffer-keyboard-quit: defun -> defsubst.
; 2. Require completion.el when compile.
;
; Revision 1.10  1996/03/12  15:18:52  dadams
; delete-selection-pre-hook: defun -> defsubst.
;
; Revision 1.9  1996/03/06  12:43:05  dadams
; (trivial: faces+ -> std-faces)
;
; Revision 1.8  1996/03/06  08:36:53  dadams
; 1. Copyright.
; 2. drew-windows.el -> frame-fns.el, drew-faces.el -> std-faces.el,
;    drew-strings.el -> strings.el.
;
; Revision 1.7  1996/02/15  16:48:32  dadams
; delete-active-region: During completion, don't delete region when self-insert.
;
; Revision 1.6  1996/02/12  09:18:08  dadams
; Updated header keywords (for finder).
;
; Revision 1.5  1996/01/08  13:41:48  dadams
; delete-selection-mode: message -> display-in-minibuffer.
; Require drew-faces.el.
;
; Revision 1.4  1995/12/28  14:49:15  dadams
; Removed require of drew-windows.el, since autoloaded.
;
; Revision 1.3  1995/12/28  07:38:13  dadams
; Will now work in tandem with completion.el:
; delete-active-region: Deletes latest completion only.
; delete-selection-pre-hook: In case of completion, makes mark active.
; Added delete-selection-pre-hook.
;
; Revision 1.2  1995/12/08  14:42:30  dadams
; completion.el was making things like SPC and `.' lose on self insert here.
; (put 'completion-separator-self-insert-command 'delete-selection t)
; (put 'completion-separator-self-insert-autofilling 'delete-selection t)
;
; Revision 1.1  1995/12/01  13:58:32  dadams
; Initial revision
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; This program 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.

;; This program 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 this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Code: 

(require 'cl) ;; when

;; Get macro `define-face-const' when this is compiled,
;; or run interpreted, but not when the compiled code is loaded.
(eval-when-compile (require 'def-face-const))

(require 'completion nil t) ;; (no error if not found):
                            ;; cmpl-last-insert-location,
                            ;; cmpl-original-string,
                            ;; completion-to-accept
(require 'strings nil t) ;; (no error if not found): display-in-minibuffer
(require 'frame-cmds nil t) ;; (no error if not found): remove-windows-on


(provide 'delsel)

;;;;;;;;;;;;;;;;;;

;; Free variables here: CMPL-LAST-INSERT-LOCATION, CMPL-ORIGINAL-STRING,
;;                      COMPLETION-TO-ACCEPT
;; To quiet the byte compiler:
(defvar cmpl-last-insert-location -1)
(defvar cmpl-original-string nil)
(defvar completion-to-accept nil)

;;;;;;;;;;;;;;;;;;


(unless (boundp 'blue-foreground-face) (define-face-const "Blue" nil))

(defvar delete-selection-mode t
  "*Non-nil means Delete Selection mode is enabled.
In this mode, when a region is highlighted, insertion commands first
delete the region, then insert.")

;; CMPL-LAST-INSERT-LOCATION, CMPL-ORIGINAL-STRING and COMPLETION-TO-ACCEPT
;; are free here.
(defun delete-active-region (&optional killp)
  (cond ((and (eq last-command 'complete) ; See `completion.el'.
              (boundp 'cmpl-last-insert-location))
         ;; Don't delete region if a `self-insert-command'.
         ;; Delete it only if a supersede or a kill.
         (when (and (symbolp this-command)
                    (memq (get this-command 'delete-selection)
                          '(supersede kill )))
           (delete-region (point) cmpl-last-insert-location) ; Free var here.
           (insert cmpl-original-string) ; Free var here.
           (setq completion-to-accept nil))) ; Free var here.
        (killp (kill-region (point) (mark)))
        (t (delete-region (point) (mark))))
  (deactivate-mark)
  t)

(defsubst delete-selection-pre-hook ()
  (if (and (eq last-command 'complete) ; See `completion.el'.
           (boundp 'cmpl-last-insert-location))
      (let ((mark-active t)) (delete-selection-pre-hook-1))
    (delete-selection-pre-hook-1)))

(defun delete-selection-pre-hook-1 ()
  (when (and delete-selection-mode
             (not buffer-read-only)
             transient-mark-mode mark-active)
    (let ((type (and (symbolp this-command)
                     (get this-command 'delete-selection))))
      (cond ((eq type 'kill)
             (delete-active-region t))
            ((eq type 'yank)
             ;; Before a yank command.  Make sure we don't yank the same
             ;; region that we are going to delete.
             ;; That would make yank a no-op.
             (when (string= (buffer-substring (point) (mark)) (car kill-ring))
               (current-kill 1))
             (delete-active-region nil))
            ((eq type 'supersede)
             (when (delete-active-region nil)
               (setq this-command '(lambda () (interactive)))))
            (type (delete-active-region nil))))))

(add-hook 'pre-command-hook 'delete-selection-pre-hook)

(put 'self-insert-command 'delete-selection t)
(put 'self-insert-iso 'delete-selection t)

;; These are defined in `completion.el'.
(put 'completion-separator-self-insert-command 'delete-selection t)
(put 'completion-separator-self-insert-autofilling 'delete-selection t)

(put 'yank 'delete-selection 'yank)
(put 'clipboard-yank 'delete-selection 'yank)
(put 'insert-register 'delete-selection t)

(put 'delete-backward-char 'delete-selection 'supersede)
(put 'backward-delete-char-untabify 'delete-selection 'supersede)
(put 'delete-char 'delete-selection 'supersede)

(put 'newline-and-indent 'delete-selection 't)
(put 'newline 'delete-selection t)
(put 'open-line 'delete-selection t)

;;;###autoload
(defalias 'pending-delete-mode 'delete-selection-mode)

;;;###autoload
(defun delete-selection-mode (arg)
  "Toggle Delete Selection mode.
When on, typed text replaces the selection if the selection is active,
and DEL deletes the selection.  When off, typed text is just inserted
at point, as usual.

Non-nil prefix ARG turns mode on if ARG is positive, else turns it off."
  (interactive "P")
  (setq delete-selection-mode (if (null arg)
                                  (not delete-selection-mode)
                                (> (prefix-numeric-value arg) 0)))
  (force-mode-line-update)
  (when (interactive-p)
    (if (fboundp 'display-in-minibuffer) ; In `strings.el'.
        (display-in-minibuffer
         'event "Delete Selection mode is now "
         (list blue-foreground-face (if delete-selection-mode "ON" "OFF")) ".")
      (message "Delete Selection mode is now %s."
               (if delete-selection-mode "ON" "OFF")))))

;; This can be used to cancel a selection in the minibuffer without 
;; aborting the minibuffer.
(defun minibuffer-keyboard-quit ()
  "Abort recursive edit.
In Delete Selection mode mode, if the mark is active, just deactivate it;
then it takes a second C-g to abort the minibuffer."
  (interactive)
  (if (and delete-selection-mode transient-mark-mode mark-active)
      (setq deactivate-mark t)
    (when (fboundp 'remove-windows-on) (remove-windows-on "*Completions*"))
    (abort-recursive-edit)))

(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) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `delsel.el' ends here