2008-11-16 Michael Kifer <kifer@cs.stonybrook.edu>
[bpt/emacs.git] / lisp / emulation / cua-gmrk.el
index a1e9d31..8e18df9 100644 (file)
@@ -1,16 +1,17 @@
 ;;; cua-gmrk.el --- CUA unified global mark support
 
-;; Copyright (C) 1997-2002 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Keywords: keyboard emulations convenience cua mark
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; Code:
 
-(provide 'cua-gmrk)
-
 (eval-when-compile
   (require 'cua-base)
   (require 'cua-rect)
   )
 
-;;; Global Marker 
+;;; Global Marker
 
 ;; Non-nil when global marker is active.
 (defvar cua--global-mark-active nil)
   (move-marker cua--global-mark-marker (point))
   (if (overlayp cua--global-mark-overlay)
       (move-overlay cua--global-mark-overlay (point) (1+ (point)))
-    (setq cua--global-mark-overlay 
+    (setq cua--global-mark-overlay
          (make-overlay (point) (1+ (point))))
-    (overlay-put cua--global-mark-overlay 'face 'cua-global-mark-face))
+    (overlay-put cua--global-mark-overlay 'face 'cua-global-mark))
   (if (and cua-global-mark-blink-cursor-interval
           (not cua--orig-blink-cursor-interval))
-      (setq cua--orig-blink-cursor-interval blink-cursor-interval 
+      (setq cua--orig-blink-cursor-interval blink-cursor-interval
            blink-cursor-interval cua-global-mark-blink-cursor-interval))
   (setq cua--global-mark-active t)
   (if msg
@@ -96,7 +93,7 @@ When the global marker is set, CUA cut and copy commands will automatically
 insert the deleted or copied text before the global marker, even when the
 global marker is in another buffer.
 If the global marker isn't set, set the global marker at point in the current
-buffer. Otherwise jump to the global marker position and cancel it.
+buffer.  Otherwise jump to the global marker position and cancel it.
 With prefix argument, don't jump to global mark when cancelling it."
   (interactive "P")
   (unless cua--global-mark-initialized
@@ -105,7 +102,7 @@ With prefix argument, don't jump to global mark when cancelling it."
       (if (not buffer-read-only)
          (cua--activate-global-mark t)
        (ding)
-       (message "Cannot set global mark in read-only buffer."))
+       (message "Cannot set global mark in read-only buffer"))
     (when (not stay)
       (pop-to-buffer (marker-buffer cua--global-mark-marker))
       (goto-char cua--global-mark-marker))
@@ -142,7 +139,7 @@ With prefix argument, don't jump to global mark when cancelling it."
       (let ((src-buf (current-buffer)))
        (save-excursion
          (if (equal (marker-buffer cua--global-mark-marker) src-buf)
-             (let ((text (buffer-substring-no-properties start end)))
+             (let ((text (filter-buffer-substring start end nil t)))
                (goto-char (marker-position cua--global-mark-marker))
                (insert text))
            (set-buffer (marker-buffer cua--global-mark-marker))
@@ -165,8 +162,8 @@ With prefix argument, don't jump to global mark when cancelling it."
          (if (equal (marker-buffer cua--global-mark-marker) src-buf)
              (if (and (< start (marker-position cua--global-mark-marker))
                       (< (marker-position cua--global-mark-marker) end))
-                 (message "Can't move region into itself.")
-               (let ((text (buffer-substring-no-properties start end))
+                 (message "Can't move region into itself")
+               (let ((text (filter-buffer-substring start end nil t))
                      (p1 (copy-marker start))
                      (p2 (copy-marker end)))
                  (goto-char (marker-position cua--global-mark-marker))
@@ -218,11 +215,11 @@ With prefix argument, don't jump to global mark when cancelling it."
              (let ((olist (overlays-at (marker-position cua--global-mark-marker)))
                    in-rect)
                (while olist
-                 (if (eq (overlay-get (car olist) 'face) 'cua-rectangle-face)
+                 (if (eq (overlay-get (car olist) 'face) 'cua-rectangle)
                      (setq in-rect t olist nil)
                    (setq olist (cdr olist))))
                (if in-rect
-                   (message "Can't move rectangle into itself.")
+                   (message "Can't move rectangle into itself")
                  (let ((text (cua--extract-rectangle)))
                    (cua--delete-rectangle)
                    (goto-char (marker-position cua--global-mark-marker))
@@ -325,7 +322,7 @@ With prefix argument, don't jump to global mark when cancelling it."
              (move-to-column col)
              (move-marker cua--global-mark-marker (point))
              (move-overlay cua--global-mark-overlay (point) (1+ (point))))))))
-           
+
 
 (defun cua-cancel-global-mark ()
   "Cancel the global mark."
@@ -346,7 +343,7 @@ With prefix argument, don't jump to global mark when cancelling it."
     (if (or (not (eq (current-buffer) (marker-buffer cua--global-mark-marker)))
            (not (pos-visible-in-window-p (marker-position cua--global-mark-marker))))
        (let ((w (selected-window)) (p (point)) h)
-         ;; The following code is an attempt to keep the global mark visible in 
+         ;; The following code is an attempt to keep the global mark visible in
          ;; other window -- but it doesn't work.
          (switch-to-buffer-other-window (marker-buffer cua--global-mark-marker) t)
          (goto-char (marker-position cua--global-mark-marker))
@@ -358,11 +355,6 @@ With prefix argument, don't jump to global mark when cancelling it."
 ;;; Initialization
 
 (defun cua--init-global-mark ()
-  (unless (face-background 'cua-global-mark-face)
-    (copy-face 'region 'cua-global-mark-face)
-    (set-face-foreground 'cua-global-mark-face "black")
-    (set-face-background 'cua-global-mark-face "cyan"))
-
   (define-key cua--global-mark-keymap [remap copy-region-as-kill]      'cua-copy-to-global-mark)
   (define-key cua--global-mark-keymap [remap kill-ring-save]           'cua-copy-to-global-mark)
   (define-key cua--global-mark-keymap [remap kill-region]              'cua-cut-to-global-mark)
@@ -377,6 +369,11 @@ With prefix argument, don't jump to global mark when cancelling it."
   (define-key cua--global-mark-keymap [remap backward-delete-char-untabify] 'cua-delete-backward-char-at-global-mark)
   (define-key cua--global-mark-keymap [remap self-insert-command]      'cua-insert-char-at-global-mark)
   (define-key cua--global-mark-keymap [remap self-insert-iso]          'cua-insert-char-at-global-mark)
+
+  ;; Catch self-inserting characters which are "stolen" by other modes
+  (define-key cua--global-mark-keymap [t]
+    '(menu-item "sic" cua-insert-char-at-global-mark :filter cua--self-insert-char-p))
+
   (define-key cua--global-mark-keymap [remap newline]                  'cua-insert-newline-at-global-mark)
   (define-key cua--global-mark-keymap [remap newline-and-indent]       'cua-insert-newline-at-global-mark)
   (define-key cua--global-mark-keymap "\r"                             'cua-insert-newline-at-global-mark)
@@ -385,4 +382,7 @@ With prefix argument, don't jump to global mark when cancelling it."
 
   (setq cua--global-mark-initialized t))
 
+(provide 'cua-gmrk)
+
+;; arch-tag: 553d8076-a91d-48ae-825d-6cb962a5f67f
 ;;; cua-gmrk.el ends here