home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / pending-del.el < prev    next >
Encoding:
Text File  |  1993-03-13  |  4.4 KB  |  118 lines
  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. ;;; This files makes the active region be pending delete, meaning that
  23. ;;; text inserted while the region is active will replace the region contents.
  24. ;;; This is a popular behavior of personal computers text editors.
  25.  
  26. (provide 'pending-del)
  27.  
  28. (defun delete-active-region (&optional killp)
  29.   (if (and (not buffer-read-only)
  30.        (extentp primary-selection-extent)
  31.        (eq (current-buffer) (extent-buffer primary-selection-extent))
  32.        (< 0 (extent-start-position primary-selection-extent))
  33.        (< 0 (extent-end-position primary-selection-extent)))
  34.       (progn
  35.     (if killp
  36.         (kill-region (extent-start-position primary-selection-extent)
  37.              (extent-end-position primary-selection-extent))
  38.       (delete-region (extent-start-position primary-selection-extent)
  39.              (extent-end-position primary-selection-extent)))
  40.     (zmacs-deactivate-region)
  41.     t)))
  42.  
  43. (defun pending-delete-pre-hook ()
  44.   (let ((type (and (symbolp this-command)
  45.            (get this-command 'pending-delete))))
  46.     (cond ((eq type 'kill)
  47.        (delete-active-region t))
  48.       ((eq type 'supersede)
  49.        (if (delete-active-region ())
  50.            (setq this-command '(lambda () (interactive)))))
  51.       (type
  52.        (delete-active-region ())))))
  53.  
  54. (put 'self-insert-command 'pending-delete t)
  55.  
  56. (put 'yank 'pending-delete t)
  57. (put 'x-yank-clipboard-selection 'pending-delete t)
  58.  
  59. (put 'delete-backward-char 'pending-delete 'supersede)
  60. (put 'backward-delete-char-untabify 'pending-delete 'supersede)
  61. (put 'delete-char 'pending-delete 'supersede)
  62.  
  63. (put 'newline-and-indent 'pending-delete 't)
  64. (put 'newline 'pending-delete t)
  65. (put 'open-line 'pending-delete t)
  66.  
  67. (defun pending-delete ()
  68.   "Toggle the state of the pending-delete package.  
  69. When ON typed text replaces the selection if the selection is active.
  70. When OFF typed text is just inserted at point."
  71.   (interactive)
  72.   (if (memq 'pending-delete-pre-hook pre-command-hook)
  73.       (progn
  74.     (remove-hook 'pre-command-hook 'pending-delete-pre-hook)
  75.     (message "pending delete is OFF"))
  76.     (progn
  77.       (add-hook 'pre-command-hook 'pending-delete-pre-hook)
  78.       (message
  79.        "Pending delete is ON, use M-x pending-delete to turn it OFF"))))
  80.  
  81. (pending-delete)
  82.  
  83. ;; This new definition of control-G makes the first control-G disown the 
  84. ;; selection and the second one signal a QUIT.
  85. ;; This is very useful for cancelling a selection in the minibuffer without 
  86. ;; aborting the minibuffer.
  87. ;; It has actually nothing to do with pending-delete but its more necessary
  88. ;; with pending delete because pending delete users use the selection more.
  89. (defun keyboard-quit ()
  90.   "Signal a `quit' condition.
  91. If this character is typed while lisp code is executing, it will be treated
  92.  as an interrupt.
  93. If this character is typed at top-level, this simply beeps.
  94. If `zmacs-regions' is true, and the zmacs region is active, then this
  95.  key deactivates the region without beeping or signalling."
  96.   (interactive)
  97.   (if (and zmacs-regions (zmacs-deactivate-region))
  98.       ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
  99.       ;; deactivating the region.  If it is inactive, beep.
  100.       nil
  101.     (signal 'quit nil)))
  102.  
  103. (defun minibuffer-keyboard-quit ()
  104.   "Abort recursive edit
  105. If `zmacs-regions' is true, and the zmacs region is active, then this
  106.  key deactivates the region without beeping."
  107.   (interactive)
  108.   (if (and zmacs-regions (zmacs-deactivate-region))
  109.       ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
  110.       ;; deactivating the region.  If it is inactive, beep.
  111.       nil
  112.     (abort-recursive-edit)))
  113.  
  114. (define-key minibuffer-local-map '(control g) 'minibuffer-keyboard-quit) 
  115.  
  116.  
  117.  
  118.