Commit 27262e39 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Make CUA-mode use shift-select-mode.

* lisp/emulation/cua-base.el (cua--explicit-region-start)
(cua--last-region-shifted): Remove.
(cua--deactivate): Use deactivate-mark.
(cua--pre-command-handler-1): Don't handle shift-selection.
(cua--post-command-handler-1): Don't change transient-mark-mode.
(cua--select-keymaps): Use region-active-p rather than
cua--explicit-region-start or cua--last-region-shifted.
(cua-mode): Enable shift-select-mode.
* lisp/emulation/cua-rect.el (cua--rectangle-highlight-for-redisplay):
New function.
(redisplay-highlight-region-function): Use it.
parent e9551b12
2013-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
* emulation/cua-rect.el (cua--rectangle-highlight-for-redisplay):
New function.
(redisplay-highlight-region-function): Use it.
* emulation/cua-base.el (cua--explicit-region-start)
(cua--last-region-shifted): Remove.
(cua--deactivate): Use deactivate-mark.
(cua--pre-command-handler-1): Don't handle shift-selection.
(cua--post-command-handler-1): Don't change transient-mark-mode.
(cua--select-keymaps): Use region-active-p rather than
cua--explicit-region-start or cua--last-region-shifted.
(cua-mode): Enable shift-select-mode.
2013-12-08 Leo Liu <sdl.web@gmail.com> 2013-12-08 Leo Liu <sdl.web@gmail.com>
* progmodes/flymake.el (flymake-popup-current-error-menu): Rename * progmodes/flymake.el (flymake-popup-current-error-menu):
from flymake-display-err-menu-for-current-line. Reimplement. Rename from flymake-display-err-menu-for-current-line. Reimplement.
(flymake-posn-at-point-as-event, flymake-popup-menu) (flymake-posn-at-point-as-event, flymake-popup-menu)
(flymake-make-emacs-menu): Remove. (Bug#16077) (flymake-make-emacs-menu): Remove. (Bug#16077)
......
...@@ -625,13 +625,6 @@ a cons (TYPE . COLOR), then both properties are affected." ...@@ -625,13 +625,6 @@ a cons (TYPE . COLOR), then both properties are affected."
;;; Aux. variables ;;; Aux. variables
;; Current region was started using cua-set-mark.
(defvar cua--explicit-region-start nil)
(make-variable-buffer-local 'cua--explicit-region-start)
;; Latest region was started using shifted movement command.
(defvar cua--last-region-shifted nil)
;; buffer + point prior to current command when rectangle is active ;; buffer + point prior to current command when rectangle is active
;; checked in post-command hook to see if point was moved ;; checked in post-command hook to see if point was moved
(defvar cua--buffer-and-point-before-command nil) (defvar cua--buffer-and-point-before-command nil)
...@@ -762,11 +755,9 @@ Repeating prefix key when region is active works as a single prefix key." ...@@ -762,11 +755,9 @@ Repeating prefix key when region is active works as a single prefix key."
deactivate-mark nil)) deactivate-mark nil))
(defun cua--deactivate (&optional now) (defun cua--deactivate (&optional now)
(setq cua--explicit-region-start nil)
(if (not now) (if (not now)
(setq deactivate-mark t) (setq deactivate-mark t)
(setq mark-active nil) (deactivate-mark)))
(run-hooks 'deactivate-mark-hook)))
(defun cua--filter-buffer-noprops (start end) (defun cua--filter-buffer-noprops (start end)
(let ((str (filter-buffer-substring start end))) (let ((str (filter-buffer-substring start end)))
...@@ -862,7 +853,6 @@ With numeric prefix arg, copy to register 0-9 instead." ...@@ -862,7 +853,6 @@ With numeric prefix arg, copy to register 0-9 instead."
"Cancel the active region, rectangle, or global mark." "Cancel the active region, rectangle, or global mark."
(interactive) (interactive)
(setq mark-active nil) (setq mark-active nil)
(setq cua--explicit-region-start nil)
(if (fboundp 'cua--cancel-rectangle) (if (fboundp 'cua--cancel-rectangle)
(cua--cancel-rectangle))) (cua--cancel-rectangle)))
...@@ -1109,8 +1099,6 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark." ...@@ -1109,8 +1099,6 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark."
(message "Mark cleared")) (message "Mark cleared"))
(t (t
(push-mark-command nil nil) (push-mark-command nil nil)
(setq cua--explicit-region-start t)
(setq cua--last-region-shifted nil)
(if cua-enable-region-auto-help (if cua-enable-region-auto-help
(cua-help-for-region t))))) (cua-help-for-region t)))))
...@@ -1203,28 +1191,10 @@ If ARG is the atom `-', scroll upward by nearly full screen." ...@@ -1203,28 +1191,10 @@ If ARG is the atom `-', scroll upward by nearly full screen."
((not (eq (get this-command 'CUA) 'move)) ((not (eq (get this-command 'CUA) 'move))
nil) nil)
;; Handle shifted cursor keys and other movement commands.
;; If region is not active, region is activated if key is shifted.
;; If region is active, region is canceled if key is unshifted
;; (and region not started with C-SPC).
;; If rectangle is active, expand rectangle in specified direction and
;; ignore the movement.
(this-command-keys-shift-translated
(unless mark-active
(push-mark-command nil t))
(setq cua--last-region-shifted t)
(setq cua--explicit-region-start nil))
;; Set mark if user explicitly said to do so ;; Set mark if user explicitly said to do so
((or cua--explicit-region-start cua--rectangle) (cua--rectangle ;FIXME: ??
(unless mark-active (unless mark-active
(push-mark-command nil nil))) (push-mark-command nil nil))))
;; Else clear mark after this command.
(t
;; If we set mark-active to nil here, the region highlight will not be
;; removed by the direct_output_ commands.
(setq deactivate-mark t)))
;; Detect extension of rectangles by mouse or other movement ;; Detect extension of rectangles by mouse or other movement
(setq cua--buffer-and-point-before-command (setq cua--buffer-and-point-before-command
...@@ -1244,22 +1214,13 @@ If ARG is the atom `-', scroll upward by nearly full screen." ...@@ -1244,22 +1214,13 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(when (fboundp 'cua--rectangle-post-command) (when (fboundp 'cua--rectangle-post-command)
(cua--rectangle-post-command)) (cua--rectangle-post-command))
(setq cua--buffer-and-point-before-command nil) (setq cua--buffer-and-point-before-command nil)
(if (or (not mark-active) deactivate-mark)
(setq cua--explicit-region-start nil))
;; Debugging ;; Debugging
(if cua--debug (if cua--debug
(cond (cond
(cua--rectangle (cua--rectangle-assert)) (cua--rectangle (cua--rectangle-assert))
(mark-active (message "Mark=%d Point=%d Expl=%s" (mark-active (message "Mark=%d Point=%d" (mark t) (point)))))
(mark t) (point) cua--explicit-region-start))))
;; Disable transient-mark-mode if rectangle active in current buffer.
(if (not (window-minibuffer-p))
(setq transient-mark-mode (and (not cua--rectangle)
(if cua-highlight-region-shift-only
(not cua--explicit-region-start)
t))))
(if cua-enable-cursor-indications (if cua-enable-cursor-indications
(cua--update-indications)) (cua--update-indications))
...@@ -1323,7 +1284,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." ...@@ -1323,7 +1284,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
cua-enable-cua-keys cua-enable-cua-keys
(not cua-inhibit-cua-keys) (not cua-inhibit-cua-keys)
(or (eq cua-enable-cua-keys t) (or (eq cua-enable-cua-keys t)
(not cua--explicit-region-start)) (region-active-p))
(not executing-kbd-macro) (not executing-kbd-macro)
(not cua--prefix-override-timer))) (not cua--prefix-override-timer)))
(setq cua--ena-prefix-repeat-keymap (setq cua--ena-prefix-repeat-keymap
...@@ -1334,7 +1295,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." ...@@ -1334,7 +1295,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(and cua-enable-cua-keys (and cua-enable-cua-keys
(not cua-inhibit-cua-keys) (not cua-inhibit-cua-keys)
(or (eq cua-enable-cua-keys t) (or (eq cua-enable-cua-keys t)
cua--last-region-shifted))) (region-active-p))))
(setq cua--ena-global-mark-keymap (setq cua--ena-global-mark-keymap
(and cua--global-mark-active (and cua--global-mark-active
(not (window-minibuffer-p))))) (not (window-minibuffer-p)))))
...@@ -1546,11 +1507,8 @@ shifted movement key, set `cua-highlight-region-shift-only'." ...@@ -1546,11 +1507,8 @@ shifted movement key, set `cua-highlight-region-shift-only'."
(if (and (boundp 'pc-selection-mode) pc-selection-mode) (if (and (boundp 'pc-selection-mode) pc-selection-mode)
(pc-selection-mode -1)) (pc-selection-mode -1))
(cua--deactivate) (cua--deactivate)
(setq shift-select-mode nil) (setq shift-select-mode t)
(setq transient-mark-mode (and cua-mode (transient-mark-mode (if cua-highlight-region-shift-only -1 1)))
(if cua-highlight-region-shift-only
(not cua--explicit-region-start)
t))))
(cua--saved-state (cua--saved-state
(setq transient-mark-mode (car cua--saved-state)) (setq transient-mark-mode (car cua--saved-state))
(if (nth 1 cua--saved-state) (if (nth 1 cua--saved-state)
......
...@@ -877,8 +877,7 @@ With prefix argument, activate previous rectangle if possible." ...@@ -877,8 +877,7 @@ With prefix argument, activate previous rectangle if possible."
(push-mark nil nil t))) (push-mark nil nil t)))
(cua--activate-rectangle) (cua--activate-rectangle)
(cua--rectangle-set-corners) (cua--rectangle-set-corners)
(setq mark-active t (setq mark-active t)
cua--explicit-region-start t)
(if cua-enable-rectangle-auto-help (if cua-enable-rectangle-auto-help
(cua-help-for-rectangle t)))) (cua-help-for-rectangle t))))
...@@ -886,8 +885,7 @@ With prefix argument, activate previous rectangle if possible." ...@@ -886,8 +885,7 @@ With prefix argument, activate previous rectangle if possible."
"Cancel current rectangle." "Cancel current rectangle."
(interactive) (interactive)
(when cua--rectangle (when cua--rectangle
(setq mark-active nil (setq mark-active nil)
cua--explicit-region-start nil)
(cua--deactivate-rectangle))) (cua--deactivate-rectangle)))
(defun cua-toggle-rectangle-mark () (defun cua-toggle-rectangle-mark ()
...@@ -1378,6 +1376,14 @@ With prefix arg, indent to that column." ...@@ -1378,6 +1376,14 @@ With prefix arg, indent to that column."
(add-function :around region-extract-function (add-function :around region-extract-function
#'cua--rectangle-region-extract) #'cua--rectangle-region-extract)
(add-function :around redisplay-highlight-region-function
#'cua--rectangle-highlight-for-redisplay)
(defun cua--rectangle-highlight-for-redisplay (orig &rest args)
(if (not cua--rectangle) (apply orig args)
;; When cua--rectangle is active, just don't highlight at all, since we
;; already do it elsewhere.
))
(defun cua--rectangle-region-extract (orig &optional delete) (defun cua--rectangle-region-extract (orig &optional delete)
(cond (cond
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment