Commit | Line | Data |
---|---|---|
72cc582e KS |
1 | ;;; cua-gmrk.el --- CUA unified global mark support |
2 | ||
5fd6d89f | 3 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
5df4f04c | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
72cc582e KS |
5 | |
6 | ;; Author: Kim F. Storm <storm@cua.dk> | |
7 | ;; Keywords: keyboard emulations convenience cua mark | |
bd78fa1d | 8 | ;; Package: cua-base |
72cc582e KS |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
ed0f493f | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
72cc582e | 13 | ;; it under the terms of the GNU General Public License as published by |
ed0f493f GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
72cc582e KS |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
ed0f493f | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
72cc582e | 24 | |
30764597 PJ |
25 | ;;; Commentary: |
26 | ||
27 | ;;; Code: | |
72cc582e | 28 | |
72cc582e KS |
29 | (eval-when-compile |
30 | (require 'cua-base) | |
31 | (require 'cua-rect) | |
32 | ) | |
33 | ||
a1506d29 | 34 | ;;; Global Marker |
72cc582e KS |
35 | |
36 | ;; Non-nil when global marker is active. | |
37 | (defvar cua--global-mark-active nil) | |
38 | ||
39 | ;; Global mark position marker. | |
40 | (defvar cua--global-mark-marker nil) | |
41 | ||
42 | ;; Overlay for global mark position. | |
43 | (defvar cua--global-mark-overlay nil) | |
44 | ||
45 | ;; Initialize global mark things once... | |
46 | (defvar cua--global-mark-initialized nil) | |
47 | ||
48 | ;; Saved configured blink-cursor-interval | |
49 | (defvar cua--orig-blink-cursor-interval nil) | |
50 | ||
51 | (defun cua--deactivate-global-mark (&optional msg) | |
52 | (when cua--global-mark-overlay | |
53 | (delete-overlay cua--global-mark-overlay) | |
54 | (setq cua--global-mark-overlay nil)) | |
55 | (if (markerp cua--global-mark-marker) | |
56 | (move-marker cua--global-mark-marker nil)) | |
57 | (if cua--orig-blink-cursor-interval | |
58 | (setq blink-cursor-interval cua--orig-blink-cursor-interval | |
59 | cua--orig-blink-cursor-interval nil)) | |
60 | (setq cua--global-mark-active nil) | |
61 | (if msg | |
62 | (message "Global Mark Cleared"))) | |
63 | ||
64 | (defun cua--activate-global-mark (&optional msg) | |
65 | (if (not (markerp cua--global-mark-marker)) | |
66 | (setq cua--global-mark-marker (make-marker))) | |
67 | (when (eobp) | |
68 | (insert " ") | |
69 | (backward-char 1)) | |
70 | (move-marker cua--global-mark-marker (point)) | |
71 | (if (overlayp cua--global-mark-overlay) | |
72 | (move-overlay cua--global-mark-overlay (point) (1+ (point))) | |
a1506d29 | 73 | (setq cua--global-mark-overlay |
72cc582e | 74 | (make-overlay (point) (1+ (point)))) |
1e98d199 | 75 | (overlay-put cua--global-mark-overlay 'face 'cua-global-mark)) |
72cc582e KS |
76 | (if (and cua-global-mark-blink-cursor-interval |
77 | (not cua--orig-blink-cursor-interval)) | |
a1506d29 | 78 | (setq cua--orig-blink-cursor-interval blink-cursor-interval |
72cc582e KS |
79 | blink-cursor-interval cua-global-mark-blink-cursor-interval)) |
80 | (setq cua--global-mark-active t) | |
81 | (if msg | |
82 | (message "Global Mark Set"))) | |
83 | ||
84 | (defun cua--global-mark-active () | |
85 | (if cua--global-mark-active | |
86 | (or (and (markerp cua--global-mark-marker) | |
87 | (marker-buffer cua--global-mark-marker)) | |
88 | (and (cua--deactivate-global-mark nil) | |
89 | nil)))) | |
90 | ||
91 | (defun cua-toggle-global-mark (stay) | |
92 | "Set or cancel the global marker. | |
93 | When the global marker is set, CUA cut and copy commands will automatically | |
94 | insert the deleted or copied text before the global marker, even when the | |
95 | global marker is in another buffer. | |
96 | If the global marker isn't set, set the global marker at point in the current | |
c23eed1b | 97 | buffer. Otherwise jump to the global marker position and cancel it. |
72cc582e KS |
98 | With prefix argument, don't jump to global mark when cancelling it." |
99 | (interactive "P") | |
100 | (unless cua--global-mark-initialized | |
101 | (cua--init-global-mark)) | |
102 | (if (not (cua--global-mark-active)) | |
103 | (if (not buffer-read-only) | |
104 | (cua--activate-global-mark t) | |
105 | (ding) | |
c23eed1b | 106 | (message "Cannot set global mark in read-only buffer")) |
72cc582e KS |
107 | (when (not stay) |
108 | (pop-to-buffer (marker-buffer cua--global-mark-marker)) | |
109 | (goto-char cua--global-mark-marker)) | |
110 | (cua--deactivate-global-mark t))) | |
111 | ||
112 | (defun cua--insert-at-global-mark (str &optional msg) | |
113 | ;; Insert string at global marker and move marker | |
937e6a56 | 114 | (with-current-buffer (marker-buffer cua--global-mark-marker) |
72cc582e KS |
115 | (goto-char (marker-position cua--global-mark-marker)) |
116 | (insert-for-yank str) | |
117 | (cua--activate-global-mark)) | |
118 | (if msg | |
119 | (message "%s %d to global mark in %s:%d" msg | |
120 | (length str) | |
121 | (buffer-name (marker-buffer cua--global-mark-marker)) | |
122 | (marker-position cua--global-mark-marker)))) | |
123 | ||
124 | (defun cua--delete-at-global-mark (arg &optional msg) | |
125 | ;; Delete chars at global marker | |
937e6a56 | 126 | (with-current-buffer (marker-buffer cua--global-mark-marker) |
72cc582e KS |
127 | (goto-char (marker-position cua--global-mark-marker)) |
128 | (delete-char arg)) | |
129 | (if msg | |
130 | (message "%s %d chars at global mark in %s:%d" msg arg | |
131 | (buffer-name (marker-buffer cua--global-mark-marker)) | |
132 | (marker-position cua--global-mark-marker)))) | |
133 | ||
134 | (defun cua-copy-region-to-global-mark (start end) | |
135 | "Copy region to global mark buffer/position." | |
136 | (interactive "r") | |
137 | (if (cua--global-mark-active) | |
138 | (let ((src-buf (current-buffer))) | |
139 | (save-excursion | |
140 | (if (equal (marker-buffer cua--global-mark-marker) src-buf) | |
c5eb971b | 141 | (let ((text (cua--filter-buffer-noprops start end))) |
72cc582e KS |
142 | (goto-char (marker-position cua--global-mark-marker)) |
143 | (insert text)) | |
144 | (set-buffer (marker-buffer cua--global-mark-marker)) | |
145 | (goto-char (marker-position cua--global-mark-marker)) | |
146 | (insert-buffer-substring-as-yank src-buf start end)) | |
147 | (cua--activate-global-mark) | |
148 | (message "Copied %d to global mark in %s:%d" | |
149 | (abs (- end start)) | |
150 | (buffer-name (marker-buffer cua--global-mark-marker)) | |
151 | (marker-position cua--global-mark-marker)))) | |
152 | (cua--deactivate-global-mark) | |
153 | (message "No Global Mark"))) | |
154 | ||
155 | (defun cua-cut-region-to-global-mark (start end) | |
156 | "Move region to global buffer/position." | |
157 | (interactive "r") | |
158 | (if (cua--global-mark-active) | |
159 | (let ((src-buf (current-buffer))) | |
160 | (save-excursion | |
161 | (if (equal (marker-buffer cua--global-mark-marker) src-buf) | |
162 | (if (and (< start (marker-position cua--global-mark-marker)) | |
163 | (< (marker-position cua--global-mark-marker) end)) | |
c23eed1b | 164 | (message "Can't move region into itself") |
c5eb971b | 165 | (let ((text (cua--filter-buffer-noprops start end)) |
72cc582e KS |
166 | (p1 (copy-marker start)) |
167 | (p2 (copy-marker end))) | |
168 | (goto-char (marker-position cua--global-mark-marker)) | |
169 | (insert text) | |
170 | (cua--activate-global-mark) | |
171 | (delete-region (marker-position p1) (marker-position p2)) | |
172 | (move-marker p1 nil) | |
173 | (move-marker p2 nil))) | |
174 | (set-buffer (marker-buffer cua--global-mark-marker)) | |
175 | (goto-char (marker-position cua--global-mark-marker)) | |
176 | (insert-buffer-substring src-buf start end) | |
177 | (message "Moved %d to global mark in %s:%d" | |
178 | (abs (- end start)) | |
179 | (buffer-name (marker-buffer cua--global-mark-marker)) | |
180 | (marker-position cua--global-mark-marker)) | |
181 | (cua--activate-global-mark) | |
182 | (set-buffer src-buf) | |
183 | (delete-region start end)))) | |
184 | (cua--deactivate-global-mark) | |
185 | (message "No Global Mark"))) | |
186 | ||
187 | (defun cua--copy-rectangle-to-global-mark (as-text) | |
188 | ;; Copy rectangle to global mark buffer/position. | |
189 | (if (cua--global-mark-active) | |
190 | (let ((src-buf (current-buffer)) | |
191 | (text (cua--extract-rectangle))) | |
937e6a56 | 192 | (with-current-buffer (marker-buffer cua--global-mark-marker) |
72cc582e KS |
193 | (goto-char (marker-position cua--global-mark-marker)) |
194 | (if as-text | |
195 | (while text | |
196 | (insert-for-yank (car text)) | |
197 | (if (setq text (cdr text)) | |
198 | (insert "\n"))) | |
199 | (cua--insert-rectangle text 'auto)) | |
200 | (cua--activate-global-mark) | |
201 | (message "Copied rectangle to global mark in %s:%d" | |
202 | (buffer-name (marker-buffer cua--global-mark-marker)) | |
203 | (marker-position cua--global-mark-marker)))) | |
204 | (cua--deactivate-global-mark) | |
205 | (message "No Global Mark"))) | |
206 | ||
207 | (defun cua--cut-rectangle-to-global-mark (as-text) | |
208 | ;; Move rectangle to global buffer/position. | |
209 | (if (cua--global-mark-active) | |
210 | (let ((src-buf (current-buffer))) | |
211 | (save-excursion | |
212 | (if (equal (marker-buffer cua--global-mark-marker) src-buf) | |
213 | (let ((olist (overlays-at (marker-position cua--global-mark-marker))) | |
214 | in-rect) | |
215 | (while olist | |
1e98d199 | 216 | (if (eq (overlay-get (car olist) 'face) 'cua-rectangle) |
72cc582e KS |
217 | (setq in-rect t olist nil) |
218 | (setq olist (cdr olist)))) | |
219 | (if in-rect | |
c23eed1b | 220 | (message "Can't move rectangle into itself") |
72cc582e KS |
221 | (let ((text (cua--extract-rectangle))) |
222 | (cua--delete-rectangle) | |
223 | (goto-char (marker-position cua--global-mark-marker)) | |
224 | (if as-text | |
225 | (while text | |
226 | (insert-for-yank (car text)) | |
227 | (if (setq text (cdr text)) | |
228 | (insert "\n"))) | |
229 | (cua--insert-rectangle text 'auto)) | |
230 | (cua--activate-global-mark)))) | |
231 | (let ((text (cua--extract-rectangle))) | |
232 | (cua--delete-rectangle) | |
233 | (set-buffer (marker-buffer cua--global-mark-marker)) | |
234 | (goto-char (marker-position cua--global-mark-marker)) | |
235 | (cua--insert-rectangle text 'auto)) | |
236 | (message "Moved rectangle to global mark in %s:%d" | |
237 | (buffer-name (marker-buffer cua--global-mark-marker)) | |
238 | (marker-position cua--global-mark-marker)) | |
239 | (cua--activate-global-mark)))) | |
240 | (cua--deactivate-global-mark) | |
241 | (message "No Global Mark"))) | |
242 | ||
243 | (defun cua-copy-to-global-mark () | |
244 | "Copy active region/rectangle to global mark buffer/position." | |
245 | (interactive) | |
246 | (setq cua--last-killed-rectangle nil) | |
247 | (if cua--rectangle | |
248 | (cua--copy-rectangle-to-global-mark nil) | |
249 | (let ((start (mark)) (end (point))) | |
250 | (or (<= start end) | |
251 | (setq start (prog1 end (setq end start)))) | |
252 | (cua-copy-region-to-global-mark start end)))) | |
253 | ||
254 | (defun cua-copy-next-to-global-mark (n) | |
255 | "Copy the following N characters in buffer to global mark buffer/position." | |
256 | (interactive "p") | |
257 | (setq cua--last-killed-rectangle nil) | |
258 | (or (eobp) | |
259 | (let ((p (point))) | |
260 | (goto-char (+ p n)) | |
261 | (cua-copy-region-to-global-mark p (point))))) | |
262 | ||
263 | (defun cua-cut-to-global-mark () | |
264 | "Move active region/rectangle to global mark buffer/position." | |
265 | (interactive) | |
266 | (if buffer-read-only | |
267 | (cua-copy-to-global-mark) | |
268 | (setq cua--last-killed-rectangle nil) | |
269 | (if cua--rectangle | |
270 | (cua--cut-rectangle-to-global-mark nil) | |
271 | (let ((start (mark)) (end (point))) | |
272 | (or (<= start end) | |
273 | (setq start (prog1 end (setq end start)))) | |
274 | (cua-cut-region-to-global-mark start end))))) | |
275 | ||
276 | (defun cua-cut-next-to-global-mark (n) | |
277 | "Move the following N characters in buffer to global mark buffer/position." | |
278 | (interactive "p") | |
279 | (setq cua--last-killed-rectangle nil) | |
280 | (or (eobp) | |
281 | (let ((p (point))) | |
282 | (goto-char (+ p n)) | |
283 | (cua-cut-region-to-global-mark p (point))))) | |
284 | ||
285 | (defun cua-delete-char-at-global-mark (arg) | |
286 | "Delete character following the global mark position." | |
287 | (interactive "p") | |
288 | (cua--delete-at-global-mark arg "Deleted")) | |
289 | ||
290 | (defun cua-delete-backward-char-at-global-mark (arg) | |
291 | "Delete character before the global mark position." | |
292 | (interactive "p") | |
293 | (cua--delete-at-global-mark (- arg) "Deleted backward")) | |
294 | ||
295 | (defun cua-insert-char-at-global-mark () | |
296 | "Insert the character you type at the global mark position." | |
297 | (interactive) | |
298 | (cua--insert-at-global-mark (char-to-string (aref (this-single-command-keys) 0)) "Inserted")) | |
299 | ||
300 | (defun cua-insert-newline-at-global-mark () | |
301 | "Insert a newline at the global mark position." | |
302 | (interactive) | |
303 | (cua--insert-at-global-mark "\n")) | |
304 | ||
305 | (defun cua-indent-to-global-mark-column () | |
306 | "Indent current line or rectangle to global mark column." | |
307 | (interactive "*") | |
308 | (if (cua--global-mark-active) | |
309 | (let (col) | |
937e6a56 | 310 | (with-current-buffer (marker-buffer cua--global-mark-marker) |
72cc582e KS |
311 | (goto-char (marker-position cua--global-mark-marker)) |
312 | (setq col (current-column))) | |
313 | (if cua--rectangle | |
314 | (cua--indent-rectangle nil col t) | |
315 | (indent-to col)) | |
316 | (if (eq (current-buffer) (marker-buffer cua--global-mark-marker)) | |
317 | (save-excursion | |
318 | (goto-char (marker-position cua--global-mark-marker)) | |
319 | (move-to-column col) | |
320 | (move-marker cua--global-mark-marker (point)) | |
321 | (move-overlay cua--global-mark-overlay (point) (1+ (point)))))))) | |
a1506d29 | 322 | |
72cc582e KS |
323 | |
324 | (defun cua-cancel-global-mark () | |
325 | "Cancel the global mark." | |
326 | (interactive) | |
327 | (if mark-active | |
328 | (cua-cancel) | |
329 | (if (cua--global-mark-active) | |
330 | (cua--deactivate-global-mark t))) | |
331 | (cua--fallback)) | |
332 | ||
333 | ;;; Post-command hook for global mark. | |
334 | ||
335 | (defun cua--global-mark-post-command () | |
336 | (when (and (cua--global-mark-active) ;; Updates cua--global-mark-active variable | |
337 | cua-global-mark-keep-visible) | |
338 | ;; keep global mark position visible | |
339 | (sit-for 0) | |
340 | (if (or (not (eq (current-buffer) (marker-buffer cua--global-mark-marker))) | |
341 | (not (pos-visible-in-window-p (marker-position cua--global-mark-marker)))) | |
342 | (let ((w (selected-window)) (p (point)) h) | |
a1506d29 | 343 | ;; The following code is an attempt to keep the global mark visible in |
72cc582e KS |
344 | ;; other window -- but it doesn't work. |
345 | (switch-to-buffer-other-window (marker-buffer cua--global-mark-marker) t) | |
346 | (goto-char (marker-position cua--global-mark-marker)) | |
347 | (if (not (pos-visible-in-window-p (marker-position cua--global-mark-marker))) | |
348 | (recenter (if (> (setq h (- (window-height) 4)) 1) h '(4)))) | |
349 | (select-window w) | |
350 | (goto-char p))))) | |
351 | ||
352 | ;;; Initialization | |
353 | ||
354 | (defun cua--init-global-mark () | |
72cc582e KS |
355 | (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark) |
356 | (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark) | |
357 | (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark) | |
358 | (define-key cua--global-mark-keymap [remap yank] 'cua-copy-next-to-global-mark) | |
359 | ||
360 | (define-key cua--global-mark-keymap [remap keyboard-escape-quit] 'cua-cancel-global-mark) | |
361 | (define-key cua--global-mark-keymap [remap keyboard-quit] 'cua-cancel-global-mark) | |
362 | ||
363 | (define-key cua--global-mark-keymap [(control ?d)] 'cua-cut-next-to-global-mark) | |
364 | (define-key cua--global-mark-keymap [remap delete-backward-char] 'cua-delete-backward-char-at-global-mark) | |
365 | (define-key cua--global-mark-keymap [remap backward-delete-char] 'cua-delete-backward-char-at-global-mark) | |
366 | (define-key cua--global-mark-keymap [remap backward-delete-char-untabify] 'cua-delete-backward-char-at-global-mark) | |
367 | (define-key cua--global-mark-keymap [remap self-insert-command] 'cua-insert-char-at-global-mark) | |
368 | (define-key cua--global-mark-keymap [remap self-insert-iso] 'cua-insert-char-at-global-mark) | |
f8b38495 KS |
369 | |
370 | ;; Catch self-inserting characters which are "stolen" by other modes | |
371 | (define-key cua--global-mark-keymap [t] | |
372 | '(menu-item "sic" cua-insert-char-at-global-mark :filter cua--self-insert-char-p)) | |
373 | ||
72cc582e KS |
374 | (define-key cua--global-mark-keymap [remap newline] 'cua-insert-newline-at-global-mark) |
375 | (define-key cua--global-mark-keymap [remap newline-and-indent] 'cua-insert-newline-at-global-mark) | |
376 | (define-key cua--global-mark-keymap "\r" 'cua-insert-newline-at-global-mark) | |
377 | ||
378 | (define-key cua--global-mark-keymap "\t" 'cua-indent-to-global-mark-column) | |
379 | ||
380 | (setq cua--global-mark-initialized t)) | |
381 | ||
88a25b18 GM |
382 | (provide 'cua-gmrk) |
383 | ||
cbee283d | 384 | ;; arch-tag: 553d8076-a91d-48ae-825d-6cb962a5f67f |
72cc582e | 385 | ;;; cua-gmrk.el ends here |