Mercurial > emacs

comparison lisp/emulation/cua-gmrk.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; cua-gmrk.el --- CUA unified global mark support 1 ;;; cua-gmrk.el --- CUA unified global mark support
2 2
3 ;; Copyright (C) 1997-2002 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
4 5
5 ;; Author: Kim F. Storm <storm@cua.dk> 6 ;; Author: Kim F. Storm <storm@cua.dk>
6 ;; Keywords: keyboard emulations convenience cua mark 7 ;; Keywords: keyboard emulations convenience cua mark
7 8
8 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
19 20
20 ;; 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
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
24 25
25 ;;; Commentary: 26 ;;; Commentary:
26 27
27 ;;; Code: 28 ;;; Code:
28 29
72 (move-marker cua--global-mark-marker (point)) 73 (move-marker cua--global-mark-marker (point))
73 (if (overlayp cua--global-mark-overlay) 74 (if (overlayp cua--global-mark-overlay)
74 (move-overlay cua--global-mark-overlay (point) (1+ (point))) 75 (move-overlay cua--global-mark-overlay (point) (1+ (point)))
75 (setq cua--global-mark-overlay 76 (setq cua--global-mark-overlay
76 (make-overlay (point) (1+ (point)))) 77 (make-overlay (point) (1+ (point))))
77 (overlay-put cua--global-mark-overlay 'face 'cua-global-mark-face)) 78 (overlay-put cua--global-mark-overlay 'face 'cua-global-mark))
78 (if (and cua-global-mark-blink-cursor-interval 79 (if (and cua-global-mark-blink-cursor-interval
79 (not cua--orig-blink-cursor-interval)) 80 (not cua--orig-blink-cursor-interval))
80 (setq cua--orig-blink-cursor-interval blink-cursor-interval 81 (setq cua--orig-blink-cursor-interval blink-cursor-interval
81 blink-cursor-interval cua-global-mark-blink-cursor-interval)) 82 blink-cursor-interval cua-global-mark-blink-cursor-interval))
82 (setq cua--global-mark-active t) 83 (setq cua--global-mark-active t)
94 "Set or cancel the global marker. 95 "Set or cancel the global marker.
95 When the global marker is set, CUA cut and copy commands will automatically 96 When the global marker is set, CUA cut and copy commands will automatically
96 insert the deleted or copied text before the global marker, even when the 97 insert the deleted or copied text before the global marker, even when the
97 global marker is in another buffer. 98 global marker is in another buffer.
98 If the global marker isn't set, set the global marker at point in the current 99 If the global marker isn't set, set the global marker at point in the current
99 buffer. Otherwise jump to the global marker position and cancel it. 100 buffer. Otherwise jump to the global marker position and cancel it.
100 With prefix argument, don't jump to global mark when cancelling it." 101 With prefix argument, don't jump to global mark when cancelling it."
101 (interactive "P") 102 (interactive "P")
102 (unless cua--global-mark-initialized 103 (unless cua--global-mark-initialized
103 (cua--init-global-mark)) 104 (cua--init-global-mark))
104 (if (not (cua--global-mark-active)) 105 (if (not (cua--global-mark-active))
105 (if (not buffer-read-only) 106 (if (not buffer-read-only)
106 (cua--activate-global-mark t) 107 (cua--activate-global-mark t)
107 (ding) 108 (ding)
108 (message "Cannot set global mark in read-only buffer.")) 109 (message "Cannot set global mark in read-only buffer"))
109 (when (not stay) 110 (when (not stay)
110 (pop-to-buffer (marker-buffer cua--global-mark-marker)) 111 (pop-to-buffer (marker-buffer cua--global-mark-marker))
111 (goto-char cua--global-mark-marker)) 112 (goto-char cua--global-mark-marker))
112 (cua--deactivate-global-mark t))) 113 (cua--deactivate-global-mark t)))
113 114
163 (let ((src-buf (current-buffer))) 164 (let ((src-buf (current-buffer)))
164 (save-excursion 165 (save-excursion
165 (if (equal (marker-buffer cua--global-mark-marker) src-buf) 166 (if (equal (marker-buffer cua--global-mark-marker) src-buf)
166 (if (and (< start (marker-position cua--global-mark-marker)) 167 (if (and (< start (marker-position cua--global-mark-marker))
167 (< (marker-position cua--global-mark-marker) end)) 168 (< (marker-position cua--global-mark-marker) end))
168 (message "Can't move region into itself.") 169 (message "Can't move region into itself")
169 (let ((text (buffer-substring-no-properties start end)) 170 (let ((text (buffer-substring-no-properties start end))
170 (p1 (copy-marker start)) 171 (p1 (copy-marker start))
171 (p2 (copy-marker end))) 172 (p2 (copy-marker end)))
172 (goto-char (marker-position cua--global-mark-marker)) 173 (goto-char (marker-position cua--global-mark-marker))
173 (insert text) 174 (insert text)
216 (save-excursion 217 (save-excursion
217 (if (equal (marker-buffer cua--global-mark-marker) src-buf) 218 (if (equal (marker-buffer cua--global-mark-marker) src-buf)
218 (let ((olist (overlays-at (marker-position cua--global-mark-marker))) 219 (let ((olist (overlays-at (marker-position cua--global-mark-marker)))
219 in-rect) 220 in-rect)
220 (while olist 221 (while olist
221 (if (eq (overlay-get (car olist) 'face) 'cua-rectangle-face) 222 (if (eq (overlay-get (car olist) 'face) 'cua-rectangle)
222 (setq in-rect t olist nil) 223 (setq in-rect t olist nil)
223 (setq olist (cdr olist)))) 224 (setq olist (cdr olist))))
224 (if in-rect 225 (if in-rect
225 (message "Can't move rectangle into itself.") 226 (message "Can't move rectangle into itself")
226 (let ((text (cua--extract-rectangle))) 227 (let ((text (cua--extract-rectangle)))
227 (cua--delete-rectangle) 228 (cua--delete-rectangle)
228 (goto-char (marker-position cua--global-mark-marker)) 229 (goto-char (marker-position cua--global-mark-marker))
229 (if as-text 230 (if as-text
230 (while text 231 (while text
356 (goto-char p))))) 357 (goto-char p)))))
357 358
358 ;;; Initialization 359 ;;; Initialization
359 360
360 (defun cua--init-global-mark () 361 (defun cua--init-global-mark ()
361 (unless (face-background 'cua-global-mark-face)
362 (copy-face 'region 'cua-global-mark-face)
363 (set-face-foreground 'cua-global-mark-face "black")
364 (set-face-background 'cua-global-mark-face "cyan"))
365
366 (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark) 362 (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark)
367 (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark) 363 (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark)
368 (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark) 364 (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark)
369 (define-key cua--global-mark-keymap [remap yank] 'cua-copy-next-to-global-mark) 365 (define-key cua--global-mark-keymap [remap yank] 'cua-copy-next-to-global-mark)
370 366
388 384
389 (define-key cua--global-mark-keymap "\t" 'cua-indent-to-global-mark-column) 385 (define-key cua--global-mark-keymap "\t" 'cua-indent-to-global-mark-column)
390 386
391 (setq cua--global-mark-initialized t)) 387 (setq cua--global-mark-initialized t))
392 388
389 ;;; arch-tag: 553d8076-a91d-48ae-825d-6cb962a5f67f
393 ;;; cua-gmrk.el ends here 390 ;;; cua-gmrk.el ends here