X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/27262e39e6a1da5db8cf0735615193efc49b9ad7..ce8171797dafbde765170b79e5f154afc4872e86:/lisp/emulation/cua-rect.el diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 8941bf27de..d516bd4c7c 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -1,6 +1,6 @@ ;;; cua-rect.el --- CUA unified rectangle support -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Kim F. Storm ;; Keywords: keyboard emulations convenience CUA @@ -78,7 +78,7 @@ (push (list 'apply 0 s e 'cua--rect-undo-handler (copy-sequence cua--rectangle) t s e) - buffer-undo-list)))) + buffer-undo-list)))) (defun cua--rect-undo-handler (rect on s e) (if (setq on (not on)) @@ -89,6 +89,21 @@ 'cua--rect-undo-handler rect on s e) buffer-undo-list)) +;;;###autoload +(define-minor-mode cua-rectangle-mark-mode + "Toggle the region as rectangular. +Activates the region if needed. Only lasts until the region is deactivated." + :keymap cua--rectangle-keymap + (cond + (cua-rectangle-mark-mode + (add-hook 'deactivate-mark-hook + (lambda () (cua-rectangle-mark-mode -1))) + (add-hook 'post-command-hook #'cua--rectangle-post-command nil t) + (cua-set-rectangle-mark)) + (t + (cua--deactivate-rectangle) + (remove-hook 'post-command-hook #'cua--rectangle-post-command t)))) + ;;; Rectangle geometry (defun cua--rectangle-top (&optional val) @@ -708,8 +723,7 @@ If command is repeated at same position, delete the rectangle." killed-rectangle ""))))) (defun cua--activate-rectangle () - ;; Turn on rectangular marking mode by disabling transient mark mode - ;; and manually handling highlighting from a post command hook. + ;; Set cua--rectangle to indicate we're marking a rectangle. ;; Be careful if we are already marking a rectangle. (setq cua--rectangle (if (and cua--last-rectangle @@ -718,20 +732,25 @@ If command is repeated at same position, delete the rectangle." (cdr (cdr cua--last-rectangle)) (cua--rectangle-get-corners)) cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "") - cua--last-rectangle nil)) + cua--last-rectangle nil) + (activate-mark)) ;; (defvar cua-save-point nil) (defun cua--deactivate-rectangle () ;; This is used to clean up after `cua--activate-rectangle'. - (mapc (function delete-overlay) cua--rectangle-overlays) + (mapc #'delete-overlay cua--rectangle-overlays) (setq cua--last-rectangle (cons (current-buffer) (cons (point) ;; cua-save-point cua--rectangle)) cua--rectangle nil cua--rectangle-overlays nil cua--status-string nil - cua--mouse-last-pos nil)) + cua--mouse-last-pos nil) + ;; FIXME: This call to cua-rectangle-mark-mode is a workaround. + ;; Deactivation can happen in various different ways, and we + ;; currently don't handle them all in a coherent way. + (if cua-rectangle-mark-mode (cua-rectangle-mark-mode -1))) (defun cua--highlight-rectangle () ;; This function is used to highlight the rectangular region. @@ -877,7 +896,6 @@ With prefix argument, activate previous rectangle if possible." (push-mark nil nil t))) (cua--activate-rectangle) (cua--rectangle-set-corners) - (setq mark-active t) (if cua-enable-rectangle-auto-help (cua-help-for-rectangle t)))) @@ -1383,7 +1401,7 @@ With prefix arg, indent to that column." (if (not cua--rectangle) (apply orig args) ;; When cua--rectangle is active, just don't highlight at all, since we ;; already do it elsewhere. - )) + (funcall redisplay-unhighlight-region-function (nth 3 args)))) (defun cua--rectangle-region-extract (orig &optional delete) (cond