diff lisp/emulation/cua-rect.el @ 44938:358d42530d42

Added cua-mode based files [split from original cua.el]: cua-base.el, cua-rect.el, cua-gmrk.el, and keypad.el

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/emulation/cua-rect.el	Sun Apr 28 21:48:39 2002 +0000
@@ -0,0 +1,1375 @@
+;;; cua-rect.el --- CUA unified rectangle support
+
+;; Copyright (C) 1997-2002 Free Software Foundation, Inc.
+
+;; Author: Kim F. Storm <[e-mail]>
+;; Keywords: keyboard emulations convenience CUA
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Acknowledgements
+
+;; The rectangle handling and display code borrows from the standard
+;; GNU emacs rect.el package and the the rect-mark.el package by Rick
+;; Sladkey <[e-mail]>.
+
+(provide 'cua-rect)
+
+(eval-when-compile
+  (require 'cua-base)
+  (require 'cua-gmrk)
+)
+
+;;; Rectangle support
+
+(require 'rect)
+
+;; If non-nil, restrict current region to this rectangle.
+;; Value is a vector [top bot left right corner ins pad select].
+;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
+;; INS specifies whether to insert on left(nil) or right(t) side.
+;; If PAD is non-nil, tabs are converted to spaces when necessary.
+;; If SELECT is a regexp, only lines starting with that regexp are affected.")
+(defvar cua--rectangle nil)
+(make-variable-buffer-local 'cua--rectangle)
+
+;; Most recent rectangle geometry.  Note: car is buffer.
+(defvar cua--last-rectangle nil)
+
+;; Rectangle restored by undo.
+(defvar cua--restored-rectangle nil)
+
+;; Last rectangle copied/killed; nil if last kill was not a rectangle.
+(defvar cua--last-killed-rectangle nil)
+
+;; List of overlays used to display current rectangle.
+(defvar cua--rectangle-overlays nil)
+(make-variable-buffer-local 'cua--rectangle-overlays)
+
+;; Per-buffer CUA mode undo list.
+(defvar cua--undo-list nil)
+(make-variable-buffer-local 'cua--undo-list)
+
+;; Record undo boundary for rectangle undo.
+(defun cua--rectangle-undo-boundary ()
+  (when (listp buffer-undo-list)
+    (if (> (length cua--undo-list) cua-undo-max)
+        (setcdr (nthcdr (1- cua-undo-max) cua--undo-list) nil))
+    (undo-boundary)
+    (setq cua--undo-list
+          (cons (cons (cdr buffer-undo-list) (copy-sequence cua--rectangle)) cua--undo-list))))
+
+(defun cua--rectangle-undo (&optional arg)
+  "Undo some previous changes.
+Knows about CUA rectangle highlighting in addition to standard undo."
+  (interactive "*P")
+  (if cua--rectangle
+      (cua--rectangle-undo-boundary))
+  (undo arg)
+  (let ((l cua--undo-list))
+    (while l
+      (if (eq (car (car l)) pending-undo-list)
+          (setq cua--restored-rectangle 
+                (and (vectorp (cdr (car l))) (cdr (car l)))
+                l nil)
+        (setq l (cdr l)))))
+  (setq cua--buffer-and-point-before-command nil))
+
+(defvar cua--tidy-undo-counter 0
+  "Number of times `cua--tidy-undo-lists' have run successfully.")
+
+;; Clean out danling entries from cua's undo list.
+;; Since this list contains pointers into the standard undo list,
+;; such references are only meningful as undo information if the
+;; corresponding entry is still on the standard undo list.
+
+(defun cua--tidy-undo-lists (&optional clean)
+  (let ((buffers (buffer-list)) (cnt cua--tidy-undo-counter))
+    (while (and buffers (or clean (not (input-pending-p))))
+      (with-current-buffer (car buffers)
+        (when (local-variable-p 'cua--undo-list)
+          (if (or clean (null cua--undo-list) (eq buffer-undo-list t))
+              (progn
+                (kill-local-variable 'cua--undo-list)
+                (setq cua--tidy-undo-counter (1+ cua--tidy-undo-counter)))
+            (let* ((bul buffer-undo-list)
+                   (cul (cons nil cua--undo-list))
+                   (cc (car (car (cdr cul)))))
+              (while (and bul cc)
+                (if (setq bul (memq cc bul))
+                    (setq cul (cdr cul)
+                          cc (and (cdr cul) (car (car (cdr cul)))))))
+              (when cc
+                (if cua--debug
+                    (setq cc (length (cdr cul))))
+                (if (eq (cdr cul) cua--undo-list)
+                    (setq cua--undo-list nil)
+                  (setcdr cul nil))
+                (setq cua--tidy-undo-counter (1+ cua--tidy-undo-counter))
+                (if cua--debug
+                    (message "Clean undo list in %s (%d)" 
+                             (buffer-name) cc)))))))
+      (setq buffers (cdr buffers)))
+    (/= cnt cua--tidy-undo-counter)))
+
+;;; Rectangle geometry
+
+(defun cua--rectangle-top (&optional val)
+  ;; Top of CUA rectangle (buffer position on first line).
+  (if (not val)
+      (aref cua--rectangle 0)
+    (setq val (line-beginning-position))
+    (if (<= val (aref cua--rectangle 1))
+        (aset cua--rectangle 0 val)
+      (aset cua--rectangle 1 val)
+      (cua--rectangle-corner 2))))
+
+(defun cua--rectangle-bot (&optional val)
+  ;; Bot of CUA rectangle (buffer position on last line).
+  (if (not val)
+      (aref cua--rectangle 1)
+    (setq val (line-end-position))
+    (if (>= val (aref cua--rectangle 0))
+        (aset cua--rectangle 1 val)
+      (aset cua--rectangle 0 val)
+      (cua--rectangle-corner 2))))
+
+(defun cua--rectangle-left (&optional val)
+  ;; Left column of CUA rectangle.
+  (if (integerp val)
+      (if (<= val (aref cua--rectangle 3))
+          (aset cua--rectangle 2 val)
+        (aset cua--rectangle 3 val)
+        (cua--rectangle-corner (if (cua--rectangle-right-side) -1 1)))
+    (aref cua--rectangle 2)))
+
+(defun cua--rectangle-right (&optional val)
+  ;; Right column of CUA rectangle.
+  (if (integerp val)
+      (if (>= val (aref cua--rectangle 2))
+          (aset cua--rectangle 3 val)
+        (aset cua--rectangle 2 val)
+        (cua--rectangle-corner (if (cua--rectangle-right-side) -1 1)))
+    (aref cua--rectangle 3)))
+
+(defun cua--rectangle-corner (&optional advance)
+  ;; Currently active corner of rectangle.
+  (let ((c (aref cua--rectangle 4)))
+    (if (not (integerp advance))
+        c
+      (aset cua--rectangle 4 
+            (if (= advance 0)
+                (- 3 c) ; opposite corner
+              (mod (+ c 4 advance) 4)))
+      (aset cua--rectangle 5 0))))
+
+(defun cua--rectangle-right-side (&optional topbot)
+  ;; t if point is on right side of rectangle.
+  (if (and topbot (= (cua--rectangle-left) (cua--rectangle-right)))
+      (< (cua--rectangle-corner) 2)
+    (= (mod (cua--rectangle-corner) 2) 1)))
+
+(defun cua--rectangle-column ()
+  (if (cua--rectangle-right-side)
+      (cua--rectangle-right)
+    (cua--rectangle-left)))
+
+(defun cua--rectangle-insert-col (&optional col)
+  ;; Currently active corner of rectangle.
+  (if (integerp col)
+      (aset cua--rectangle 5 col)
+    (if (cua--rectangle-right-side t)
+        (if (= (aref cua--rectangle 5) 0)
+            (1+ (cua--rectangle-right))
+          (aref cua--rectangle 5))
+      (cua--rectangle-left))))
+
+(defun cua--rectangle-padding (&optional set val)
+  ;; Current setting of rectangle padding
+  (if set
+      (aset cua--rectangle 6 val))
+  (and (not buffer-read-only)
+       (aref cua--rectangle 6)))
+
+(defun cua--rectangle-restriction (&optional val bounded negated)
+  ;; Current rectangle restriction
+  (if val
+      (aset cua--rectangle 7
+            (and (stringp val)
+             (> (length val) 0)
+             (list val bounded negated)))
+    (aref cua--rectangle 7)))
+
+(defun cua--rectangle-assert ()
+  (message "%S (%d)" cua--rectangle (point))
+  (if (< (cua--rectangle-right) (cua--rectangle-left))
+      (message "rectangle right < left"))
+  (if (< (cua--rectangle-bot) (cua--rectangle-top))
+      (message "rectangle bot < top")))
+
+(defun cua--rectangle-get-corners (&optional pad)
+  ;; Calculate the rectangular region represented by point and mark,
+  ;; putting start in the upper left corner and end in the
+  ;; bottom right corner.
+  (let ((top (point)) (bot (mark)) r l corner)
+    (save-excursion
+      (goto-char top)
+      (setq l (current-column))
+      (goto-char bot)
+      (setq r (current-column))
+      (if (<= top bot)
+          (setq corner (if (<= l r) 0 1))
+        (setq top (prog1 bot (setq bot top)))
+        (setq corner (if (<= l r) 2 3)))
+      (if (<= l r)
+          (if (< l r)
+              (setq r (1- r)))
+        (setq l (prog1 r (setq r l)))
+        (goto-char top)
+        (move-to-column l pad)
+        (setq top (point))
+        (goto-char bot)
+        (move-to-column r pad)
+        (setq bot (point))))
+    (vector top bot l r corner 0 pad nil)))
+
+(defun cua--rectangle-set-corners ()
+  ;; Set mark and point in opposite corners of current rectangle.
+  (let (pp pc mp mc (c (cua--rectangle-corner)))
+    (cond
+     ((= c 0)  ; top/left -> bot/right
+      (setq pp (cua--rectangle-top) pc (cua--rectangle-left)
+            mp (cua--rectangle-bot) mc (cua--rectangle-right)))
+     ((= c 1)  ; top/right -> bot/left
+      (setq pp (cua--rectangle-top) pc (cua--rectangle-right)
+            mp (cua--rectangle-bot) mc (cua--rectangle-left)))
+     ((= c 2)  ; bot/left -> top/right
+      (setq pp (cua--rectangle-bot) pc (cua--rectangle-left)
+            mp (cua--rectangle-top) mc (cua--rectangle-right)))
+     ((= c 3)  ; bot/right -> top/left
+      (setq pp (cua--rectangle-bot) pc (cua--rectangle-right)
+            mp (cua--rectangle-top) mc (cua--rectangle-left))))
+    (goto-char mp)
+    (move-to-column mc (cua--rectangle-padding))
+    (set-mark (point))
+    (goto-char pp)
+    (move-to-column pc (cua--rectangle-padding))))
+
+;;; Rectangle resizing
+
+(defun cua--forward-line (n pad)
+  ;; Move forward/backward one line.  Returns t if movement.
+  (if (or (not pad) (< n 0))
+      (= (forward-line n) 0)
+    (next-line 1)
+    t))
+
+(defun cua--rectangle-resized ()
+  ;; Refresh state after resizing rectangle
+  (setq cua--buffer-and-point-before-command nil)
+  (cua--pad-rectangle)
+  (cua--rectangle-insert-col 0)
+  (cua--rectangle-set-corners)
+  (cua--keep-active))
+
+(defun cua-resize-rectangle-right (n)
+  "Resize rectangle to the right."
+  (interactive "p")
+  (let ((pad (cua--rectangle-padding)) (resized (> n 0)))
+    (while (> n 0)
+      (setq n (1- n))
+      (cond
+       ((and (cua--rectangle-right-side) (or pad (eolp)))
+        (cua--rectangle-right (1+ (cua--rectangle-right)))
+        (move-to-column (cua--rectangle-right) pad))
+       ((cua--rectangle-right-side)
+        (forward-char 1)                 
+        (cua--rectangle-right (current-column)))
+       ((or pad (eolp))                  
+        (cua--rectangle-left (1+ (cua--rectangle-left)))
+        (move-to-column (cua--rectangle-right) pad))
+       (t
+        (forward-char 1)
+        (cua--rectangle-left (current-column)))))
+    (if resized
+        (cua--rectangle-resized))))
+
+(defun cua-resize-rectangle-left (n)
+  "Resize rectangle to the left."
+  (interactive "p")
+  (let ((pad (cua--rectangle-padding)) resized)
+    (while (> n 0)
+      (setq n (1- n))
+      (if (or (= (cua--rectangle-right) 0)
+              (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0)))
+          (setq n 0)
+        (cond
+         ((and (cua--rectangle-right-side) (or pad (eolp) (bolp)))
+          (cua--rectangle-right (1- (cua--rectangle-right)))
+          (move-to-column (cua--rectangle-right) pad))
+         ((cua--rectangle-right-side)
+          (backward-char 1)
+          (cua--rectangle-right (current-column)))
+         ((or pad (eolp) (bolp))
+          (cua--rectangle-left (1- (cua--rectangle-left)))
+          (move-to-column (cua--rectangle-right) pad))
+         (t
+          (backward-char 1)
+          (cua--rectangle-left (current-column))))
+        (setq resized t)))
+    (if resized
+        (cua--rectangle-resized))))
+
+(defun cua-resize-rectangle-down (n)
+  "Resize rectangle downwards."
+  (interactive "p")
+  (let ((pad (cua--rectangle-padding)) resized)
+    (while (> n 0)
+      (setq n (1- n))
+      (cond
+       ((>= (cua--rectangle-corner) 2)
+        (goto-char (cua--rectangle-bot))
+        (when (cua--forward-line 1 pad)
+          (move-to-column (cua--rectangle-column) pad)
+          (cua--rectangle-bot t)
+          (setq resized t)))
+       (t
+        (goto-char (cua--rectangle-top))
+        (when (cua--forward-line 1 pad)
+          (move-to-column (cua--rectangle-column) pad)
+          (cua--rectangle-top t)
+          (setq resized t)))))
+    (if resized
+        (cua--rectangle-resized))))
+
+(defun cua-resize-rectangle-up (n)
+  "Resize rectangle upwards."
+  (interactive "p")
+  (let ((pad (cua--rectangle-padding)) resized)
+    (while (> n 0)
+      (setq n (1- n))
+      (cond
+       ((>= (cua--rectangle-corner) 2)
+        (goto-char (cua--rectangle-bot))
+        (when (cua--forward-line -1 pad)
+          (move-to-column (cua--rectangle-column) pad)
+          (cua--rectangle-bot t)
+          (setq resized t)))
+       (t
+        (goto-char (cua--rectangle-top))
+        (when (cua--forward-line -1 pad)
+          (move-to-column (cua--rectangle-column) pad)
+          (cua--rectangle-top t)
+          (setq resized t)))))
+    (if resized
+        (cua--rectangle-resized))))
+
+(defun cua-resize-rectangle-eol ()
+  "Resize rectangle to end of line."
+  (interactive)
+  (unless (eolp)
+    (end-of-line)
+    (if (> (current-column) (cua--rectangle-right))
+        (cua--rectangle-right (current-column)))
+    (if (not (cua--rectangle-right-side))
+        (cua--rectangle-corner 1))
+    (cua--rectangle-resized)))
+
+(defun cua-resize-rectangle-bol ()
+  "Resize rectangle to beginning of line."
+  (interactive)
+  (unless (bolp)
+    (beginning-of-line)
+    (cua--rectangle-left (current-column))
+    (if (cua--rectangle-right-side)
+        (cua--rectangle-corner -1))
+    (cua--rectangle-resized)))
+
+(defun cua-resize-rectangle-bot ()
+  "Resize rectangle to bottom of buffer."
+  (interactive)
+  (goto-char (point-max))
+  (move-to-column (cua--rectangle-column) (cua--rectangle-padding))
+  (cua--rectangle-bot t)
+  (cua--rectangle-resized))
+
+(defun cua-resize-rectangle-top ()
+  "Resize rectangle to top of buffer."
+  (interactive)
+  (goto-char (point-min))
+  (move-to-column (cua--rectangle-column) (cua--rectangle-padding))
+  (cua--rectangle-top t)
+  (cua--rectangle-resized))
+
+(defun cua-resize-rectangle-page-up ()
+  "Resize rectangle upwards by one scroll page."
+  (interactive)
+  (let ((pad (cua--rectangle-padding)))
+    (scroll-down)
+    (move-to-column (cua--rectangle-column) pad)
+    (if (>= (cua--rectangle-corner) 2)
+        (cua--rectangle-bot t)
+      (cua--rectangle-top t))
+    (cua--rectangle-resized)))
+
+(defun cua-resize-rectangle-page-down ()
+  "Resize rectangle downwards by one scroll page."
+  (interactive)
+  (let ((pad (cua--rectangle-padding)))
+    (scroll-up)
+    (move-to-column (cua--rectangle-column) pad)
+    (if (>= (cua--rectangle-corner) 2)
+        (cua--rectangle-bot t)
+      (cua--rectangle-top t))
+    (cua--rectangle-resized)))
+
+;;; Mouse support
+
+;; This is pretty simplistic, but it does the job...
+
+(defun cua-mouse-resize-rectangle (event)
+  "Set rectangle corner at mouse click position."
+  (interactive "e")
+  (mouse-set-point event)
+  (if (cua--rectangle-padding)
+      (move-to-column (car (posn-col-row (event-end event))) t))
+  (if (cua--rectangle-right-side)
+      (cua--rectangle-right (current-column))
+    (cua--rectangle-left (current-column)))
+  (if (>= (cua--rectangle-corner) 2)
+      (cua--rectangle-bot t)
+    (cua--rectangle-top t))
+  (cua--rectangle-resized))
+
+(defvar cua--mouse-last-pos nil)
+
+(defun cua-mouse-set-rectangle-mark (event)
+  "Start rectangle at mouse click position."
+  (interactive "e")
+  (when cua--rectangle
+    (cua--deactivate-rectangle)
+    (cua--deactivate t))
+  (setq cua--last-rectangle nil)
+  (mouse-set-point event)
+  (cua-set-rectangle-mark)
+  (setq cua--buffer-and-point-before-command nil)
+  (setq cua--mouse-last-pos nil))
+
+(defun cua-mouse-save-then-kill-rectangle (event arg)
+  "Expand rectangle to mouse click position and copy rectangle.
+If command is repeated at same position, delete the rectangle."
+  (interactive "e\nP")
+  (if (and (eq this-command last-command)
+           (eq (point) (car-safe cua--mouse-last-pos))
+           (eq cua--last-killed-rectangle (cdr-safe cua--mouse-last-pos)))
+      (progn
+        (unless buffer-read-only
+          (cua--delete-rectangle))
+        (cua--deactivate))
+    (cua-mouse-resize-rectangle event)
+    (let ((cua-keep-region-after-copy t))
+      (cua-copy-rectangle arg)
+      (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
+(defun cua--mouse-ignore (event)
+  (interactive "e")
+  (setq this-command last-command))
+
+(defun cua--rectangle-move (dir)
+  (let ((pad (cua--rectangle-padding))
+        (moved t)
+        (top (cua--rectangle-top))
+        (bot (cua--rectangle-bot))
+        (l (cua--rectangle-left))
+        (r (cua--rectangle-right)))
+    (cond
+     ((eq dir 'up)
+      (goto-char top)
+      (when (cua--forward-line -1 pad)
+        (cua--rectangle-top t)
+        (goto-char bot)
+        (forward-line -1)
+        (cua--rectangle-bot t)))
+     ((eq dir 'down)
+      (goto-char bot)
+      (when (cua--forward-line 1 pad)
+        (cua--rectangle-bot t)
+        (goto-char top)
+        (cua--forward-line 1 pad)
+        (cua--rectangle-top t)))
+     ((eq dir 'left)
+      (when (> l 0)
+        (cua--rectangle-left (1- l))
+        (cua--rectangle-right (1- r))))
+     ((eq dir 'right)
+      (cua--rectangle-right (1+ r))
+      (cua--rectangle-left (1+ l)))
+     (t
+      (setq moved nil)))
+    (when moved
+      (setq cua--buffer-and-point-before-command nil)
+      (cua--pad-rectangle)
+      (cua--rectangle-set-corners)
+      (cua--keep-active))))
+
+
+;;; Operations on current rectangle
+
+(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct)
+  ;; Call FCT for each line of region with 4 parameters:
+  ;; Region start, end, left-col, right-col
+  ;; Point is at start when FCT is called
+  ;; Set undo boundary if UNDO is non-nil.
+  ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding)
+  ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
+  (let* ((start (cua--rectangle-top))
+         (end   (cua--rectangle-bot))
+         (l (cua--rectangle-left))
+         (r (1+ (cua--rectangle-right)))
+         (m (make-marker))
+         (tabpad (and (integerp pad) (= pad 2)))
+         (sel (cua--rectangle-restriction)))
+    (if undo
+        (cua--rectangle-undo-boundary))
+    (if (integerp pad)
+        (setq pad (cua--rectangle-padding)))
+    (save-excursion
+      (save-restriction
+        (widen)
+        (when (> (cua--rectangle-corner) 1)
+          (goto-char end)
+          (and (bolp) (not (eolp)) (not (eobp))
+               (setq end (1+ end))))
+        (when visible
+          (setq start (max (window-start) start))
+          (setq end   (min (window-end) end)))
+        (goto-char end)
+        (setq end (line-end-position))
+        (goto-char start)
+        (setq start (line-beginning-position))
+        (narrow-to-region start end)
+        (goto-char (point-min))
+        (while (< (point) (point-max))
+          (move-to-column r pad)
+          (and (not pad) (not visible) (> (current-column) r)
+               (backward-char 1))
+          (if (and tabpad (not pad) (looking-at "\t"))
+              (forward-char 1))
+          (set-marker m (point))
+          (move-to-column l pad)
+          (if fct
+              (let ((v t) (p (point)))
+                (when sel
+                  (if (car (cdr sel))
+                      (setq v (looking-at (car sel)))
+                    (setq v (re-search-forward (car sel) m t))
+                    (goto-char p))
+                  (if (car (cdr (cdr sel)))
+                      (setq v (null v))))
+                (if visible
+                    (funcall fct p m l r v)
+                  (if v
+                      (funcall fct p m l r)))))
+          (set-marker m nil)
+          (forward-line 1))
+        (if (not visible)
+            (cua--rectangle-bot t))
+        (if post-fct
+            (funcall post-fct l r))))
+    (cond
+     ((eq keep-clear 'keep)
+      (cua--keep-active))
+     ((eq keep-clear 'clear)
+      (cua--deactivate))
+     ((eq keep-clear 'corners)
+      (cua--rectangle-set-corners)
+      (cua--keep-active)))
+    (setq cua--buffer-and-point-before-command nil)))
+
+(put 'cua--rectangle-operation 'lisp-indent-function 4)
+
+(defun cua--pad-rectangle (&optional pad)
+  (if (or pad (cua--rectangle-padding))
+      (cua--rectangle-operation nil nil t t)))
+
+(defun cua--delete-rectangle ()
+  (cua--rectangle-operation nil nil t 2
+    '(lambda (s e l r)
+       (delete-region s (if (> e s) e (1+ e))))))
+
+(defun cua--extract-rectangle ()
+  (let (rect)
+    (cua--rectangle-operation nil nil nil 1
+     '(lambda (s e l r)
+        (setq rect (cons (buffer-substring-no-properties s e) rect))))
+      (nreverse rect)))
+
+(defun cua--insert-rectangle (rect &optional below)
+  ;; 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
+  ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines.
+  (if (and below (eq below 'auto))
+      (setq below (and (bolp)
+                       (or (eolp) (eobp) (= (1+ (point)) (point-max))))))
+  (let ((lines rect)
+        (insertcolumn (current-column))
+        (first t)
+        p)
+    (while (or lines below)
+      (or first
+          (if overwrite-mode
+              (insert ?\n)
+            (forward-line 1)
+            (or (bolp) (insert ?\n))
+            (move-to-column insertcolumn t)))
+      (if (not lines)
+          (setq below nil)
+        (insert-for-yank (car lines))
+        (setq lines (cdr lines))
+        (and first (not below)
+             (setq p (point))))
+      (setq first nil))
+    (and p (not overwrite-mode)
+         (goto-char p))))
+
+(defun cua--copy-rectangle-as-kill (&optional ring)
+  (if cua--register
+      (set-register cua--register (cua--extract-rectangle))
+    (setq killed-rectangle (cua--extract-rectangle))
+    (setq cua--last-killed-rectangle (cons (and kill-ring (car kill-ring)) killed-rectangle))
+    (if ring
+        (kill-new (mapconcat
+                   (function (lambda (row) (concat row "\n")))
+                   killed-rectangle "")))))
+
+(defun cua--activate-rectangle (&optional force)
+  ;; Turn on rectangular marking mode by disabling transient mark mode
+  ;; and manually handling highlighting from a post command hook.
+  ;; Be careful if we are already marking a rectangle.
+  (setq cua--rectangle 
+        (if (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
+           (and (not buffer-read-only)
+                (or cua-auto-expand-rectangles
+                    force
+                    (eq major-mode 'picture-mode)))))
+        cua--status-string (if (cua--rectangle-padding) " Pad" "")
+        cua--last-rectangle nil))
+
+;; (defvar cua-save-point nil)
+
+(defun cua--deactivate-rectangle ()
+  ;; This is used to clean up after `cua--activate-rectangle'.
+  (mapcar (function 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))
+
+(defun cua--highlight-rectangle ()
+  ;; This function is used to highlight the rectangular region.
+  ;; We do this by putting an overlay on each line within the rectangle.
+  ;; Each overlay extends across all the columns of the rectangle.
+  ;; We try to reuse overlays where possible because this is more efficient
+  ;; and results in less flicker.
+  ;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines,
+  ;; the higlighted region may not be perfectly rectangular.
+  (let ((deactivate-mark deactivate-mark)
+        (old cua--rectangle-overlays)
+        (new nil)
+        (left (cua--rectangle-left))
+        (right (1+ (cua--rectangle-right))))
+    (when (/= left right)
+      (sit-for 0)  ; make window top/bottom reliable
+      (cua--rectangle-operation nil t nil nil
+        '(lambda (s e l r v)
+           (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face))
+                 overlay)
+             ;; Trim old leading overlays.
+	     (if (= s e) (setq e (1+ e)))
+             (while (and old
+                         (setq overlay (car old))
+                         (< (overlay-start overlay) s)
+                         (/= (overlay-end overlay) e))
+               (delete-overlay overlay)
+               (setq old (cdr old)))
+             ;; Reuse an overlay if possible, otherwise create one.
+             (if (and old
+                      (setq overlay (car old))
+                      (or (= (overlay-start overlay) s)
+                          (= (overlay-end overlay) e)))
+                 (progn
+                   (move-overlay overlay s e)
+                   (setq old (cdr old)))
+               (setq overlay (make-overlay s e)))
+             (overlay-put overlay 'face rface)
+             (setq new (cons overlay new))))))
+    ;; Trim old trailing overlays.
+    (mapcar (function delete-overlay) old)
+    (setq cua--rectangle-overlays (nreverse new))))
+
+(defun cua--indent-rectangle (&optional ch to-col clear)
+  ;; Indent current rectangle.
+  (let ((col (cua--rectangle-insert-col))
+        (pad (cua--rectangle-padding))
+        indent)
+    (cua--rectangle-operation (if clear 'clear 'corners) nil t pad
+      '(lambda (s e l r)
+         (move-to-column col pad)
+         (if (and (eolp)
+                  (< (current-column) col))
+             (move-to-column col t))
+	 (cond
+	  (to-col (indent-to to-col))
+	  (ch (insert ch))
+	  (t (tab-to-tab-stop)))
+         (if (cua--rectangle-right-side t)
+             (cua--rectangle-insert-col (current-column))
+           (setq indent (- (current-column) l))))
+      '(lambda (l r)
+         (when (and indent (> indent 0))
+           (aset cua--rectangle 2 (+ l indent))
+           (aset cua--rectangle 3 (+ r indent -1)))))))
+
+;;
+;; rectangle functions / actions
+;;
+
+(defvar cua--rectangle-initialized nil)
+
+(defun cua-set-rectangle-mark (&optional reopen)
+  "Set mark and start in CUA rectangle mode.
+With prefix argument, activate previous rectangle if possible."
+  (interactive "P")
+  (unless cua--rectangle-initialized
+    (cua--init-rectangles))
+  (when (not cua--rectangle)
+    (if (and reopen
+             cua--last-rectangle
+             (eq (car cua--last-rectangle) (current-buffer)))
+        (goto-char (car (cdr cua--last-rectangle)))
+      (if (not mark-active)
+          (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))))
+
+(defun cua-clear-rectangle-mark ()
+  "Cancel current rectangle."
+  (interactive)
+  (when cua--rectangle
+    (setq mark-active nil
+          cua--explicit-region-start nil)
+    (cua--deactivate-rectangle)))
+
+(defun cua-toggle-rectangle-mark ()
+  (interactive)
+  (if cua--rectangle
+      (cua--deactivate-rectangle)
+    (unless cua--rectangle-initialized
+      (cua--init-rectangles))
+    (cua--activate-rectangle))
+  (if cua--rectangle
+      (if cua-enable-rectangle-auto-help
+          (cua-help-for-rectangle t))
+    (if cua-enable-region-auto-help
+        (cua-help-for-region t))))
+
+(defun cua-restrict-regexp-rectangle (arg)
+  "Restrict rectangle to lines (not) matching REGEXP.
+With prefix argument, the toggle restriction."
+  (interactive "P")
+  (let ((r (cua--rectangle-restriction)) regexp)
+    (if (and r (null (car (cdr r))))
+      (if arg
+          (cua--rectangle-restriction (car r) nil (not (car (cdr (cdr r)))))
+        (cua--rectangle-restriction "" nil nil))
+      (cua--rectangle-restriction
+       (read-from-minibuffer "Restrict rectangle (regexp): "
+                             nil nil nil nil) nil arg))))
+
+(defun cua-restrict-prefix-rectangle (arg)
+  "Restrict rectangle to lines (not) starting with CHAR.
+With prefix argument, the toggle restriction."
+  (interactive "P")
+  (let ((r (cua--rectangle-restriction)) regexp)
+    (if (and r (car (cdr r)))
+      (if arg
+          (cua--rectangle-restriction (car r) t (not (car (cdr (cdr r)))))
+        (cua--rectangle-restriction "" nil nil))
+      (cua--rectangle-restriction
+       (format "[%c]" 
+               (read-char "Restrictive rectangle (char): ")) t arg))))
+
+(defun cua-move-rectangle-up ()
+  (interactive)
+  (cua--rectangle-move 'up))
+
+(defun cua-move-rectangle-down ()
+  (interactive)
+  (cua--rectangle-move 'down))
+
+(defun cua-move-rectangle-left ()
+  (interactive)
+  (cua--rectangle-move 'left))
+
+(defun cua-move-rectangle-right ()
+  (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))
+  (cua--rectangle-set-corners))
+
+(defun cua-toggle-rectangle-padding ()
+  (interactive)
+  (if buffer-read-only
+      (message "Cannot do padding in read-only buffer.")
+    (cua--rectangle-padding t (not (cua--rectangle-padding)))
+    (cua--pad-rectangle)
+    (cua--rectangle-set-corners))
+  (setq cua--status-string (and (cua--rectangle-padding) " Pad"))
+  (cua--keep-active))
+
+(defun cua-do-rectangle-padding ()
+  (interactive)
+  (if buffer-read-only
+      (message "Cannot do padding in read-only buffer.")
+    (cua--pad-rectangle t)
+    (cua--rectangle-set-corners))
+  (cua--keep-active))
+
+(defun cua-open-rectangle ()
+  "Blank out CUA rectangle, shifting text right.
+The text previously in the region is not overwritten by the blanks,
+but instead winds up to the right of the rectangle."
+  (interactive)
+  (cua--rectangle-operation 'corners nil t 1
+   '(lambda (s e l r)
+      (skip-chars-forward " \t")
+      (let ((ws (- (current-column) l))
+            (p (point)))
+        (skip-chars-backward " \t")
+        (delete-region (point) p)
+        (indent-to (+ r ws))))))
+
+(defun cua-close-rectangle (arg)
+  "Delete all whitespace starting at left edge of CUA rectangle.
+On each line in the rectangle, all continuous whitespace starting
+at that column is deleted.
+With prefix arg, also delete whitespace to the left of that column."
+  (interactive "P")
+  (cua--rectangle-operation 'clear nil t 1
+   '(lambda (s e l r)
+      (when arg
+        (skip-syntax-backward " " (line-beginning-position))
+        (setq s (point)))
+      (skip-syntax-forward " " (line-end-position))
+      (delete-region s (point)))))
+
+(defun cua-blank-rectangle ()
+  "Blank out CUA rectangle.
+The text previously in the rectangle is overwritten by the blanks."
+  (interactive)
+  (cua--rectangle-operation 'keep nil nil 1
+   '(lambda (s e l r)
+      (goto-char e)
+      (skip-syntax-forward " " (line-end-position))
+      (setq e (point))
+      (let ((column (current-column)))
+        (goto-char s)
+        (skip-syntax-backward " " (line-beginning-position))
+        (delete-region (point) e)
+        (indent-to column)))))
+
+(defun cua-align-rectangle ()
+  "Align rectangle lines to left column."
+  (interactive)
+  (let (x)
+    (cua--rectangle-operation 'clear nil t t
+     '(lambda (s e l r)
+        (let ((b (line-beginning-position)))
+          (skip-syntax-backward "^ " b)
+          (skip-syntax-backward " " b)
+          (setq s (point)))
+        (skip-syntax-forward " " (line-end-position))
+        (delete-region s (point))
+        (indent-to l))
+     '(lambda (l r)
+        (move-to-column l)
+        ;; (setq cua-save-point (point))
+        ))))
+
+(defun cua-copy-rectangle-as-text (&optional arg delete)
+  "Copy rectangle, but store as normal text."
+  (interactive "P")
+  (if cua--global-mark-active
+      (if delete
+          (cua--cut-rectangle-to-global-mark t)
+        (cua--copy-rectangle-to-global-mark t))
+    (let* ((rect (cua--extract-rectangle))
+           (text (mapconcat
+                  (function (lambda (row) (concat row "\n")))
+                  rect "")))
+      (setq arg (cua--prefix-arg arg))
+      (if cua--register
+          (set-register cua--register text)
+        (kill-new text)))
+    (if delete
+        (cua--delete-rectangle))
+    (cua--deactivate)))
+
+(defun cua-cut-rectangle-as-text (arg)
+  "Kill rectangle, but store as normal text."
+  (interactive "P")
+  (cua-copy-rectangle-as-text arg (not buffer-read-only)))
+
+(defun cua-string-rectangle (string)
+  "Replace CUA rectangle contents with STRING on each line.
+The length of STRING need not be the same as the rectangle width."
+  (interactive "sString rectangle: ")
+  (cua--rectangle-operation 'keep nil t t
+     '(lambda (s e l r)
+        (delete-region s e)
+        (skip-chars-forward " \t")
+        (let ((ws (- (current-column) l)))
+          (delete-region s (point))
+          (insert string)
+          (indent-to (+ (current-column) ws))))
+     (unless (cua--rectangle-restriction)
+       '(lambda (l r)
+          (cua--rectangle-right (max l (+ l (length string) -1)))))))
+
+(defun cua-fill-char-rectangle (ch)
+  "Replace CUA rectangle contents with CHARACTER."
+  (interactive "cFill rectangle with character: ")
+  (cua--rectangle-operation 'clear nil t 1
+   '(lambda (s e l r)
+      (delete-region s e)
+      (move-to-column l t)
+      (insert-char ch (- r l)))))
+
+(defun cua-replace-in-rectangle (regexp newtext)
+  "Replace REGEXP with NEWTEXT in each line of CUA rectangle."
+  (interactive "sReplace regexp: \nsNew text: ")
+  (if buffer-read-only
+      (message "Cannot replace in read-only buffer")
+    (cua--rectangle-operation 'keep nil t 1
+     '(lambda (s e l r)
+        (if (re-search-forward regexp e t)
+            (replace-match newtext nil nil))))))
+
+(defun cua-incr-rectangle (increment)
+  "Increment each line of CUA rectangle by prefix amount."
+  (interactive "p")
+  (cua--rectangle-operation 'keep nil t 1
+     '(lambda (s e l r)
+        (cond
+         ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
+          (let* ((txt (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
+                 (n (string-to-number txt 16))
+                 (fmt (format "0x%%0%dx" (length txt))))
+            (replace-match (format fmt (+ n increment)))))
+         ((re-search-forward "\\( *-?[0-9]+\\)" e t)
+          (let* ((txt (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
+                 (prefix (if (= (aref txt 0) ?0) "0" ""))
+                 (n (string-to-number txt 10))
+                 (fmt (format "%%%s%dd" prefix (length txt))))
+            (replace-match (format fmt (+ n increment)))))
+         (t nil)))))
+
+(defvar cua--rectangle-seq-format "%d"
+  "Last format used by cua-sequence-rectangle.")
+
+(defun cua-sequence-rectangle (first incr fmt)
+  "Resequence each line of CUA rectangle starting from FIRST.
+The numbers are formatted according to the FORMAT string."
+  (interactive 
+   (list (if current-prefix-arg
+             (prefix-numeric-value current-prefix-arg)
+           (string-to-number
+            (read-string "Start value: (0) " nil nil "0")))
+         (string-to-number
+          (read-string "Increment: (1) " nil nil "1"))
+         (read-string (concat "Format: (" cua--rectangle-seq-format ") "))))
+  (if (= (length fmt) 0)
+      (setq fmt cua--rectangle-seq-format)
+    (setq cua--rectangle-seq-format fmt))
+  (cua--rectangle-operation 'clear nil t 1
+     '(lambda (s e l r)
+         (delete-region s e)
+         (insert (format fmt first))
+         (setq first (+ first incr)))))
+
+(defun cua-upcase-rectangle ()
+  "Convert the rectangle to upper case."
+  (interactive)
+  (cua--rectangle-operation 'clear nil nil nil
+     '(lambda (s e l r)
+        (upcase-region s e))))
+
+(defun cua-downcase-rectangle ()
+  "Convert the rectangle to lower case."
+  (interactive)
+  (cua--rectangle-operation 'clear nil nil nil
+     '(lambda (s e l r)
+        (downcase-region s e))))
+
+
+;;; Replace/rearrange text in current rectangle
+
+(defun cua--rectangle-aux-replace (width adjust keep replace pad format-fct &optional setup-fct)
+  ;; Process text inserted by calling SETUP-FCT or current rectangle if nil.
+  ;; Then call FORMAT-FCT on text (if non-nil); takes two args: start and end.
+  ;; Fill to WIDTH characters if > 0 or fill to current width if == 0.
+  ;; Don't fill if WIDTH < 0.
+  ;; Replace current rectangle by filled text if REPLACE is non-nil
+  (let ((auxbuf (get-buffer-create "*CUA temp*"))
+        (w (if (> width 1) width
+	     (- (cua--rectangle-right) (cua--rectangle-left) -1)))
+        (r (or setup-fct (cua--extract-rectangle)))
+        y z (tr 0))
+    (save-excursion
+      (set-buffer auxbuf)
+      (erase-buffer)
+      (if setup-fct
+          (funcall setup-fct)
+        (cua--insert-rectangle r))
+      (if format-fct
+          (let ((fill-column w))
+            (funcall format-fct (point-min) (point-max))))
+      (when replace
+        (goto-char (point-min))
+        (while (not (eobp))
+          (setq z (cons (buffer-substring (point) (line-end-position)) z))
+          (forward-line 1))))
+    (if (not cua--debug)
+	(kill-buffer auxbuf))
+    (when replace
+      (setq z (reverse z))
+      (if cua--debug
+	  (print z auxbuf))
+      (cua--rectangle-operation nil nil t pad
+        '(lambda (s e l r)
+           (let (cc)
+             (goto-char e)
+             (skip-chars-forward " \t")
+             (setq cc (current-column))
+	     (if cua--debug
+		 (print (list cc s e) auxbuf))
+             (delete-region s (point))
+             (if (not z)
+                 (setq y 0)
+	       (move-to-column l t)
+	       (insert (car z))
+	       (when (> (current-column) (+ l w))
+		 (setq y (point))
+		 (move-to-column (+ l w) t)
+		 (delete-region (point) y)
+		 (setq tr (1+ tr)))
+	       (setq z (cdr z)))
+	     (if cua--debug
+		 (print (list (current-column) cc) auxbuf))
+             (indent-to cc))))
+      (if (> tr 0)
+	  (message "Warning:  Truncated %d row%s" tr (if (> tr 1) "s" "")))
+      (if adjust
+          (cua--rectangle-right (+ (cua--rectangle-left) w -1)))
+      (if keep
+          (cua--rectangle-resized)))))
+
+(put 'cua--rectangle-aux-replace 'lisp-indent-function 4)
+
+(defun cua--left-fill-rectangle (start end)
+  (beginning-of-line)
+  (while (< (point) (point-max))
+    (delete-horizontal-space nil)
+    (forward-line 1))
+  (fill-region-as-paragraph (point-min) (point-max) 'left nil)
+  (untabify (point-min) (point-max)))
+
+(defun cua-text-fill-rectangle (width text)
+  "Replace rectagle with filled TEXT read from minibuffer.
+A numeric prefix argument is used a new width for the filled rectangle."
+  (interactive (list
+                (prefix-numeric-value current-prefix-arg)
+                (read-from-minibuffer "Enter text: "
+                                      nil nil nil nil)))
+  (cua--rectangle-aux-replace width t t t 1
+    'cua--left-fill-rectangle
+    '(lambda () (insert text))))
+
+(defun cua-refill-rectangle (width)
+  "Fill contents of current rectagle.
+A numeric prefix argument is used as new width for the filled rectangle."
+  (interactive "P")
+  (cua--rectangle-aux-replace
+      (if width (prefix-numeric-value width) 0)
+      t t t 1 'cua--left-fill-rectangle))
+
+(defun cua-shell-command-on-rectangle (replace command)
+  "Run shell command on rectangle like `shell-command-on-region'.
+With prefix arg, replace rectangle with output from command."
+  (interactive (list
+                current-prefix-arg
+                (read-from-minibuffer "Shell command on rectangle: "
+                                      nil nil nil 
+                                      'shell-command-history)))
+  (cua--rectangle-aux-replace -1 t t replace 1
+    '(lambda (s e)
+       (shell-command-on-region s e command
+                                replace replace nil))))
+
+(defun cua-reverse-rectangle ()
+  "Reverse the lines of the rectangle."
+  (interactive)
+  (cua--rectangle-aux-replace 0 t t t t 'reverse-region))
+
+(defun cua-scroll-rectangle-up ()
+  "Remove the first line of the rectangle and scroll remaining lines up."
+  (interactive)
+  (cua--rectangle-aux-replace 0 t t t t
+    '(lambda (s e) 
+       (if (= (forward-line 1) 0)
+           (delete-region s (point))))))
+
+(defun cua-scroll-rectangle-down ()
+  "Insert a blank line at the first line of the rectangle.
+The remaining lines are scrolled down, losing the last line."
+  (interactive)
+  (cua--rectangle-aux-replace 0 t t t t
+    '(lambda (s e)
+       (goto-char s)
+       (insert "\n"))))
+
+
+;;; Insert/delete text to left or right of rectangle
+
+(defun cua-insert-char-rectangle (&optional ch)
+  (interactive)
+  (if buffer-read-only
+      (ding)
+    (cua--indent-rectangle (or ch (aref (this-single-command-keys) 0)))
+    (cua--keep-active))
+  t)
+
+(defun cua-indent-rectangle (column)
+  "Indent rectangle to next tab stop.
+With prefix arg, indent to that column."
+  (interactive "P")
+  (if (null column)
+      (cua-insert-char-rectangle ?\t)
+    (cua--indent-rectangle nil (prefix-numeric-value column))))
+
+(defun cua-delete-char-rectangle ()
+  "Delete char to left or right of rectangle."
+  (interactive)
+  (let ((col (cua--rectangle-insert-col))
+        (pad (cua--rectangle-padding))
+        indent)
+    (cua--rectangle-operation 'corners nil t pad
+     '(lambda (s e l r)
+        (move-to-column 
+         (if (cua--rectangle-right-side t)
+             (max (1+ r) col) l)
+         pad)
+        (if (bolp)
+            nil
+          (delete-backward-char 1)
+          (if (cua--rectangle-right-side t)
+              (cua--rectangle-insert-col (current-column))
+            (setq indent (- l (current-column))))))
+     '(lambda (l r)
+        (when (and indent (> indent 0))
+          (aset cua--rectangle 2 (- l indent))
+          (aset cua--rectangle 3 (- r indent 1)))))))
+
+(defun cua-help-for-rectangle (&optional help)
+  (interactive)
+  (let ((M (if cua-use-hyper-key " H-" " M-")))
+    (message 
+     (concat (if help "C-?:help" "")
+             M "p:pad" M "o:open" M "c:close" M "b:blank" 
+             M "s:string" M "f:fill" M "i:incr" M "n:seq"))))
+
+
+;;; CUA-like cut & paste for rectangles
+
+(defun cua--cancel-rectangle ()
+  ;; Cancel rectangle
+  (if cua--rectangle
+      (cua--deactivate-rectangle))
+  (setq cua--last-rectangle nil))
+
+(defun cua--rectangle-post-command ()
+  (if cua--restored-rectangle
+      (setq cua--rectangle cua--restored-rectangle
+            cua--restored-rectangle nil
+            mark-active t
+            deactivate-mark nil)
+    (when (and cua--rectangle cua--buffer-and-point-before-command
+               (equal (car cua--buffer-and-point-before-command) (current-buffer))
+               (not (= (cdr cua--buffer-and-point-before-command) (point))))
+      (if (cua--rectangle-right-side)
+          (cua--rectangle-right (current-column))
+        (cua--rectangle-left (current-column)))
+      (if (>= (cua--rectangle-corner) 2)
+          (cua--rectangle-bot t)
+        (cua--rectangle-top t))
+      (if (cua--rectangle-padding)
+          (setq unread-command-events 
+                (cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events)))))
+  (if cua--rectangle
+      (if (and mark-active
+               (not deactivate-mark))
+          (cua--highlight-rectangle)
+        (cua--deactivate-rectangle))))
+
+
+;;; Initialization
+
+(defun cua--rect-M/H-key (key cmd)
+  (cua--M/H-key cua--rectangle-keymap key cmd))
+
+(defun cua--rectangle-on-off (on)
+  (cancel-function-timers 'cua--tidy-undo-lists)
+  (if on
+      (run-with-idle-timer 10 t 'cua--tidy-undo-lists)
+    (cua--tidy-undo-lists t)))
+
+(defun cua--init-rectangles ()
+  (unless (face-background 'cua-rectangle-face)
+    (copy-face 'region 'cua-rectangle-face)
+    (set-face-background 'cua-rectangle-face "maroon")
+    (set-face-foreground 'cua-rectangle-face "white"))
+
+  (unless (face-background 'cua-rectangle-noselect-face)
+    (copy-face 'region 'cua-rectangle-noselect-face)
+    (set-face-background 'cua-rectangle-noselect-face "dimgray")
+    (set-face-foreground 'cua-rectangle-noselect-face "white"))
+
+  (unless (eq cua-use-hyper-key 'only)
+    (define-key cua--rectangle-keymap [(shift return)] 'cua-clear-rectangle-mark)
+    (define-key cua--region-keymap    [(shift return)] 'cua-toggle-rectangle-mark))
+  (when cua-use-hyper-key
+    (cua--rect-M/H-key 'space			       'cua-clear-rectangle-mark)
+    (cua--M/H-key cua--region-keymap 'space	       '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 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-char]       'cua-resize-rectangle-left)
+  (define-key cua--rectangle-keymap [remap next-line]           'cua-resize-rectangle-down)
+  (define-key cua--rectangle-keymap [remap previous-line]       'cua-resize-rectangle-up)
+  (define-key cua--rectangle-keymap [remap end-of-line]         'cua-resize-rectangle-eol)
+  (define-key cua--rectangle-keymap [remap beginning-of-line]   'cua-resize-rectangle-bol)
+  (define-key cua--rectangle-keymap [remap end-of-buffer]       'cua-resize-rectangle-bot)
+  (define-key cua--rectangle-keymap [remap beginning-of-buffer] 'cua-resize-rectangle-top)
+  (define-key cua--rectangle-keymap [remap scroll-down]         'cua-resize-rectangle-page-up)
+  (define-key cua--rectangle-keymap [remap scroll-up]           'cua-resize-rectangle-page-down)
+
+  (define-key cua--rectangle-keymap [remap delete-backward-char] 'cua-delete-char-rectangle)
+  (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)
+  
+  (define-key cua--rectangle-keymap "\r"     'cua-rotate-rectangle)
+  (define-key cua--rectangle-keymap "\t"     'cua-indent-rectangle)
+
+  (define-key cua--rectangle-keymap [(control ??)] 'cua-help-for-rectangle)
+
+  (define-key cua--rectangle-keymap [mouse-1]	   'cua-mouse-set-rectangle-mark)
+  (define-key cua--rectangle-keymap [down-mouse-1] 'cua--mouse-ignore)
+  (define-key cua--rectangle-keymap [drag-mouse-1] 'cua--mouse-ignore)
+  (define-key cua--rectangle-keymap [mouse-3]	   'cua-mouse-save-then-kill-rectangle)
+  (define-key cua--rectangle-keymap [down-mouse-3] 'cua--mouse-ignore)
+  (define-key cua--rectangle-keymap [drag-mouse-3] 'cua--mouse-ignore)
+
+  (cua--rect-M/H-key 'up    'cua-move-rectangle-up)
+  (cua--rect-M/H-key 'down  'cua-move-rectangle-down)
+  (cua--rect-M/H-key 'left  'cua-move-rectangle-left)
+  (cua--rect-M/H-key 'right 'cua-move-rectangle-right)
+
+  (cua--rect-M/H-key '(control up)   'cua-scroll-rectangle-up)
+  (cua--rect-M/H-key '(control down) 'cua-scroll-rectangle-down)
+
+  (cua--rect-M/H-key ?a	'cua-align-rectangle)
+  (cua--rect-M/H-key ?b	'cua-blank-rectangle)
+  (cua--rect-M/H-key ?c	'cua-close-rectangle)
+  (cua--rect-M/H-key ?f	'cua-fill-char-rectangle)
+  (cua--rect-M/H-key ?i	'cua-incr-rectangle)
+  (cua--rect-M/H-key ?k	'cua-cut-rectangle-as-text)
+  (cua--rect-M/H-key ?l	'cua-downcase-rectangle)
+  (cua--rect-M/H-key ?m	'cua-copy-rectangle-as-text)
+  (cua--rect-M/H-key ?n	'cua-sequence-rectangle)
+  (cua--rect-M/H-key ?o	'cua-open-rectangle)
+  (cua--rect-M/H-key ?p	'cua-toggle-rectangle-padding)
+  (cua--rect-M/H-key ?P	'cua-do-rectangle-padding)
+  (cua--rect-M/H-key ?q	'cua-refill-rectangle)
+  (cua--rect-M/H-key ?r	'cua-replace-in-rectangle)
+  (cua--rect-M/H-key ?R	'cua-reverse-rectangle)
+  (cua--rect-M/H-key ?s	'cua-string-rectangle)
+  (cua--rect-M/H-key ?t	'cua-text-fill-rectangle)
+  (cua--rect-M/H-key ?u	'cua-upcase-rectangle)
+  (cua--rect-M/H-key ?|	'cua-shell-command-on-rectangle)
+  (cua--rect-M/H-key ?'	'cua-restrict-prefix-rectangle)
+  (cua--rect-M/H-key ?/	'cua-restrict-regexp-rectangle)
+
+  (setq cua--rectangle-initialized t))
+
+;;; cua-rect.el ends here