2013-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
+ * emulation/cua-rect.el (cua--rectangle-region-extract): New function.
+ (region-extract-function): Use it.
+ (cua-mouse-save-then-kill-rectangle): Use cua-copy-region.
+ (cua-copy-rectangle, cua-cut-rectangle, cua-delete-rectangle):
+ Delete functions.
+ (cua--init-rectangles): Don't re-remap copy-region-as-kill,
+ kill-ring-save, kill-region, delete-char, delete-forward-char.
+ Ignore self-insert-iso.
+
+ * emulation/cua-gmrk.el (cua--init-global-mark):
+ Ignore `self-insert-iso'.
+
+ * emulation/cua-base.el (cua--prefix-copy-handler)
+ (cua--prefix-cut-handler): Rely on region-extract-function rather than
+ checking cua--rectangle.
+ (cua-delete-region): Use region-extract-function.
+ (cua-replace-region): Delete function.
+ (cua-copy-region, cua-cut-region): Obey region-extract-function.
+ (cua--pre-command-handler-1): Don't do the delete-selection thing.
+ (cua--self-insert-char-p): Ignore `self-insert-iso'.
+ (cua--init-keymaps): Don't remap delete-selection commands.
+ (cua-mode): Use delete-selection-mode instead of rolling our own
+ (bug#16085).
+
+ * menu-bar.el (clipboard-kill-ring-save, clipboard-kill-region):
+ Obey region-extract-function.
+
Make registers and delete-selection-mode work on rectangles.
* register.el (describe-register-1): Don't modify the register's value.
(copy-to-register): Obey region-extract-function.
;; This is done by highlighting the first occurrence of "redo"
;; and type "repeat" M-v M-v.
-;; Note: Since CUA-mode duplicates the functionality of the
-;; delete-selection-mode, that mode is automatically disabled when
-;; CUA-mode is enabled.
-
;; CUA mode indications
;; --------------------
cua--last-killed-rectangle nil))
;; All behind cua--rectangle tests.
-(declare-function cua-copy-rectangle "cua-rect" (arg))
-(declare-function cua-cut-rectangle "cua-rect" (arg))
(declare-function cua--rectangle-left "cua-rect" (&optional val))
(declare-function cua--delete-rectangle "cua-rect" ())
(declare-function cua--insert-rectangle "cua-rect"
(defun cua--prefix-copy-handler (arg)
"Copy region/rectangle, then replay last key."
(interactive "P")
- (if cua--rectangle
- (cua-copy-rectangle arg)
- (cua-copy-region arg))
+ (cua-copy-region arg)
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
(defun cua--prefix-cut-handler (arg)
"Cut region/rectangle, then replay last key."
(interactive "P")
- (if cua--rectangle
- (cua-cut-rectangle arg)
- (cua-cut-region arg))
+ (cua-cut-region arg)
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
(let ((start (mark)) (end (point)))
(or (<= start end)
(setq start (prog1 end (setq end start))))
- (setq cua--last-deleted-region-text (filter-buffer-substring start end))
+ (setq cua--last-deleted-region-text
+ (funcall region-extract-function t))
(if cua-delete-copy-to-register-0
(set-register ?0 cua--last-deleted-region-text))
- (delete-region start end)
(setq cua--last-deleted-region-pos
(cons (current-buffer)
(and (consp buffer-undo-list)
(cua--deactivate)
(/= start end)))
-(defun cua-replace-region ()
- "Replace the active region with the character you type."
- (interactive)
- (let ((not-empty (and cua-delete-selection (cua-delete-region))))
- (unless (eq this-original-command this-command)
- (let ((overwrite-mode
- (and overwrite-mode
- not-empty
- (not (eq this-original-command 'self-insert-command)))))
- (cua--fallback)))))
-
(defun cua-copy-region (arg)
"Copy the region to the kill ring.
With numeric prefix arg, copy to register 0-9 instead."
(setq start (prog1 end (setq end start))))
(cond
(cua--register
- (copy-to-register cua--register start end nil))
+ (copy-to-register cua--register start end nil 'region))
((eq this-original-command 'clipboard-kill-ring-save)
- (clipboard-kill-ring-save start end))
+ (clipboard-kill-ring-save start end 'region))
(t
- (copy-region-as-kill start end)))
+ (copy-region-as-kill start end 'region)))
(if cua-keep-region-after-copy
(cua--keep-active)
(cua--deactivate))))
(setq start (prog1 end (setq end start))))
(cond
(cua--register
- (copy-to-register cua--register start end t))
+ (copy-to-register cua--register start end t 'region))
((eq this-original-command 'clipboard-kill-region)
- (clipboard-kill-region start end))
+ (clipboard-kill-region start end 'region))
(t
- (kill-region start end))))
+ (kill-region start end 'region))))
(cua--deactivate)))
;;; Generic commands for regions, rectangles, and global marks
(if cua-enable-region-auto-help
(cua-help-for-region t)))))
-;;; Scrolling commands which does not signal errors at top/bottom
-;;; of buffer at first key-press (instead moves to top/bottom
-;;; of buffer).
+;; Scrolling commands which do not signal errors at top/bottom
+;; of buffer at first key-press (instead moves to top/bottom
+;; of buffer).
(defun cua-scroll-up (&optional arg)
"Scroll text of current window upward ARG lines; or near full screen if no ARG.
((not (symbolp this-command))
nil)
- ;; Handle delete-selection property on non-movement commands
((not (eq (get this-command 'CUA) 'move))
- (when (and mark-active (not deactivate-mark))
- (let* ((ds (or (get this-command 'delete-selection)
- (get this-command 'pending-delete)))
- (nc (cond
- ((not ds) nil)
- ((eq ds 'yank)
- 'cua-paste)
- ((eq ds 'kill)
- (if cua--rectangle
- 'cua-copy-rectangle
- 'cua-copy-region))
- ((eq ds 'supersede)
- (if cua--rectangle
- 'cua-delete-rectangle
- 'cua-delete-region))
- (t
- (if cua--rectangle
- 'cua-delete-rectangle ;; replace?
- 'cua-replace-region)))))
- (if nc
- (setq this-original-command this-command
- this-command nc)))))
+ nil)
;; Handle shifted cursor keys and other movement commands.
;; If region is not active, region is activated if key is shifted.
;; Return DEF if current key sequence is self-inserting in
;; global-map.
(if (memq (global-key-binding (this-single-command-keys))
- '(self-insert-command self-insert-iso))
+ '(self-insert-command))
def nil))
(defvar cua-global-keymap (make-sparse-keymap)
(define-key cua--region-keymap [(shift control x)] 'cua--shift-control-x-prefix)
(define-key cua--region-keymap [(shift control c)] 'cua--shift-control-c-prefix)
- ;; replace current region
- (define-key cua--region-keymap [remap self-insert-command] 'cua-replace-region)
- (define-key cua--region-keymap [remap self-insert-iso] 'cua-replace-region)
- (define-key cua--region-keymap [remap insert-register] 'cua-replace-region)
- (define-key cua--region-keymap [remap newline-and-indent] 'cua-replace-region)
- (define-key cua--region-keymap [remap newline] 'cua-replace-region)
- (define-key cua--region-keymap [remap open-line] 'cua-replace-region)
;; delete current region
(define-key cua--region-keymap [remap delete-backward-char] 'cua-delete-region)
(define-key cua--region-keymap [remap backward-delete-char] 'cua-delete-region)
(and (boundp 'delete-selection-mode) delete-selection-mode)
(and (boundp 'pc-selection-mode) pc-selection-mode)
shift-select-mode))
- (if (and (boundp 'delete-selection-mode) delete-selection-mode)
- (delete-selection-mode -1))
+ (if cua-delete-selection
+ (delete-selection-mode 1)
+ (if (and (boundp 'delete-selection-mode) delete-selection-mode)
+ (delete-selection-mode -1)))
(if (and (boundp 'pc-selection-mode) pc-selection-mode)
(pc-selection-mode -1))
(cua--deactivate)
(cua--saved-state
(setq transient-mark-mode (car cua--saved-state))
(if (nth 1 cua--saved-state)
- (delete-selection-mode 1))
+ (delete-selection-mode 1)
+ (if (and (boundp 'delete-selection-mode) delete-selection-mode)
+ (delete-selection-mode -1)))
(if (nth 2 cua--saved-state)
(pc-selection-mode 1))
(setq shift-select-mode (nth 3 cua--saved-state))
(cua--deactivate))
(cua-mouse-resize-rectangle event)
(let ((cua-keep-region-after-copy t))
- (cua-copy-rectangle arg)
+ (cua-copy-region arg)
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
(defun cua--mouse-ignore (_event)
(interactive)
(cua--rectangle-move 'right))
-(defun cua-copy-rectangle (arg)
- (interactive "P")
- (setq arg (cua--prefix-arg arg))
- (cua--copy-rectangle-as-kill arg)
- (if cua-keep-region-after-copy
- (cua--keep-active)
- (cua--deactivate)))
-
-(defun cua-cut-rectangle (arg)
- (interactive "P")
- (if buffer-read-only
- (cua-copy-rectangle arg)
- (setq arg (cua--prefix-arg arg))
- (goto-char (min (mark) (point)))
- (cua--copy-rectangle-as-kill arg)
- (cua--delete-rectangle))
- (cua--deactivate))
-
-(defun cua-delete-rectangle ()
- (interactive)
- (goto-char (min (point) (mark)))
- (if cua-delete-copy-to-register-0
- (set-register ?0 (cua--extract-rectangle)))
- (cua--delete-rectangle)
- (cua--deactivate))
-
(defun cua-rotate-rectangle ()
(interactive)
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
(goto-char cua--rect-undo-set-point)
(setq cua--rect-undo-set-point nil)))
+(add-function :around region-extract-function
+ #'cua--rectangle-region-extract)
+
+(defun cua--rectangle-region-extract (orig &optional delete)
+ (cond
+ ((not cua--rectangle) (funcall orig delete))
+ ((eq delete 'delete-only) (cua--delete-rectangle))
+ (t
+ (let* ((strs (cua--extract-rectangle))
+ (str (mapconcat #'identity strs "\n")))
+ (if delete (cua--delete-rectangle))
+ (setq killed-rectangle strs)
+ (setq cua--last-killed-rectangle
+ (cons (and kill-ring (car kill-ring)) killed-rectangle))
+ (when (eq last-command 'kill-region)
+ ;; Try to prevent kill-region from appending this to some
+ ;; earlier element.
+ (setq last-command 'kill-region-dont-append))
+ (when strs
+ (put-text-property 0 (length str) 'yank-handler
+ `(rectangle--insert-for-yank ,strs t)
+ str)
+ str)))))
+
;;; Initialization
(defun cua--rect-M/H-key (key cmd)
(cua--rect-M/H-key ?\s 'cua-clear-rectangle-mark)
(cua--M/H-key cua--region-keymap ?\s 'cua-toggle-rectangle-mark))
- (define-key cua--rectangle-keymap [remap copy-region-as-kill] 'cua-copy-rectangle)
- (define-key cua--rectangle-keymap [remap kill-ring-save] 'cua-copy-rectangle)
- (define-key cua--rectangle-keymap [remap kill-region] 'cua-cut-rectangle)
- (define-key cua--rectangle-keymap [remap delete-char] 'cua-delete-rectangle)
- (define-key cua--rectangle-keymap [remap delete-forward-char] 'cua-delete-rectangle)
(define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark)
(define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right)
(define-key cua--rectangle-keymap [remap backward-delete-char] 'cua-delete-char-rectangle)
(define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle)
(define-key cua--rectangle-keymap [remap self-insert-command] 'cua-insert-char-rectangle)
- (define-key cua--rectangle-keymap [remap self-insert-iso] 'cua-insert-char-rectangle)
;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--rectangle-keymap [t]
projects / emacs.git / commitdiff