Mercurial > emacs
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
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sun, 28 Apr 2002 21:48:39 +0000 |
parents | |
children | 829beb9a6a4b |
line wrap: on
line diff
--- /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 <storm@cua.dk> +;; 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 <jrs@world.std.com>. + +(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