Lines Matching +defs:cua +defs:toggle +defs:global +defs:mark
0 ;;; cua-gmrk.el --- CUA unified global mark support
6 ;; Author: Kim F. Storm <storm@cua.dk>
7 ;; Keywords: keyboard emulations convenience cua mark
30 (provide 'cua-gmrk)
33 (require 'cua-base)
34 (require 'cua-rect)
39 ;; Non-nil when global marker is active.
40 (defvar cua--global-mark-active nil)
42 ;; Global mark position marker.
43 (defvar cua--global-mark-marker nil)
45 ;; Overlay for global mark position.
46 (defvar cua--global-mark-overlay nil)
48 ;; Initialize global mark things once...
49 (defvar cua--global-mark-initialized nil)
52 (defvar cua--orig-blink-cursor-interval nil)
54 (defun cua--deactivate-global-mark (&optional msg)
55 (when cua--global-mark-overlay
56 (delete-overlay cua--global-mark-overlay)
57 (setq cua--global-mark-overlay nil))
58 (if (markerp cua--global-mark-marker)
59 (move-marker cua--global-mark-marker nil))
60 (if cua--orig-blink-cursor-interval
61 (setq blink-cursor-interval cua--orig-blink-cursor-interval
62 cua--orig-blink-cursor-interval nil))
63 (setq cua--global-mark-active nil)
67 (defun cua--activate-global-mark (&optional msg)
68 (if (not (markerp cua--global-mark-marker))
69 (setq cua--global-mark-marker (make-marker)))
73 (move-marker cua--global-mark-marker (point))
74 (if (overlayp cua--global-mark-overlay)
75 (move-overlay cua--global-mark-overlay (point) (1+ (point)))
76 (setq cua--global-mark-overlay
78 (overlay-put cua--global-mark-overlay 'face 'cua-global-mark))
79 (if (and cua-global-mark-blink-cursor-interval
80 (not cua--orig-blink-cursor-interval))
81 (setq cua--orig-blink-cursor-interval blink-cursor-interval
82 blink-cursor-interval cua-global-mark-blink-cursor-interval))
83 (setq cua--global-mark-active t)
87 (defun cua--global-mark-active ()
88 (if cua--global-mark-active
89 (or (and (markerp cua--global-mark-marker)
90 (marker-buffer cua--global-mark-marker))
91 (and (cua--deactivate-global-mark nil)
94 (defun cua-toggle-global-mark (stay)
95 "Set or cancel the global marker.
96 When the global marker is set, CUA cut and copy commands will automatically
97 insert the deleted or copied text before the global marker, even when the
98 global marker is in another buffer.
99 If the global marker isn't set, set the global marker at point in the current
100 buffer. Otherwise jump to the global marker position and cancel it.
101 With prefix argument, don't jump to global mark when cancelling it."
103 (unless cua--global-mark-initialized
104 (cua--init-global-mark))
105 (if (not (cua--global-mark-active))
107 (cua--activate-global-mark t)
109 (message "Cannot set global mark in read-only buffer"))
111 (pop-to-buffer (marker-buffer cua--global-mark-marker))
112 (goto-char cua--global-mark-marker))
113 (cua--deactivate-global-mark t)))
115 (defun cua--insert-at-global-mark (str &optional msg)
116 ;; Insert string at global marker and move marker
118 (set-buffer (marker-buffer cua--global-mark-marker))
119 (goto-char (marker-position cua--global-mark-marker))
121 (cua--activate-global-mark))
123 (message "%s %d to global mark in %s:%d" msg
125 (buffer-name (marker-buffer cua--global-mark-marker))
126 (marker-position cua--global-mark-marker))))
128 (defun cua--delete-at-global-mark (arg &optional msg)
129 ;; Delete chars at global marker
131 (set-buffer (marker-buffer cua--global-mark-marker))
132 (goto-char (marker-position cua--global-mark-marker))
135 (message "%s %d chars at global mark in %s:%d" msg arg
136 (buffer-name (marker-buffer cua--global-mark-marker))
137 (marker-position cua--global-mark-marker))))
139 (defun cua-copy-region-to-global-mark (start end)
140 "Copy region to global mark buffer/position."
142 (if (cua--global-mark-active)
145 (if (equal (marker-buffer cua--global-mark-marker) src-buf)
147 (goto-char (marker-position cua--global-mark-marker))
149 (set-buffer (marker-buffer cua--global-mark-marker))
150 (goto-char (marker-position cua--global-mark-marker))
152 (cua--activate-global-mark)
153 (message "Copied %d to global mark in %s:%d"
155 (buffer-name (marker-buffer cua--global-mark-marker))
156 (marker-position cua--global-mark-marker))))
157 (cua--deactivate-global-mark)
160 (defun cua-cut-region-to-global-mark (start end)
161 "Move region to global buffer/position."
163 (if (cua--global-mark-active)
166 (if (equal (marker-buffer cua--global-mark-marker) src-buf)
167 (if (and (< start (marker-position cua--global-mark-marker))
168 (< (marker-position cua--global-mark-marker) end))
173 (goto-char (marker-position cua--global-mark-marker))
175 (cua--activate-global-mark)
179 (set-buffer (marker-buffer cua--global-mark-marker))
180 (goto-char (marker-position cua--global-mark-marker))
182 (message "Moved %d to global mark in %s:%d"
184 (buffer-name (marker-buffer cua--global-mark-marker))
185 (marker-position cua--global-mark-marker))
186 (cua--activate-global-mark)
189 (cua--deactivate-global-mark)
192 (defun cua--copy-rectangle-to-global-mark (as-text)
193 ;; Copy rectangle to global mark buffer/position.
194 (if (cua--global-mark-active)
196 (text (cua--extract-rectangle)))
198 (set-buffer (marker-buffer cua--global-mark-marker))
199 (goto-char (marker-position cua--global-mark-marker))
205 (cua--insert-rectangle text 'auto))
206 (cua--activate-global-mark)
207 (message "Copied rectangle to global mark in %s:%d"
208 (buffer-name (marker-buffer cua--global-mark-marker))
209 (marker-position cua--global-mark-marker))))
210 (cua--deactivate-global-mark)
213 (defun cua--cut-rectangle-to-global-mark (as-text)
214 ;; Move rectangle to global buffer/position.
215 (if (cua--global-mark-active)
218 (if (equal (marker-buffer cua--global-mark-marker) src-buf)
219 (let ((olist (overlays-at (marker-position cua--global-mark-marker)))
222 (if (eq (overlay-get (car olist) 'face) 'cua-rectangle)
227 (let ((text (cua--extract-rectangle)))
228 (cua--delete-rectangle)
229 (goto-char (marker-position cua--global-mark-marker))
235 (cua--insert-rectangle text 'auto))
236 (cua--activate-global-mark))))
237 (let ((text (cua--extract-rectangle)))
238 (cua--delete-rectangle)
239 (set-buffer (marker-buffer cua--global-mark-marker))
240 (goto-char (marker-position cua--global-mark-marker))
241 (cua--insert-rectangle text 'auto))
242 (message "Moved rectangle to global mark in %s:%d"
243 (buffer-name (marker-buffer cua--global-mark-marker))
244 (marker-position cua--global-mark-marker))
245 (cua--activate-global-mark))))
246 (cua--deactivate-global-mark)
249 (defun cua-copy-to-global-mark ()
250 "Copy active region/rectangle to global mark buffer/position."
252 (setq cua--last-killed-rectangle nil)
253 (if cua--rectangle
254 (cua--copy-rectangle-to-global-mark nil)
255 (let ((start (mark)) (end (point)))
258 (cua-copy-region-to-global-mark start end))))
260 (defun cua-copy-next-to-global-mark (n)
261 "Copy the following N characters in buffer to global mark buffer/position."
263 (setq cua--last-killed-rectangle nil)
267 (cua-copy-region-to-global-mark p (point)))))
269 (defun cua-cut-to-global-mark ()
270 "Move active region/rectangle to global mark buffer/position."
273 (cua-copy-to-global-mark)
274 (setq cua--last-killed-rectangle nil)
275 (if cua--rectangle
276 (cua--cut-rectangle-to-global-mark nil)
277 (let ((start (mark)) (end (point)))
280 (cua-cut-region-to-global-mark start end)))))
282 (defun cua-cut-next-to-global-mark (n)
283 "Move the following N characters in buffer to global mark buffer/position."
285 (setq cua--last-killed-rectangle nil)
289 (cua-cut-region-to-global-mark p (point)))))
291 (defun cua-delete-char-at-global-mark (arg)
292 "Delete character following the global mark position."
294 (cua--delete-at-global-mark arg "Deleted"))
296 (defun cua-delete-backward-char-at-global-mark (arg)
297 "Delete character before the global mark position."
299 (cua--delete-at-global-mark (- arg) "Deleted backward"))
301 (defun cua-insert-char-at-global-mark ()
302 "Insert the character you type at the global mark position."
304 (cua--insert-at-global-mark (char-to-string (aref (this-single-command-keys) 0)) "Inserted"))
306 (defun cua-insert-newline-at-global-mark ()
307 "Insert a newline at the global mark position."
309 (cua--insert-at-global-mark "\n"))
311 (defun cua-indent-to-global-mark-column ()
312 "Indent current line or rectangle to global mark column."
314 (if (cua--global-mark-active)
317 (set-buffer (marker-buffer cua--global-mark-marker))
318 (goto-char (marker-position cua--global-mark-marker))
320 (if cua--rectangle
321 (cua--indent-rectangle nil col t)
323 (if (eq (current-buffer) (marker-buffer cua--global-mark-marker))
325 (goto-char (marker-position cua--global-mark-marker))
327 (move-marker cua--global-mark-marker (point))
328 (move-overlay cua--global-mark-overlay (point) (1+ (point))))))))
331 (defun cua-cancel-global-mark ()
332 "Cancel the global mark."
334 (if mark-active
335 (cua-cancel)
336 (if (cua--global-mark-active)
337 (cua--deactivate-global-mark t)))
338 (cua--fallback))
340 ;;; Post-command hook for global mark.
342 (defun cua--global-mark-post-command ()
343 (when (and (cua--global-mark-active) ;; Updates cua--global-mark-active variable
344 cua-global-mark-keep-visible)
345 ;; keep global mark position visible
347 (if (or (not (eq (current-buffer) (marker-buffer cua--global-mark-marker)))
348 (not (pos-visible-in-window-p (marker-position cua--global-mark-marker))))
350 ;; The following code is an attempt to keep the global mark visible in
352 (switch-to-buffer-other-window (marker-buffer cua--global-mark-marker) t)
353 (goto-char (marker-position cua--global-mark-marker))
354 (if (not (pos-visible-in-window-p (marker-position cua--global-mark-marker)))
361 (defun cua--init-global-mark ()
362 (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark)
363 (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark)
364 (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark)
365 (define-key cua--global-mark-keymap [remap yank] 'cua-copy-next-to-global-mark)
367 (define-key cua--global-mark-keymap [remap keyboard-escape-quit] 'cua-cancel-global-mark)
368 (define-key cua--global-mark-keymap [remap keyboard-quit] 'cua-cancel-global-mark)
370 (define-key cua--global-mark-keymap [(control ?d)] 'cua-cut-next-to-global-mark)
371 (define-key cua--global-mark-keymap [remap delete-backward-char] 'cua-delete-backward-char-at-global-mark)
372 (define-key cua--global-mark-keymap [remap backward-delete-char] 'cua-delete-backward-char-at-global-mark)
373 (define-key cua--global-mark-keymap [remap backward-delete-char-untabify] 'cua-delete-backward-char-at-global-mark)
374 (define-key cua--global-mark-keymap [remap self-insert-command] 'cua-insert-char-at-global-mark)
375 (define-key cua--global-mark-keymap [remap self-insert-iso] 'cua-insert-char-at-global-mark)
378 (define-key cua--global-mark-keymap [t]
379 '(menu-item "sic" cua-insert-char-at-global-mark :filter cua--self-insert-char-p))
381 (define-key cua--global-mark-keymap [remap newline] 'cua-insert-newline-at-global-mark)
382 (define-key cua--global-mark-keymap [remap newline-and-indent] 'cua-insert-newline-at-global-mark)
383 (define-key cua--global-mark-keymap "\r" 'cua-insert-newline-at-global-mark)
385 (define-key cua--global-mark-keymap "\t" 'cua-indent-to-global-mark-column)
387 (setq cua--global-mark-initialized t))
390 ;;; cua-gmrk.el ends here