;;; cua-rect.el --- CUA unified rectangle support
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2016 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience CUA
(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))
'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)
(setq rect (cons row rect))))))
(nreverse rect)))
+(defun cua--extract-rectangle-bounds ()
+ (let (rect)
+ (if (not (cua--rectangle-virtual-edges))
+ (cua--rectangle-operation nil nil nil nil nil ; do not tabify
+ (lambda (s e _l _r)
+ (setq rect (cons (cons s e) rect))))
+ (cua--rectangle-operation nil 1 nil nil nil ; do not tabify
+ (lambda (s e l r _v)
+ (goto-char s)
+ (move-to-column l)
+ (setq s (point))
+ (move-to-column r)
+ (setq e (point))
+ (setq rect (cons (cons s e) rect)))))
+ (nreverse rect)))
+
(defun cua--insert-rectangle (rect &optional below paste-column line-count)
;; Insert rectangle as insert-rectangle, but don't set mark and exit with
;; point at either next to top right or below bottom left corner
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
+ (or (and cua--last-rectangle
(eq (car cua--last-rectangle) (current-buffer))
- (eq (car (cdr cua--last-rectangle)) (point)))
- (cdr (cdr cua--last-rectangle))
- (cua--rectangle-get-corners))
+ (eq (car (cdr cua--last-rectangle)) (point))
+ (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.
(make-string
(- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
(if cua--virtual-edges-debug ?. ?\s))
- 'face (or (get-text-property (1- s) 'face) 'default)))
+ 'face (or (get-text-property (max (1- s) (point-min)) 'face) 'default)))
(if (/= pl le)
(setq s (1- s))))
(cond
(push-mark nil nil t)))
(cua--activate-rectangle)
(cua--rectangle-set-corners)
- (setq mark-active t
- cua--explicit-region-start t)
(if cua-enable-rectangle-auto-help
(cua-help-for-rectangle t))))
"Cancel current rectangle."
(interactive)
(when cua--rectangle
- (setq mark-active nil
- cua--explicit-region-start nil)
+ (setq mark-active nil)
(cua--deactivate-rectangle)))
(defun cua-toggle-rectangle-mark ()
(add-function :around region-extract-function
#'cua--rectangle-region-extract)
+(add-function :around region-insert-function
+ #'cua--insert-rectangle)
+(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.
+ (funcall redisplay-unhighlight-region-function (nth 3 args))))
(defun cua--rectangle-region-extract (orig &optional delete)
(cond
- ((not cua--rectangle) (funcall orig delete))
- ((eq delete 'delete-only) (cua--delete-rectangle))
+ ((not cua--rectangle)
+ (funcall orig delete))
+ ((eq delete 'bounds)
+ (cua--extract-rectangle-bounds))
+ ((eq delete 'delete-only)
+ (cua--delete-rectangle))
(t
(let* ((strs (cua--extract-rectangle))
(str (mapconcat #'identity strs "\n")))