aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emulation
diff options
context:
space:
mode:
authorMiles Bader2004-09-04 09:14:28 +0000
committerMiles Bader2004-09-04 09:14:28 +0000
commit6f7dde8273383c74cc722196c9b37c04faeb263f (patch)
tree5a4126925b754a52e74fa30de6521b3454f57a6d /lisp/emulation
parent32d61209ceb2b6c4b32e9d3ccc477014cc666c25 (diff)
parent90e118abf2dcc4aca4d7a7642247fa488554351e (diff)
downloademacs-6f7dde8273383c74cc722196c9b37c04faeb263f.tar.gz
emacs-6f7dde8273383c74cc722196c9b37c04faeb263f.zip
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-34
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-514 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-522 Update from CVS
Diffstat (limited to 'lisp/emulation')
-rw-r--r--lisp/emulation/cua-base.el91
-rw-r--r--lisp/emulation/cua-rect.el417
2 files changed, 327 insertions, 181 deletions
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index b39945c7712..fb3c537936f 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -141,30 +141,39 @@
141;; completely separate set of "rectangle commands" [C-x r ...] on the 141;; completely separate set of "rectangle commands" [C-x r ...] on the
142;; region to copy, kill, fill a.s.o. the virtual rectangle. 142;; region to copy, kill, fill a.s.o. the virtual rectangle.
143;; 143;;
144;; cua-mode's superior rectangle support is based on using a true visual 144;; cua-mode's superior rectangle support uses a true visual
145;; representation of the selected rectangle. To start a rectangle, use 145;; representation of the selected rectangle, i.e. it highlights the
146;; [S-return] and extend it using the normal movement keys (up, down, 146;; actual part of the buffer that is currently selected as part of the
147;; left, right, home, end, C-home, C-end). Once the rectangle has the 147;; rectangle. Unlike emacs' traditional rectangle commands, the
148;; desired size, you can cut or copy it using C-x and C-c (or C-w and M-w), 148;; selected rectangle always as straight left and right edges, even
149;; and you can subsequently insert it - as a rectangle - using C-v (or 149;; when those are in the middle of a TAB character or beyond the end
150;; C-y). So the only new command you need to know to work with 150;; of the current line. And it does this without actually modifying
151;; cua-mode rectangles is S-return! 151;; the buffer contents (it uses display overlays to visualize the
152;; virtual dimensions of the rectangle).
153;;
154;; This means that cua-mode's rectangles are not limited to the actual
155;; contents of the buffer, so if the cursor is currently at the end of a
156;; short line, you can still extend the rectangle to include more columns
157;; of longer lines in the same rectangle. And you can also have the
158;; left edge of a rectangle start in the middle of a TAB character.
159;; Sounds strange? Try it!
160;;
161;; To start a rectangle, use [S-return] and extend it using the normal
162;; movement keys (up, down, left, right, home, end, C-home,
163;; C-end). Once the rectangle has the desired size, you can cut or
164;; copy it using C-x and C-c (or C-w and M-w), and you can
165;; subsequently insert it - as a rectangle - using C-v (or C-y). So
166;; the only new command you need to know to work with cua-mode
167;; rectangles is S-return!
152;; 168;;
153;; Normally, when you paste a rectangle using C-v (C-y), each line of 169;; Normally, when you paste a rectangle using C-v (C-y), each line of
154;; the rectangle is inserted into the existing lines in the buffer. 170;; the rectangle is inserted into the existing lines in the buffer.
155;; If overwrite-mode is active when you paste a rectangle, it is 171;; If overwrite-mode is active when you paste a rectangle, it is
156;; inserted as normal (multi-line) text. 172;; inserted as normal (multi-line) text.
157;; 173;;
158;; Furthermore, cua-mode's rectangles are not limited to the actual 174;; If you prefer the traditional rectangle marking (i.e. don't want
159;; contents of the buffer, so if the cursor is currently at the end of a 175;; straight edges), [M-p] toggles this for the current rectangle,
160;; short line, you can still extend the rectangle to include more columns 176;; or you can customize cua-virtual-rectangle-edges.
161;; of longer lines in the same rectangle. Sounds strange? Try it!
162;;
163;; You can enable padding for just this rectangle by pressing [M-p];
164;; this works like entering `picture-mode' where the tabs and spaces
165;; are automatically converted/inserted to make the rectangle truly
166;; rectangular. Or you can do it for all rectangles by setting the
167;; `cua-auto-expand-rectangles' variable.
168 177
169;; And there's more: If you want to extend or reduce the size of the 178;; And there's more: If you want to extend or reduce the size of the
170;; rectangle in one of the other corners of the rectangle, just use 179;; rectangle in one of the other corners of the rectangle, just use
@@ -204,8 +213,8 @@
204;; a supplied format string (prompt) 213;; a supplied format string (prompt)
205;; [M-o] opens the rectangle by moving the highlighted text to the 214;; [M-o] opens the rectangle by moving the highlighted text to the
206;; right of the rectangle and filling the rectangle with blanks. 215;; right of the rectangle and filling the rectangle with blanks.
207;; [M-p] toggles rectangle padding, i.e. insert tabs and spaces to 216;; [M-p] toggles virtual straight rectangle edges
208;; make rectangles truly rectangular 217;; [M-P] inserts tabs and spaces (padding) to make real straight edges
209;; [M-q] performs text filling on the rectangle 218;; [M-q] performs text filling on the rectangle
210;; [M-r] replaces REGEXP (prompt) by STRING (prompt) in rectangle 219;; [M-r] replaces REGEXP (prompt) by STRING (prompt) in rectangle
211;; [M-R] reverse the lines in the rectangle 220;; [M-R] reverse the lines in the rectangle
@@ -347,14 +356,27 @@ managers, so try setting this to nil, if prefix override doesn't work."
347 356
348;;; Rectangle Customization 357;;; Rectangle Customization
349 358
350(defcustom cua-auto-expand-rectangles nil 359(defcustom cua-virtual-rectangle-edges t
351 "*If non-nil, rectangles are padded with spaces to make straight edges. 360 "*If non-nil, rectangles have virtual straight edges.
352This implies modifying buffer contents by expanding tabs and inserting spaces. 361Note that although rectangles are always DISPLAYED with straight edges, the
353Consequently, this is inhibited in read-only buffers. 362buffer is NOT modified, until you execute a command that actually modifies it.
354Can be toggled by [M-p] while the rectangle is active," 363\[M-p] toggles this feature when a rectangle is active."
355 :type 'boolean 364 :type 'boolean
356 :group 'cua) 365 :group 'cua)
357 366
367(defcustom cua-auto-tabify-rectangles 1000
368 "*If non-nil, automatically tabify after rectangle commands.
369This basically means that `tabify' is applied to all lines that
370are modified by inserting or deleting a rectangle. If value is
371an integer, cua will look for existing tabs in a region around
372the rectangle, and only do the conversion if any tabs are already
373present. The number specifies then number of characters before
374and after the region marked by the rectangle to search."
375 :type '(choice (number :tag "Auto detect (limit)")
376 (const :tag "Disabled" nil)
377 (other :tag "Enabled" t))
378 :group 'cua)
379
358(defcustom cua-enable-rectangle-auto-help t 380(defcustom cua-enable-rectangle-auto-help t
359 "*If non-nil, automatically show help for region, rectangle and global mark." 381 "*If non-nil, automatically show help for region, rectangle and global mark."
360 :type 'boolean 382 :type 'boolean
@@ -412,7 +434,6 @@ Can be toggled by [M-p] while the rectangle is active,"
412 (frame-parameter nil 'cursor-color) 434 (frame-parameter nil 'cursor-color)
413 "red") 435 "red")
414 "Normal (non-overwrite) cursor color. 436 "Normal (non-overwrite) cursor color.
415Also used to indicate that rectangle padding is not in effect.
416Default is to load cursor color from initial or default frame parameters. 437Default is to load cursor color from initial or default frame parameters.
417 438
418If the value is a COLOR name, then only the `cursor-color' attribute will be 439If the value is a COLOR name, then only the `cursor-color' attribute will be
@@ -462,7 +483,6 @@ a cons (TYPE . COLOR), then both properties are affected."
462 483
463(defcustom cua-overwrite-cursor-color "yellow" 484(defcustom cua-overwrite-cursor-color "yellow"
464 "*Cursor color used when overwrite mode is set, if non-nil. 485 "*Cursor color used when overwrite mode is set, if non-nil.
465Also used to indicate that rectangle padding is in effect.
466Only used when `cua-enable-cursor-indications' is non-nil. 486Only used when `cua-enable-cursor-indications' is non-nil.
467 487
468If the value is a COLOR name, then only the `cursor-color' attribute will be 488If the value is a COLOR name, then only the `cursor-color' attribute will be
@@ -806,7 +826,8 @@ If global mark is active, copy from register or one character."
806 (interactive "P") 826 (interactive "P")
807 (setq arg (cua--prefix-arg arg)) 827 (setq arg (cua--prefix-arg arg))
808 (let ((regtxt (and cua--register (get-register cua--register))) 828 (let ((regtxt (and cua--register (get-register cua--register)))
809 (count (prefix-numeric-value arg))) 829 (count (prefix-numeric-value arg))
830 paste-column paste-lines)
810 (cond 831 (cond
811 ((and cua--register (not regtxt)) 832 ((and cua--register (not regtxt))
812 (message "Nothing in register %c" cua--register)) 833 (message "Nothing in register %c" cua--register))
@@ -825,7 +846,12 @@ If global mark is active, copy from register or one character."
825 ;; the same region that we are going to delete. 846 ;; the same region that we are going to delete.
826 ;; That would make yank a no-op. 847 ;; That would make yank a no-op.
827 (if cua--rectangle 848 (if cua--rectangle
828 (cua--delete-rectangle) 849 (progn
850 (goto-char (min (mark) (point)))
851 (setq paste-column (cua--rectangle-left))
852 (setq paste-lines (cua--delete-rectangle))
853 (if (= paste-lines 1)
854 (setq paste-lines nil))) ;; paste all
829 (if (string= (buffer-substring (point) (mark)) 855 (if (string= (buffer-substring (point) (mark))
830 (car kill-ring)) 856 (car kill-ring))
831 (current-kill 1)) 857 (current-kill 1))
@@ -843,7 +869,8 @@ If global mark is active, copy from register or one character."
843 (setq this-command 'cua--paste-rectangle) 869 (setq this-command 'cua--paste-rectangle)
844 (undo-boundary) 870 (undo-boundary)
845 (setq buffer-undo-list (cons pt buffer-undo-list))) 871 (setq buffer-undo-list (cons pt buffer-undo-list)))
846 (cua--insert-rectangle (cdr cua--last-killed-rectangle)) 872 (cua--insert-rectangle (cdr cua--last-killed-rectangle)
873 nil paste-column paste-lines)
847 (if arg (goto-char pt)))) 874 (if arg (goto-char pt))))
848 (t (yank arg))))))) 875 (t (yank arg)))))))
849 876
@@ -1033,9 +1060,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
1033 ((and buffer-read-only 1060 ((and buffer-read-only
1034 cua-read-only-cursor-color) 1061 cua-read-only-cursor-color)
1035 cua-read-only-cursor-color) 1062 cua-read-only-cursor-color)
1036 ((and cua-overwrite-cursor-color 1063 ((and cua-overwrite-cursor-color overwrite-mode)
1037 (or overwrite-mode
1038 (and cua--rectangle (cua--rectangle-padding))))
1039 cua-overwrite-cursor-color) 1064 cua-overwrite-cursor-color)
1040 (t cua-normal-cursor-color))) 1065 (t cua-normal-cursor-color)))
1041 (color (if (consp cursor) (cdr cursor) cursor)) 1066 (color (if (consp cursor) (cdr cursor) cursor))
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 965fe63bced..3270b7fd62c 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -44,10 +44,10 @@
44(require 'rect) 44(require 'rect)
45 45
46;; If non-nil, restrict current region to this rectangle. 46;; If non-nil, restrict current region to this rectangle.
47;; Value is a vector [top bot left right corner ins pad select]. 47;; Value is a vector [top bot left right corner ins virt select].
48;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. 48;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
49;; INS specifies whether to insert on left(nil) or right(t) side. 49;; INS specifies whether to insert on left(nil) or right(t) side.
50;; If PAD is non-nil, tabs are converted to spaces when necessary. 50;; If VIRT is non-nil, virtual straight edges are enabled.
51;; If SELECT is a regexp, only lines starting with that regexp are affected.") 51;; If SELECT is a regexp, only lines starting with that regexp are affected.")
52(defvar cua--rectangle nil) 52(defvar cua--rectangle nil)
53(make-variable-buffer-local 'cua--rectangle) 53(make-variable-buffer-local 'cua--rectangle)
@@ -65,6 +65,12 @@
65(defvar cua--rectangle-overlays nil) 65(defvar cua--rectangle-overlays nil)
66(make-variable-buffer-local 'cua--rectangle-overlays) 66(make-variable-buffer-local 'cua--rectangle-overlays)
67 67
68(defvar cua--overlay-keymap
69 (let ((map (make-sparse-keymap)))
70 (define-key map "\r" 'cua-rotate-rectangle)))
71
72(defvar cua--virtual-edges-debug nil)
73
68;; Per-buffer CUA mode undo list. 74;; Per-buffer CUA mode undo list.
69(defvar cua--undo-list nil) 75(defvar cua--undo-list nil)
70(make-variable-buffer-local 'cua--undo-list) 76(make-variable-buffer-local 'cua--undo-list)
@@ -97,7 +103,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
97(defvar cua--tidy-undo-counter 0 103(defvar cua--tidy-undo-counter 0
98 "Number of times `cua--tidy-undo-lists' have run successfully.") 104 "Number of times `cua--tidy-undo-lists' have run successfully.")
99 105
100;; Clean out danling entries from cua's undo list. 106;; Clean out dangling entries from cua's undo list.
101;; Since this list contains pointers into the standard undo list, 107;; Since this list contains pointers into the standard undo list,
102;; such references are only meningful as undo information if the 108;; such references are only meningful as undo information if the
103;; corresponding entry is still on the standard undo list. 109;; corresponding entry is still on the standard undo list.
@@ -203,11 +209,11 @@ Knows about CUA rectangle highlighting in addition to standard undo."
203 (aref cua--rectangle 5)) 209 (aref cua--rectangle 5))
204 (cua--rectangle-left)))) 210 (cua--rectangle-left))))
205 211
206(defun cua--rectangle-padding (&optional set val) 212(defun cua--rectangle-virtual-edges (&optional set val)
207 ;; Current setting of rectangle padding 213 ;; Current setting of rectangle virtual-edges
208 (if set 214 (if set
209 (aset cua--rectangle 6 val)) 215 (aset cua--rectangle 6 val))
210 (and (not buffer-read-only) 216 (and ;(not buffer-read-only)
211 (aref cua--rectangle 6))) 217 (aref cua--rectangle 6)))
212 218
213(defun cua--rectangle-restriction (&optional val bounded negated) 219(defun cua--rectangle-restriction (&optional val bounded negated)
@@ -226,7 +232,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
226 (if (< (cua--rectangle-bot) (cua--rectangle-top)) 232 (if (< (cua--rectangle-bot) (cua--rectangle-top))
227 (message "rectangle bot < top"))) 233 (message "rectangle bot < top")))
228 234
229(defun cua--rectangle-get-corners (&optional pad) 235(defun cua--rectangle-get-corners ()
230 ;; Calculate the rectangular region represented by point and mark, 236 ;; Calculate the rectangular region represented by point and mark,
231 ;; putting start in the upper left corner and end in the 237 ;; putting start in the upper left corner and end in the
232 ;; bottom right corner. 238 ;; bottom right corner.
@@ -245,12 +251,12 @@ Knows about CUA rectangle highlighting in addition to standard undo."
245 (setq r (1- r))) 251 (setq r (1- r)))
246 (setq l (prog1 r (setq r l))) 252 (setq l (prog1 r (setq r l)))
247 (goto-char top) 253 (goto-char top)
248 (move-to-column l pad) 254 (move-to-column l)
249 (setq top (point)) 255 (setq top (point))
250 (goto-char bot) 256 (goto-char bot)
251 (move-to-column r pad) 257 (move-to-column r)
252 (setq bot (point)))) 258 (setq bot (point))))
253 (vector top bot l r corner 0 pad nil))) 259 (vector top bot l r corner 0 cua-virtual-rectangle-edges nil)))
254 260
255(defun cua--rectangle-set-corners () 261(defun cua--rectangle-set-corners ()
256 ;; Set mark and point in opposite corners of current rectangle. 262 ;; Set mark and point in opposite corners of current rectangle.
@@ -269,24 +275,31 @@ Knows about CUA rectangle highlighting in addition to standard undo."
269 (setq pp (cua--rectangle-bot) pc (cua--rectangle-right) 275 (setq pp (cua--rectangle-bot) pc (cua--rectangle-right)
270 mp (cua--rectangle-top) mc (cua--rectangle-left)))) 276 mp (cua--rectangle-top) mc (cua--rectangle-left))))
271 (goto-char mp) 277 (goto-char mp)
272 (move-to-column mc (cua--rectangle-padding)) 278 (move-to-column mc)
273 (set-mark (point)) 279 (set-mark (point))
274 (goto-char pp) 280 (goto-char pp)
275 (move-to-column pc (cua--rectangle-padding)))) 281 ;; Move cursor inside rectangle, except if char at rigth edge is a tab.
282 (if (and (if (cua--rectangle-right-side)
283 (and (= (move-to-column pc) (- pc tab-width))
284 (not (eolp)))
285 (> (move-to-column pc) pc))
286 (not (bolp)))
287 (backward-char 1))
288 ))
276 289
277;;; Rectangle resizing 290;;; Rectangle resizing
278 291
279(defun cua--forward-line (n pad) 292(defun cua--forward-line (n)
280 ;; Move forward/backward one line. Returns t if movement. 293 ;; Move forward/backward one line. Returns t if movement.
281 (if (or (not pad) (< n 0)) 294 (let ((pt (point)))
282 (= (forward-line n) 0) 295 (and (= (forward-line n) 0)
283 (next-line 1) 296 ;; Deal with end of buffer
284 t)) 297 (or (not (eobp))
298 (goto-char pt)))))
285 299
286(defun cua--rectangle-resized () 300(defun cua--rectangle-resized ()
287 ;; Refresh state after resizing rectangle 301 ;; Refresh state after resizing rectangle
288 (setq cua--buffer-and-point-before-command nil) 302 (setq cua--buffer-and-point-before-command nil)
289 (cua--pad-rectangle)
290 (cua--rectangle-insert-col 0) 303 (cua--rectangle-insert-col 0)
291 (cua--rectangle-set-corners) 304 (cua--rectangle-set-corners)
292 (cua--keep-active)) 305 (cua--keep-active))
@@ -294,47 +307,35 @@ Knows about CUA rectangle highlighting in addition to standard undo."
294(defun cua-resize-rectangle-right (n) 307(defun cua-resize-rectangle-right (n)
295 "Resize rectangle to the right." 308 "Resize rectangle to the right."
296 (interactive "p") 309 (interactive "p")
297 (let ((pad (cua--rectangle-padding)) (resized (> n 0))) 310 (let ((resized (> n 0)))
298 (while (> n 0) 311 (while (> n 0)
299 (setq n (1- n)) 312 (setq n (1- n))
300 (cond 313 (cond
301 ((and (cua--rectangle-right-side) (or pad (eolp)))
302 (cua--rectangle-right (1+ (cua--rectangle-right)))
303 (move-to-column (cua--rectangle-right) pad))
304 ((cua--rectangle-right-side) 314 ((cua--rectangle-right-side)
305 (forward-char 1) 315 (cua--rectangle-right (1+ (cua--rectangle-right)))
306 (cua--rectangle-right (current-column))) 316 (move-to-column (cua--rectangle-right)))
307 ((or pad (eolp))
308 (cua--rectangle-left (1+ (cua--rectangle-left)))
309 (move-to-column (cua--rectangle-right) pad))
310 (t 317 (t
311 (forward-char 1) 318 (cua--rectangle-left (1+ (cua--rectangle-left)))
312 (cua--rectangle-left (current-column))))) 319 (move-to-column (cua--rectangle-right)))))
313 (if resized 320 (if resized
314 (cua--rectangle-resized)))) 321 (cua--rectangle-resized))))
315 322
316(defun cua-resize-rectangle-left (n) 323(defun cua-resize-rectangle-left (n)
317 "Resize rectangle to the left." 324 "Resize rectangle to the left."
318 (interactive "p") 325 (interactive "p")
319 (let ((pad (cua--rectangle-padding)) resized) 326 (let (resized)
320 (while (> n 0) 327 (while (> n 0)
321 (setq n (1- n)) 328 (setq n (1- n))
322 (if (or (= (cua--rectangle-right) 0) 329 (if (or (= (cua--rectangle-right) 0)
323 (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0))) 330 (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0)))
324 (setq n 0) 331 (setq n 0)
325 (cond 332 (cond
326 ((and (cua--rectangle-right-side) (or pad (eolp) (bolp)))
327 (cua--rectangle-right (1- (cua--rectangle-right)))
328 (move-to-column (cua--rectangle-right) pad))
329 ((cua--rectangle-right-side) 333 ((cua--rectangle-right-side)
330 (backward-char 1) 334 (cua--rectangle-right (1- (cua--rectangle-right)))
331 (cua--rectangle-right (current-column))) 335 (move-to-column (cua--rectangle-right)))
332 ((or pad (eolp) (bolp))
333 (cua--rectangle-left (1- (cua--rectangle-left)))
334 (move-to-column (cua--rectangle-right) pad))
335 (t 336 (t
336 (backward-char 1) 337 (cua--rectangle-left (1- (cua--rectangle-left)))
337 (cua--rectangle-left (current-column)))) 338 (move-to-column (cua--rectangle-right))))
338 (setq resized t))) 339 (setq resized t)))
339 (if resized 340 (if resized
340 (cua--rectangle-resized)))) 341 (cua--rectangle-resized))))
@@ -342,20 +343,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
342(defun cua-resize-rectangle-down (n) 343(defun cua-resize-rectangle-down (n)
343 "Resize rectangle downwards." 344 "Resize rectangle downwards."
344 (interactive "p") 345 (interactive "p")
345 (let ((pad (cua--rectangle-padding)) resized) 346 (let (resized)
346 (while (> n 0) 347 (while (> n 0)
347 (setq n (1- n)) 348 (setq n (1- n))
348 (cond 349 (cond
349 ((>= (cua--rectangle-corner) 2) 350 ((>= (cua--rectangle-corner) 2)
350 (goto-char (cua--rectangle-bot)) 351 (goto-char (cua--rectangle-bot))
351 (when (cua--forward-line 1 pad) 352 (when (cua--forward-line 1)
352 (move-to-column (cua--rectangle-column) pad) 353 (move-to-column (cua--rectangle-column))
353 (cua--rectangle-bot t) 354 (cua--rectangle-bot t)
354 (setq resized t))) 355 (setq resized t)))
355 (t 356 (t
356 (goto-char (cua--rectangle-top)) 357 (goto-char (cua--rectangle-top))
357 (when (cua--forward-line 1 pad) 358 (when (cua--forward-line 1)
358 (move-to-column (cua--rectangle-column) pad) 359 (move-to-column (cua--rectangle-column))
359 (cua--rectangle-top t) 360 (cua--rectangle-top t)
360 (setq resized t))))) 361 (setq resized t)))))
361 (if resized 362 (if resized
@@ -364,20 +365,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
364(defun cua-resize-rectangle-up (n) 365(defun cua-resize-rectangle-up (n)
365 "Resize rectangle upwards." 366 "Resize rectangle upwards."
366 (interactive "p") 367 (interactive "p")
367 (let ((pad (cua--rectangle-padding)) resized) 368 (let (resized)
368 (while (> n 0) 369 (while (> n 0)
369 (setq n (1- n)) 370 (setq n (1- n))
370 (cond 371 (cond
371 ((>= (cua--rectangle-corner) 2) 372 ((>= (cua--rectangle-corner) 2)
372 (goto-char (cua--rectangle-bot)) 373 (goto-char (cua--rectangle-bot))
373 (when (cua--forward-line -1 pad) 374 (when (cua--forward-line -1)
374 (move-to-column (cua--rectangle-column) pad) 375 (move-to-column (cua--rectangle-column))
375 (cua--rectangle-bot t) 376 (cua--rectangle-bot t)
376 (setq resized t))) 377 (setq resized t)))
377 (t 378 (t
378 (goto-char (cua--rectangle-top)) 379 (goto-char (cua--rectangle-top))
379 (when (cua--forward-line -1 pad) 380 (when (cua--forward-line -1)
380 (move-to-column (cua--rectangle-column) pad) 381 (move-to-column (cua--rectangle-column))
381 (cua--rectangle-top t) 382 (cua--rectangle-top t)
382 (setq resized t))))) 383 (setq resized t)))))
383 (if resized 384 (if resized
@@ -408,7 +409,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
408 "Resize rectangle to bottom of buffer." 409 "Resize rectangle to bottom of buffer."
409 (interactive) 410 (interactive)
410 (goto-char (point-max)) 411 (goto-char (point-max))
411 (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) 412 (move-to-column (cua--rectangle-column))
412 (cua--rectangle-bot t) 413 (cua--rectangle-bot t)
413 (cua--rectangle-resized)) 414 (cua--rectangle-resized))
414 415
@@ -416,31 +417,29 @@ Knows about CUA rectangle highlighting in addition to standard undo."
416 "Resize rectangle to top of buffer." 417 "Resize rectangle to top of buffer."
417 (interactive) 418 (interactive)
418 (goto-char (point-min)) 419 (goto-char (point-min))
419 (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) 420 (move-to-column (cua--rectangle-column))
420 (cua--rectangle-top t) 421 (cua--rectangle-top t)
421 (cua--rectangle-resized)) 422 (cua--rectangle-resized))
422 423
423(defun cua-resize-rectangle-page-up () 424(defun cua-resize-rectangle-page-up ()
424 "Resize rectangle upwards by one scroll page." 425 "Resize rectangle upwards by one scroll page."
425 (interactive) 426 (interactive)
426 (let ((pad (cua--rectangle-padding))) 427 (scroll-down)
427 (scroll-down) 428 (move-to-column (cua--rectangle-column))
428 (move-to-column (cua--rectangle-column) pad) 429 (if (>= (cua--rectangle-corner) 2)
429 (if (>= (cua--rectangle-corner) 2) 430 (cua--rectangle-bot t)
430 (cua--rectangle-bot t) 431 (cua--rectangle-top t))
431 (cua--rectangle-top t)) 432 (cua--rectangle-resized))
432 (cua--rectangle-resized)))
433 433
434(defun cua-resize-rectangle-page-down () 434(defun cua-resize-rectangle-page-down ()
435 "Resize rectangle downwards by one scroll page." 435 "Resize rectangle downwards by one scroll page."
436 (interactive) 436 (interactive)
437 (let ((pad (cua--rectangle-padding))) 437 (scroll-up)
438 (scroll-up) 438 (move-to-column (cua--rectangle-column))
439 (move-to-column (cua--rectangle-column) pad) 439 (if (>= (cua--rectangle-corner) 2)
440 (if (>= (cua--rectangle-corner) 2) 440 (cua--rectangle-bot t)
441 (cua--rectangle-bot t) 441 (cua--rectangle-top t))
442 (cua--rectangle-top t)) 442 (cua--rectangle-resized))
443 (cua--rectangle-resized)))
444 443
445;;; Mouse support 444;;; Mouse support
446 445
@@ -450,7 +449,8 @@ Knows about CUA rectangle highlighting in addition to standard undo."
450 "Set rectangle corner at mouse click position." 449 "Set rectangle corner at mouse click position."
451 (interactive "e") 450 (interactive "e")
452 (mouse-set-point event) 451 (mouse-set-point event)
453 (if (cua--rectangle-padding) 452 ;; FIX ME -- need to calculate virtual column.
453 (if (cua--rectangle-virtual-edges)
454 (move-to-column (car (posn-col-row (event-end event))) t)) 454 (move-to-column (car (posn-col-row (event-end event))) t))
455 (if (cua--rectangle-right-side) 455 (if (cua--rectangle-right-side)
456 (cua--rectangle-right (current-column)) 456 (cua--rectangle-right (current-column))
@@ -470,6 +470,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
470 (cua--deactivate t)) 470 (cua--deactivate t))
471 (setq cua--last-rectangle nil) 471 (setq cua--last-rectangle nil)
472 (mouse-set-point event) 472 (mouse-set-point event)
473 ;; FIX ME -- need to calculate virtual column.
473 (cua-set-rectangle-mark) 474 (cua-set-rectangle-mark)
474 (setq cua--buffer-and-point-before-command nil) 475 (setq cua--buffer-and-point-before-command nil)
475 (setq cua--mouse-last-pos nil)) 476 (setq cua--mouse-last-pos nil))
@@ -489,13 +490,13 @@ If command is repeated at same position, delete the rectangle."
489 (let ((cua-keep-region-after-copy t)) 490 (let ((cua-keep-region-after-copy t))
490 (cua-copy-rectangle arg) 491 (cua-copy-rectangle arg)
491 (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle))))) 492 (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
493
492(defun cua--mouse-ignore (event) 494(defun cua--mouse-ignore (event)
493 (interactive "e") 495 (interactive "e")
494 (setq this-command last-command)) 496 (setq this-command last-command))
495 497
496(defun cua--rectangle-move (dir) 498(defun cua--rectangle-move (dir)
497 (let ((pad (cua--rectangle-padding)) 499 (let ((moved t)
498 (moved t)
499 (top (cua--rectangle-top)) 500 (top (cua--rectangle-top))
500 (bot (cua--rectangle-bot)) 501 (bot (cua--rectangle-bot))
501 (l (cua--rectangle-left)) 502 (l (cua--rectangle-left))
@@ -503,17 +504,17 @@ If command is repeated at same position, delete the rectangle."
503 (cond 504 (cond
504 ((eq dir 'up) 505 ((eq dir 'up)
505 (goto-char top) 506 (goto-char top)
506 (when (cua--forward-line -1 pad) 507 (when (cua--forward-line -1)
507 (cua--rectangle-top t) 508 (cua--rectangle-top t)
508 (goto-char bot) 509 (goto-char bot)
509 (forward-line -1) 510 (forward-line -1)
510 (cua--rectangle-bot t))) 511 (cua--rectangle-bot t)))
511 ((eq dir 'down) 512 ((eq dir 'down)
512 (goto-char bot) 513 (goto-char bot)
513 (when (cua--forward-line 1 pad) 514 (when (cua--forward-line 1)
514 (cua--rectangle-bot t) 515 (cua--rectangle-bot t)
515 (goto-char top) 516 (goto-char top)
516 (cua--forward-line 1 pad) 517 (cua--forward-line 1)
517 (cua--rectangle-top t))) 518 (cua--rectangle-top t)))
518 ((eq dir 'left) 519 ((eq dir 'left)
519 (when (> l 0) 520 (when (> l 0)
@@ -526,19 +527,37 @@ If command is repeated at same position, delete the rectangle."
526 (setq moved nil))) 527 (setq moved nil)))
527 (when moved 528 (when moved
528 (setq cua--buffer-and-point-before-command nil) 529 (setq cua--buffer-and-point-before-command nil)
529 (cua--pad-rectangle)
530 (cua--rectangle-set-corners) 530 (cua--rectangle-set-corners)
531 (cua--keep-active)))) 531 (cua--keep-active))))
532 532
533 533
534;;; Operations on current rectangle 534;;; Operations on current rectangle
535 535
536(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct) 536(defun cua--tabify-start (start end)
537 ;; Return position where auto-tabify should start (or nil if not required).
538 (save-excursion
539 (save-restriction
540 (widen)
541 (and (not buffer-read-only)
542 cua-auto-tabify-rectangles
543 (if (or (not (integerp cua-auto-tabify-rectangles))
544 (= (point-min) (point-max))
545 (progn
546 (goto-char (max (point-min)
547 (- start cua-auto-tabify-rectangles)))
548 (search-forward "\t" (min (point-max)
549 (+ end cua-auto-tabify-rectangles)) t)))
550 start)))))
551
552(defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct)
537 ;; Call FCT for each line of region with 4 parameters: 553 ;; Call FCT for each line of region with 4 parameters:
538 ;; Region start, end, left-col, right-col 554 ;; Region start, end, left-col, right-col
539 ;; Point is at start when FCT is called 555 ;; Point is at start when FCT is called
556 ;; Call fct with (s,e) = whole lines if VISIBLE non-nil.
557 ;; Only call fct for visible lines if VISIBLE==t.
540 ;; Set undo boundary if UNDO is non-nil. 558 ;; Set undo boundary if UNDO is non-nil.
541 ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding) 559 ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
560 ;; Perform auto-tabify after operation if TABIFY is non-nil.
542 ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. 561 ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
543 (let* ((start (cua--rectangle-top)) 562 (let* ((start (cua--rectangle-top))
544 (end (cua--rectangle-bot)) 563 (end (cua--rectangle-bot))
@@ -546,11 +565,12 @@ If command is repeated at same position, delete the rectangle."
546 (r (1+ (cua--rectangle-right))) 565 (r (1+ (cua--rectangle-right)))
547 (m (make-marker)) 566 (m (make-marker))
548 (tabpad (and (integerp pad) (= pad 2))) 567 (tabpad (and (integerp pad) (= pad 2)))
549 (sel (cua--rectangle-restriction))) 568 (sel (cua--rectangle-restriction))
569 (tabify-start (and tabify (cua--tabify-start start end))))
550 (if undo 570 (if undo
551 (cua--rectangle-undo-boundary)) 571 (cua--rectangle-undo-boundary))
552 (if (integerp pad) 572 (if (integerp pad)
553 (setq pad (cua--rectangle-padding))) 573 (setq pad (cua--rectangle-virtual-edges)))
554 (save-excursion 574 (save-excursion
555 (save-restriction 575 (save-restriction
556 (widen) 576 (widen)
@@ -558,11 +578,13 @@ If command is repeated at same position, delete the rectangle."
558 (goto-char end) 578 (goto-char end)
559 (and (bolp) (not (eolp)) (not (eobp)) 579 (and (bolp) (not (eolp)) (not (eobp))
560 (setq end (1+ end)))) 580 (setq end (1+ end))))
561 (when visible 581 (when (eq visible t)
562 (setq start (max (window-start) start)) 582 (setq start (max (window-start) start))
563 (setq end (min (window-end) end))) 583 (setq end (min (window-end) end)))
564 (goto-char end) 584 (goto-char end)
565 (setq end (line-end-position)) 585 (setq end (line-end-position))
586 (if (and visible (bolp) (not (eobp)))
587 (setq end (1+ end)))
566 (goto-char start) 588 (goto-char start)
567 (setq start (line-beginning-position)) 589 (setq start (line-beginning-position))
568 (narrow-to-region start end) 590 (narrow-to-region start end)
@@ -575,7 +597,7 @@ If command is repeated at same position, delete the rectangle."
575 (forward-char 1)) 597 (forward-char 1))
576 (set-marker m (point)) 598 (set-marker m (point))
577 (move-to-column l pad) 599 (move-to-column l pad)
578 (if (and fct (>= (current-column) l) (<= (current-column) r)) 600 (if (and fct (or visible (and (>= (current-column) l) (<= (current-column) r))))
579 (let ((v t) (p (point))) 601 (let ((v t) (p (point)))
580 (when sel 602 (when sel
581 (if (car (cdr sel)) 603 (if (car (cdr sel))
@@ -585,8 +607,7 @@ If command is repeated at same position, delete the rectangle."
585 (if (car (cdr (cdr sel))) 607 (if (car (cdr (cdr sel)))
586 (setq v (null v)))) 608 (setq v (null v))))
587 (if visible 609 (if visible
588 (unless (eolp) 610 (funcall fct p m l r v)
589 (funcall fct p m l r v))
590 (if v 611 (if v
591 (funcall fct p m l r))))) 612 (funcall fct p m l r)))))
592 (set-marker m nil) 613 (set-marker m nil)
@@ -594,7 +615,9 @@ If command is repeated at same position, delete the rectangle."
594 (if (not visible) 615 (if (not visible)
595 (cua--rectangle-bot t)) 616 (cua--rectangle-bot t))
596 (if post-fct 617 (if post-fct
597 (funcall post-fct l r)))) 618 (funcall post-fct l r))
619 (when tabify-start
620 (tabify tabify-start (point)))))
598 (cond 621 (cond
599 ((eq keep-clear 'keep) 622 ((eq keep-clear 'keep)
600 (cua--keep-active)) 623 (cua--keep-active))
@@ -607,48 +630,96 @@ If command is repeated at same position, delete the rectangle."
607 630
608(put 'cua--rectangle-operation 'lisp-indent-function 4) 631(put 'cua--rectangle-operation 'lisp-indent-function 4)
609 632
610(defun cua--pad-rectangle (&optional pad)
611 (if (or pad (cua--rectangle-padding))
612 (cua--rectangle-operation nil nil t t)))
613
614(defun cua--delete-rectangle () 633(defun cua--delete-rectangle ()
615 (cua--rectangle-operation nil nil t 2 634 (let ((lines 0))
616 '(lambda (s e l r) 635 (if (not (cua--rectangle-virtual-edges))
617 (if (and (> e s) (<= e (point-max))) 636 (cua--rectangle-operation nil nil t 2 t
618 (delete-region s e))))) 637 '(lambda (s e l r v)
638 (setq lines (1+ lines))
639 (if (and (> e s) (<= e (point-max)))
640 (delete-region s e))))
641 (cua--rectangle-operation nil 1 t nil t
642 '(lambda (s e l r v)
643 (setq lines (1+ lines))
644 (when (and (> e s) (<= e (point-max)))
645 (delete-region s e)))))
646 lines))
619 647
620(defun cua--extract-rectangle () 648(defun cua--extract-rectangle ()
621 (let (rect) 649 (let (rect)
622 (cua--rectangle-operation nil nil nil 1 650 (if (not (cua--rectangle-virtual-edges))
623 '(lambda (s e l r) 651 (cua--rectangle-operation nil nil nil nil nil ; do not tabify
624 (setq rect (cons (buffer-substring-no-properties s e) rect)))) 652 '(lambda (s e l r)
625 (nreverse rect))) 653 (setq rect (cons (buffer-substring-no-properties s e) rect))))
626 654 (cua--rectangle-operation nil 1 nil nil nil ; do not tabify
627(defun cua--insert-rectangle (rect &optional below) 655 '(lambda (s e l r v)
656 (let ((copy t) (bs 0) (as 0) row)
657 (if (= s e) (setq e (1+ e)))
658 (goto-char s)
659 (move-to-column l)
660 (if (= (point) (line-end-position))
661 (setq bs (- r l)
662 copy nil)
663 (skip-chars-forward "\s\t" e)
664 (setq bs (- (min r (current-column)) l)
665 s (point))
666 (move-to-column r)
667 (skip-chars-backward "\s\t" s)
668 (setq as (- r (max (current-column) l))
669 e (point)))
670 (setq row (if (and copy (> e s))
671 (buffer-substring-no-properties s e)
672 ""))
673 (when (> bs 0)
674 (setq row (concat (make-string bs ?\s) row)))
675 (when (> as 0)
676 (setq row (concat row (make-string as ?\s))))
677 (setq rect (cons row rect))))))
678 (nreverse rect)))
679
680(defun cua--insert-rectangle (rect &optional below paste-column line-count)
628 ;; Insert rectangle as insert-rectangle, but don't set mark and exit with 681 ;; Insert rectangle as insert-rectangle, but don't set mark and exit with
629 ;; point at either next to top right or below bottom left corner 682 ;; point at either next to top right or below bottom left corner
630 ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. 683 ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines.
631 (if (and below (eq below 'auto)) 684 (if (eq below 'auto)
632 (setq below (and (bolp) 685 (setq below (and (bolp)
633 (or (eolp) (eobp) (= (1+ (point)) (point-max)))))) 686 (or (eolp) (eobp) (= (1+ (point)) (point-max))))))
687 (unless paste-column
688 (setq paste-column (current-column)))
634 (let ((lines rect) 689 (let ((lines rect)
635 (insertcolumn (current-column))
636 (first t) 690 (first t)
691 (tabify-start (cua--tabify-start (point) (point)))
692 last-column
637 p) 693 p)
638 (while (or lines below) 694 (while (or lines below)
639 (or first 695 (or first
640 (if overwrite-mode 696 (if overwrite-mode
641 (insert ?\n) 697 (insert ?\n)
642 (forward-line 1) 698 (forward-line 1)
643 (or (bolp) (insert ?\n)) 699 (or (bolp) (insert ?\n))))
644 (move-to-column insertcolumn t))) 700 (unless overwrite-mode
701 (move-to-column paste-column t))
645 (if (not lines) 702 (if (not lines)
646 (setq below nil) 703 (setq below nil)
647 (insert-for-yank (car lines)) 704 (insert-for-yank (car lines))
705 (unless last-column
706 (setq last-column (current-column)))
648 (setq lines (cdr lines)) 707 (setq lines (cdr lines))
649 (and first (not below) 708 (and first (not below)
650 (setq p (point)))) 709 (setq p (point))))
651 (setq first nil)) 710 (setq first nil)
711 (if (and line-count (= (setq line-count (1- line-count)) 0))
712 (setq lines nil)))
713 (when (and line-count last-column (not overwrite-mode))
714 (while (> line-count 0)
715 (forward-line 1)
716 (or (bolp) (insert ?\n))
717 (move-to-column paste-column t)
718 (insert-char ?\s (- last-column paste-column -1))
719 (setq line-count (1- line-count))))
720 (when (and tabify-start
721 (not overwrite-mode))
722 (tabify tabify-start (point)))
652 (and p (not overwrite-mode) 723 (and p (not overwrite-mode)
653 (goto-char p)))) 724 (goto-char p))))
654 725
@@ -662,7 +733,7 @@ If command is repeated at same position, delete the rectangle."
662 (function (lambda (row) (concat row "\n"))) 733 (function (lambda (row) (concat row "\n")))
663 killed-rectangle ""))))) 734 killed-rectangle "")))))
664 735
665(defun cua--activate-rectangle (&optional force) 736(defun cua--activate-rectangle ()
666 ;; Turn on rectangular marking mode by disabling transient mark mode 737 ;; Turn on rectangular marking mode by disabling transient mark mode
667 ;; and manually handling highlighting from a post command hook. 738 ;; and manually handling highlighting from a post command hook.
668 ;; Be careful if we are already marking a rectangle. 739 ;; Be careful if we are already marking a rectangle.
@@ -671,12 +742,8 @@ If command is repeated at same position, delete the rectangle."
671 (eq (car cua--last-rectangle) (current-buffer)) 742 (eq (car cua--last-rectangle) (current-buffer))
672 (eq (car (cdr cua--last-rectangle)) (point))) 743 (eq (car (cdr cua--last-rectangle)) (point)))
673 (cdr (cdr cua--last-rectangle)) 744 (cdr (cdr cua--last-rectangle))
674 (cua--rectangle-get-corners 745 (cua--rectangle-get-corners))
675 (and (not buffer-read-only) 746 cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "")
676 (or cua-auto-expand-rectangles
677 force
678 (eq major-mode 'picture-mode)))))
679 cua--status-string (if (cua--rectangle-padding) " Pad" "")
680 cua--last-rectangle nil)) 747 cua--last-rectangle nil))
681 748
682;; (defvar cua-save-point nil) 749;; (defvar cua-save-point nil)
@@ -698,7 +765,7 @@ If command is repeated at same position, delete the rectangle."
698 ;; Each overlay extends across all the columns of the rectangle. 765 ;; Each overlay extends across all the columns of the rectangle.
699 ;; We try to reuse overlays where possible because this is more efficient 766 ;; We try to reuse overlays where possible because this is more efficient
700 ;; and results in less flicker. 767 ;; and results in less flicker.
701 ;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines, 768 ;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or short lines,
702 ;; the higlighted region may not be perfectly rectangular. 769 ;; the higlighted region may not be perfectly rectangular.
703 (let ((deactivate-mark deactivate-mark) 770 (let ((deactivate-mark deactivate-mark)
704 (old cua--rectangle-overlays) 771 (old cua--rectangle-overlays)
@@ -707,12 +774,67 @@ If command is repeated at same position, delete the rectangle."
707 (right (1+ (cua--rectangle-right)))) 774 (right (1+ (cua--rectangle-right))))
708 (when (/= left right) 775 (when (/= left right)
709 (sit-for 0) ; make window top/bottom reliable 776 (sit-for 0) ; make window top/bottom reliable
710 (cua--rectangle-operation nil t nil nil 777 (cua--rectangle-operation nil t nil nil nil ; do not tabify
711 '(lambda (s e l r v) 778 '(lambda (s e l r v)
712 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) 779 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face))
713 overlay) 780 overlay bs ms as)
714 ;; Trim old leading overlays.
715 (if (= s e) (setq e (1+ e))) 781 (if (= s e) (setq e (1+ e)))
782 (when (cua--rectangle-virtual-edges)
783 (let ((lb (line-beginning-position))
784 (le (line-end-position))
785 cl cl0 pl cr cr0 pr)
786 (goto-char s)
787 (setq cl (move-to-column l)
788 pl (point))
789 (setq cr (move-to-column r)
790 pr (point))
791 (if (= lb pl)
792 (setq cl0 0)
793 (goto-char (1- pl))
794 (setq cl0 (current-column)))
795 (if (= lb le)
796 (setq cr0 0)
797 (goto-char (1- pr))
798 (setq cr0 (current-column)))
799 (unless (and (= cl l) (= cr r))
800 (when (/= cl l)
801 (setq bs (propertize
802 (make-string
803 (- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
804 (if cua--virtual-edges-debug ?. ?\s))
805 'face 'default))
806 (if (/= pl le)
807 (setq s (1- s))))
808 (cond
809 ((= cr r)
810 (if (and (/= pr le)
811 (/= cr0 (1- cr))
812 (or bs (/= cr0 (- cr tab-width)))
813 (/= (mod cr tab-width) 0))
814 (setq e (1- e))))
815 ((= cr cl)
816 (setq ms (propertize
817 (make-string
818 (- r l)
819 (if cua--virtual-edges-debug ?, ?\s))
820 'face rface))
821 (if (cua--rectangle-right-side)
822 (put-text-property (1- (length ms)) (length ms) 'cursor t ms)
823 (put-text-property 0 1 'cursor t ms))
824 (setq bs (concat bs ms))
825 (setq rface nil))
826 (t
827 (setq as (propertize
828 (make-string
829 (- r cr0 (if (= le pr) 1 0))
830 (if cua--virtual-edges-debug ?~ ?\s))
831 'face rface))
832 (if (cua--rectangle-right-side)
833 (put-text-property (1- (length as)) (length as) 'cursor t as)
834 (put-text-property 0 1 'cursor t as))
835 (if (/= pr le)
836 (setq e (1- e))))))))
837 ;; Trim old leading overlays.
716 (while (and old 838 (while (and old
717 (setq overlay (car old)) 839 (setq overlay (car old))
718 (< (overlay-start overlay) s) 840 (< (overlay-start overlay) s)
@@ -728,8 +850,11 @@ If command is repeated at same position, delete the rectangle."
728 (move-overlay overlay s e) 850 (move-overlay overlay s e)
729 (setq old (cdr old))) 851 (setq old (cdr old)))
730 (setq overlay (make-overlay s e))) 852 (setq overlay (make-overlay s e)))
731 (overlay-put overlay 'face rface) 853 (overlay-put overlay 'before-string bs)
732 (setq new (cons overlay new)))))) 854 (overlay-put overlay 'after-string as)
855 (overlay-put overlay 'face rface)
856 (overlay-put overlay 'keymap cua--overlay-keymap)
857 (setq new (cons overlay new))))))
733 ;; Trim old trailing overlays. 858 ;; Trim old trailing overlays.
734 (mapcar (function delete-overlay) old) 859 (mapcar (function delete-overlay) old)
735 (setq cua--rectangle-overlays (nreverse new)))) 860 (setq cua--rectangle-overlays (nreverse new))))
@@ -737,9 +862,9 @@ If command is repeated at same position, delete the rectangle."
737(defun cua--indent-rectangle (&optional ch to-col clear) 862(defun cua--indent-rectangle (&optional ch to-col clear)
738 ;; Indent current rectangle. 863 ;; Indent current rectangle.
739 (let ((col (cua--rectangle-insert-col)) 864 (let ((col (cua--rectangle-insert-col))
740 (pad (cua--rectangle-padding)) 865 (pad (cua--rectangle-virtual-edges))
741 indent) 866 indent)
742 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad 867 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil
743 '(lambda (s e l r) 868 '(lambda (s e l r)
744 (move-to-column col pad) 869 (move-to-column col pad)
745 (if (and (eolp) 870 (if (and (eolp)
@@ -875,23 +1000,22 @@ With prefix argument, the toggle restriction."
875(defun cua-rotate-rectangle () 1000(defun cua-rotate-rectangle ()
876 (interactive) 1001 (interactive)
877 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) 1002 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
878 (cua--rectangle-set-corners)) 1003 (cua--rectangle-set-corners)
1004 (if (cua--rectangle-virtual-edges)
1005 (setq cua--buffer-and-point-before-command nil)))
879 1006
880(defun cua-toggle-rectangle-padding () 1007(defun cua-toggle-rectangle-virtual-edges ()
881 (interactive) 1008 (interactive)
882 (if buffer-read-only 1009 (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges)))
883 (message "Cannot do padding in read-only buffer.") 1010 (cua--rectangle-set-corners)
884 (cua--rectangle-padding t (not (cua--rectangle-padding))) 1011 (setq cua--status-string (and (cua--rectangle-virtual-edges) " [R]"))
885 (cua--pad-rectangle)
886 (cua--rectangle-set-corners))
887 (setq cua--status-string (and (cua--rectangle-padding) " Pad"))
888 (cua--keep-active)) 1012 (cua--keep-active))
889 1013
890(defun cua-do-rectangle-padding () 1014(defun cua-do-rectangle-padding ()
891 (interactive) 1015 (interactive)
892 (if buffer-read-only 1016 (if buffer-read-only
893 (message "Cannot do padding in read-only buffer.") 1017 (message "Cannot do padding in read-only buffer.")
894 (cua--pad-rectangle t) 1018 (cua--rectangle-operation nil nil t t t)
895 (cua--rectangle-set-corners)) 1019 (cua--rectangle-set-corners))
896 (cua--keep-active)) 1020 (cua--keep-active))
897 1021
@@ -900,7 +1024,7 @@ With prefix argument, the toggle restriction."
900The text previously in the region is not overwritten by the blanks, 1024The text previously in the region is not overwritten by the blanks,
901but instead winds up to the right of the rectangle." 1025but instead winds up to the right of the rectangle."
902 (interactive) 1026 (interactive)
903 (cua--rectangle-operation 'corners nil t 1 1027 (cua--rectangle-operation 'corners nil t 1 nil
904 '(lambda (s e l r) 1028 '(lambda (s e l r)
905 (skip-chars-forward " \t") 1029 (skip-chars-forward " \t")
906 (let ((ws (- (current-column) l)) 1030 (let ((ws (- (current-column) l))
@@ -915,7 +1039,7 @@ On each line in the rectangle, all continuous whitespace starting
915at that column is deleted. 1039at that column is deleted.
916With prefix arg, also delete whitespace to the left of that column." 1040With prefix arg, also delete whitespace to the left of that column."
917 (interactive "P") 1041 (interactive "P")
918 (cua--rectangle-operation 'clear nil t 1 1042 (cua--rectangle-operation 'clear nil t 1 nil
919 '(lambda (s e l r) 1043 '(lambda (s e l r)
920 (when arg 1044 (when arg
921 (skip-syntax-backward " " (line-beginning-position)) 1045 (skip-syntax-backward " " (line-beginning-position))
@@ -927,7 +1051,7 @@ With prefix arg, also delete whitespace to the left of that column."
927 "Blank out CUA rectangle. 1051 "Blank out CUA rectangle.
928The text previously in the rectangle is overwritten by the blanks." 1052The text previously in the rectangle is overwritten by the blanks."
929 (interactive) 1053 (interactive)
930 (cua--rectangle-operation 'keep nil nil 1 1054 (cua--rectangle-operation 'keep nil nil 1 nil
931 '(lambda (s e l r) 1055 '(lambda (s e l r)
932 (goto-char e) 1056 (goto-char e)
933 (skip-syntax-forward " " (line-end-position)) 1057 (skip-syntax-forward " " (line-end-position))
@@ -942,7 +1066,7 @@ The text previously in the rectangle is overwritten by the blanks."
942 "Align rectangle lines to left column." 1066 "Align rectangle lines to left column."
943 (interactive) 1067 (interactive)
944 (let (x) 1068 (let (x)
945 (cua--rectangle-operation 'clear nil t t 1069 (cua--rectangle-operation 'clear nil t t nil
946 '(lambda (s e l r) 1070 '(lambda (s e l r)
947 (let ((b (line-beginning-position))) 1071 (let ((b (line-beginning-position)))
948 (skip-syntax-backward "^ " b) 1072 (skip-syntax-backward "^ " b)
@@ -984,7 +1108,7 @@ The text previously in the rectangle is overwritten by the blanks."
984 "Replace CUA rectangle contents with STRING on each line. 1108 "Replace CUA rectangle contents with STRING on each line.
985The length of STRING need not be the same as the rectangle width." 1109The length of STRING need not be the same as the rectangle width."
986 (interactive "sString rectangle: ") 1110 (interactive "sString rectangle: ")
987 (cua--rectangle-operation 'keep nil t t 1111 (cua--rectangle-operation 'keep nil t t nil
988 '(lambda (s e l r) 1112 '(lambda (s e l r)
989 (delete-region s e) 1113 (delete-region s e)
990 (skip-chars-forward " \t") 1114 (skip-chars-forward " \t")
@@ -999,7 +1123,7 @@ The length of STRING need not be the same as the rectangle width."
999(defun cua-fill-char-rectangle (ch) 1123(defun cua-fill-char-rectangle (ch)
1000 "Replace CUA rectangle contents with CHARACTER." 1124 "Replace CUA rectangle contents with CHARACTER."
1001 (interactive "cFill rectangle with character: ") 1125 (interactive "cFill rectangle with character: ")
1002 (cua--rectangle-operation 'clear nil t 1 1126 (cua--rectangle-operation 'clear nil t 1 nil
1003 '(lambda (s e l r) 1127 '(lambda (s e l r)
1004 (delete-region s e) 1128 (delete-region s e)
1005 (move-to-column l t) 1129 (move-to-column l t)
@@ -1010,7 +1134,7 @@ The length of STRING need not be the same as the rectangle width."
1010 (interactive "sReplace regexp: \nsNew text: ") 1134 (interactive "sReplace regexp: \nsNew text: ")
1011 (if buffer-read-only 1135 (if buffer-read-only
1012 (message "Cannot replace in read-only buffer") 1136 (message "Cannot replace in read-only buffer")
1013 (cua--rectangle-operation 'keep nil t 1 1137 (cua--rectangle-operation 'keep nil t 1 nil
1014 '(lambda (s e l r) 1138 '(lambda (s e l r)
1015 (if (re-search-forward regexp e t) 1139 (if (re-search-forward regexp e t)
1016 (replace-match newtext nil nil)))))) 1140 (replace-match newtext nil nil))))))
@@ -1018,7 +1142,7 @@ The length of STRING need not be the same as the rectangle width."
1018(defun cua-incr-rectangle (increment) 1142(defun cua-incr-rectangle (increment)
1019 "Increment each line of CUA rectangle by prefix amount." 1143 "Increment each line of CUA rectangle by prefix amount."
1020 (interactive "p") 1144 (interactive "p")
1021 (cua--rectangle-operation 'keep nil t 1 1145 (cua--rectangle-operation 'keep nil t 1 nil
1022 '(lambda (s e l r) 1146 '(lambda (s e l r)
1023 (cond 1147 (cond
1024 ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) 1148 ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
@@ -1051,36 +1175,36 @@ The numbers are formatted according to the FORMAT string."
1051 (if (= (length fmt) 0) 1175 (if (= (length fmt) 0)
1052 (setq fmt cua--rectangle-seq-format) 1176 (setq fmt cua--rectangle-seq-format)
1053 (setq cua--rectangle-seq-format fmt)) 1177 (setq cua--rectangle-seq-format fmt))
1054 (cua--rectangle-operation 'clear nil t 1 1178 (cua--rectangle-operation 'clear nil t 1 nil
1055 '(lambda (s e l r) 1179 '(lambda (s e l r)
1056 (delete-region s e) 1180 (delete-region s e)
1057 (insert (format fmt first)) 1181 (insert (format fmt first))
1058 (setq first (+ first incr))))) 1182 (setq first (+ first incr)))))
1059 1183
1060(defmacro cua--convert-rectangle-as (command) 1184(defmacro cua--convert-rectangle-as (command tabify)
1061 `(cua--rectangle-operation 'clear nil nil nil 1185 `(cua--rectangle-operation 'clear nil nil nil ,tabify
1062 '(lambda (s e l r) 1186 '(lambda (s e l r)
1063 (,command s e)))) 1187 (,command s e))))
1064 1188
1065(defun cua-upcase-rectangle () 1189(defun cua-upcase-rectangle ()
1066 "Convert the rectangle to upper case." 1190 "Convert the rectangle to upper case."
1067 (interactive) 1191 (interactive)
1068 (cua--convert-rectangle-as upcase-region)) 1192 (cua--convert-rectangle-as upcase-region nil))
1069 1193
1070(defun cua-downcase-rectangle () 1194(defun cua-downcase-rectangle ()
1071 "Convert the rectangle to lower case." 1195 "Convert the rectangle to lower case."
1072 (interactive) 1196 (interactive)
1073 (cua--convert-rectangle-as downcase-region)) 1197 (cua--convert-rectangle-as downcase-region nil))
1074 1198
1075(defun cua-upcase-initials-rectangle () 1199(defun cua-upcase-initials-rectangle ()
1076 "Convert the rectangle initials to upper case." 1200 "Convert the rectangle initials to upper case."
1077 (interactive) 1201 (interactive)
1078 (cua--convert-rectangle-as upcase-initials-region)) 1202 (cua--convert-rectangle-as upcase-initials-region nil))
1079 1203
1080(defun cua-capitalize-rectangle () 1204(defun cua-capitalize-rectangle ()
1081 "Convert the rectangle to proper case." 1205 "Convert the rectangle to proper case."
1082 (interactive) 1206 (interactive)
1083 (cua--convert-rectangle-as capitalize-region)) 1207 (cua--convert-rectangle-as capitalize-region nil))
1084 1208
1085 1209
1086;;; Replace/rearrange text in current rectangle 1210;;; Replace/rearrange text in current rectangle
@@ -1116,7 +1240,7 @@ The numbers are formatted according to the FORMAT string."
1116 (setq z (reverse z)) 1240 (setq z (reverse z))
1117 (if cua--debug 1241 (if cua--debug
1118 (print z auxbuf)) 1242 (print z auxbuf))
1119 (cua--rectangle-operation nil nil t pad 1243 (cua--rectangle-operation nil nil t pad nil
1120 '(lambda (s e l r) 1244 '(lambda (s e l r)
1121 (let (cc) 1245 (let (cc)
1122 (goto-char e) 1246 (goto-char e)
@@ -1232,9 +1356,9 @@ With prefix arg, indent to that column."
1232 "Delete char to left or right of rectangle." 1356 "Delete char to left or right of rectangle."
1233 (interactive) 1357 (interactive)
1234 (let ((col (cua--rectangle-insert-col)) 1358 (let ((col (cua--rectangle-insert-col))
1235 (pad (cua--rectangle-padding)) 1359 (pad (cua--rectangle-virtual-edges))
1236 indent) 1360 indent)
1237 (cua--rectangle-operation 'corners nil t pad 1361 (cua--rectangle-operation 'corners nil t pad nil
1238 '(lambda (s e l r) 1362 '(lambda (s e l r)
1239 (move-to-column 1363 (move-to-column
1240 (if (cua--rectangle-right-side t) 1364 (if (cua--rectangle-right-side t)
@@ -1282,10 +1406,7 @@ With prefix arg, indent to that column."
1282 (cua--rectangle-left (current-column))) 1406 (cua--rectangle-left (current-column)))
1283 (if (>= (cua--rectangle-corner) 2) 1407 (if (>= (cua--rectangle-corner) 2)
1284 (cua--rectangle-bot t) 1408 (cua--rectangle-bot t)
1285 (cua--rectangle-top t)) 1409 (cua--rectangle-top t))))
1286 (if (cua--rectangle-padding)
1287 (setq unread-command-events
1288 (cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events)))))
1289 (if cua--rectangle 1410 (if cua--rectangle
1290 (if (and mark-active 1411 (if (and mark-active
1291 (not deactivate-mark)) 1412 (not deactivate-mark))
@@ -1379,7 +1500,7 @@ With prefix arg, indent to that column."
1379 (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) 1500 (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text)
1380 (cua--rect-M/H-key ?n 'cua-sequence-rectangle) 1501 (cua--rect-M/H-key ?n 'cua-sequence-rectangle)
1381 (cua--rect-M/H-key ?o 'cua-open-rectangle) 1502 (cua--rect-M/H-key ?o 'cua-open-rectangle)
1382 (cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding) 1503 (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges)
1383 (cua--rect-M/H-key ?P 'cua-do-rectangle-padding) 1504 (cua--rect-M/H-key ?P 'cua-do-rectangle-padding)
1384 (cua--rect-M/H-key ?q 'cua-refill-rectangle) 1505 (cua--rect-M/H-key ?q 'cua-refill-rectangle)
1385 (cua--rect-M/H-key ?r 'cua-replace-in-rectangle) 1506 (cua--rect-M/H-key ?r 'cua-replace-in-rectangle)