aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKim F. Storm2004-08-29 20:57:19 +0000
committerKim F. Storm2004-08-29 20:57:19 +0000
commit7279710840de2d2d67d6a91ebfa0a857372de5ec (patch)
treecff8f92406a7479052aeef66d65985429148386c
parent2661eae951908207096f1893eb3159c4944cf2e2 (diff)
downloademacs-7279710840de2d2d67d6a91ebfa0a857372de5ec.tar.gz
emacs-7279710840de2d2d67d6a91ebfa0a857372de5ec.zip
(cua--rectangle-padding): Remove.
(cua--rectangle-virtual-edges): New defun. (cua--rectangle-get-corners): Remove optional PAD arg. (cua--rectangle-set-corners): Never do padding. (cua--forward-line): Remove optional PAD arg. Simplify. (cua-resize-rectangle-right, cua-resize-rectangle-left) (cua-resize-rectangle-down, cua-resize-rectangle-up): (cua-resize-rectangle-bot, cua-resize-rectangle-top) (cua-resize-rectangle-page-up, cua-resize-rectangle-page-down) (cua--rectangle-move): Never do padding. Simplify. (cua--tabify-start): New defun. (cua--rectangle-operation): Add tabify arg. All callers changed. (cua--pad-rectangle): Remove. (cua--delete-rectangle): Handle delete with virtual edges. (cua--extract-rectangle): Add spaces if rectangle has virtual edges. (cua--insert-rectangle): Handle insert at virtual column. Perform auto-tabify if necessary. (cua--activate-rectangle): Remove optional FORCE arg. Never do padding. Simplify. (cua--highlight-rectangle): Enhance for virtual edges. (cua-toggle-rectangle-padding): Remove command. (cua-toggle-rectangle-virtual-edges): New command. (cua-sequence-rectangle): Add optional TABIFY arg. Callers changed. (cua--rectangle-post-command): Don't force rectangle padding. (cua--init-rectangles): Bind M-p to cua-toggle-rectangle-virtual-edges.
-rw-r--r--lisp/emulation/cua-rect.el388
1 files changed, 241 insertions, 147 deletions
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 965fe63bced..626ef22cf2d 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,8 @@
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--virtual-edges-debug nil)
69
68;; Per-buffer CUA mode undo list. 70;; Per-buffer CUA mode undo list.
69(defvar cua--undo-list nil) 71(defvar cua--undo-list nil)
70(make-variable-buffer-local 'cua--undo-list) 72(make-variable-buffer-local 'cua--undo-list)
@@ -97,7 +99,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
97(defvar cua--tidy-undo-counter 0 99(defvar cua--tidy-undo-counter 0
98 "Number of times `cua--tidy-undo-lists' have run successfully.") 100 "Number of times `cua--tidy-undo-lists' have run successfully.")
99 101
100;; Clean out danling entries from cua's undo list. 102;; Clean out dangling entries from cua's undo list.
101;; Since this list contains pointers into the standard undo list, 103;; Since this list contains pointers into the standard undo list,
102;; such references are only meningful as undo information if the 104;; such references are only meningful as undo information if the
103;; corresponding entry is still on the standard undo list. 105;; corresponding entry is still on the standard undo list.
@@ -203,11 +205,11 @@ Knows about CUA rectangle highlighting in addition to standard undo."
203 (aref cua--rectangle 5)) 205 (aref cua--rectangle 5))
204 (cua--rectangle-left)))) 206 (cua--rectangle-left))))
205 207
206(defun cua--rectangle-padding (&optional set val) 208(defun cua--rectangle-virtual-edges (&optional set val)
207 ;; Current setting of rectangle padding 209 ;; Current setting of rectangle virtual-edges
208 (if set 210 (if set
209 (aset cua--rectangle 6 val)) 211 (aset cua--rectangle 6 val))
210 (and (not buffer-read-only) 212 (and ;(not buffer-read-only)
211 (aref cua--rectangle 6))) 213 (aref cua--rectangle 6)))
212 214
213(defun cua--rectangle-restriction (&optional val bounded negated) 215(defun cua--rectangle-restriction (&optional val bounded negated)
@@ -226,7 +228,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
226 (if (< (cua--rectangle-bot) (cua--rectangle-top)) 228 (if (< (cua--rectangle-bot) (cua--rectangle-top))
227 (message "rectangle bot < top"))) 229 (message "rectangle bot < top")))
228 230
229(defun cua--rectangle-get-corners (&optional pad) 231(defun cua--rectangle-get-corners ()
230 ;; Calculate the rectangular region represented by point and mark, 232 ;; Calculate the rectangular region represented by point and mark,
231 ;; putting start in the upper left corner and end in the 233 ;; putting start in the upper left corner and end in the
232 ;; bottom right corner. 234 ;; bottom right corner.
@@ -245,12 +247,12 @@ Knows about CUA rectangle highlighting in addition to standard undo."
245 (setq r (1- r))) 247 (setq r (1- r)))
246 (setq l (prog1 r (setq r l))) 248 (setq l (prog1 r (setq r l)))
247 (goto-char top) 249 (goto-char top)
248 (move-to-column l pad) 250 (move-to-column l)
249 (setq top (point)) 251 (setq top (point))
250 (goto-char bot) 252 (goto-char bot)
251 (move-to-column r pad) 253 (move-to-column r)
252 (setq bot (point)))) 254 (setq bot (point))))
253 (vector top bot l r corner 0 pad nil))) 255 (vector top bot l r corner 0 cua-virtual-rectangle-edges nil)))
254 256
255(defun cua--rectangle-set-corners () 257(defun cua--rectangle-set-corners ()
256 ;; Set mark and point in opposite corners of current rectangle. 258 ;; Set mark and point in opposite corners of current rectangle.
@@ -269,24 +271,21 @@ Knows about CUA rectangle highlighting in addition to standard undo."
269 (setq pp (cua--rectangle-bot) pc (cua--rectangle-right) 271 (setq pp (cua--rectangle-bot) pc (cua--rectangle-right)
270 mp (cua--rectangle-top) mc (cua--rectangle-left)))) 272 mp (cua--rectangle-top) mc (cua--rectangle-left))))
271 (goto-char mp) 273 (goto-char mp)
272 (move-to-column mc (cua--rectangle-padding)) 274 (move-to-column mc)
273 (set-mark (point)) 275 (set-mark (point))
274 (goto-char pp) 276 (goto-char pp)
275 (move-to-column pc (cua--rectangle-padding)))) 277 (move-to-column pc)
278 ))
276 279
277;;; Rectangle resizing 280;;; Rectangle resizing
278 281
279(defun cua--forward-line (n pad) 282(defun cua--forward-line (n)
280 ;; Move forward/backward one line. Returns t if movement. 283 ;; Move forward/backward one line. Returns t if movement.
281 (if (or (not pad) (< n 0)) 284 (= (forward-line n) 0))
282 (= (forward-line n) 0)
283 (next-line 1)
284 t))
285 285
286(defun cua--rectangle-resized () 286(defun cua--rectangle-resized ()
287 ;; Refresh state after resizing rectangle 287 ;; Refresh state after resizing rectangle
288 (setq cua--buffer-and-point-before-command nil) 288 (setq cua--buffer-and-point-before-command nil)
289 (cua--pad-rectangle)
290 (cua--rectangle-insert-col 0) 289 (cua--rectangle-insert-col 0)
291 (cua--rectangle-set-corners) 290 (cua--rectangle-set-corners)
292 (cua--keep-active)) 291 (cua--keep-active))
@@ -294,47 +293,35 @@ Knows about CUA rectangle highlighting in addition to standard undo."
294(defun cua-resize-rectangle-right (n) 293(defun cua-resize-rectangle-right (n)
295 "Resize rectangle to the right." 294 "Resize rectangle to the right."
296 (interactive "p") 295 (interactive "p")
297 (let ((pad (cua--rectangle-padding)) (resized (> n 0))) 296 (let ((resized (> n 0)))
298 (while (> n 0) 297 (while (> n 0)
299 (setq n (1- n)) 298 (setq n (1- n))
300 (cond 299 (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) 300 ((cua--rectangle-right-side)
305 (forward-char 1) 301 (cua--rectangle-right (1+ (cua--rectangle-right)))
306 (cua--rectangle-right (current-column))) 302 (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 303 (t
311 (forward-char 1) 304 (cua--rectangle-left (1+ (cua--rectangle-left)))
312 (cua--rectangle-left (current-column))))) 305 (move-to-column (cua--rectangle-right)))))
313 (if resized 306 (if resized
314 (cua--rectangle-resized)))) 307 (cua--rectangle-resized))))
315 308
316(defun cua-resize-rectangle-left (n) 309(defun cua-resize-rectangle-left (n)
317 "Resize rectangle to the left." 310 "Resize rectangle to the left."
318 (interactive "p") 311 (interactive "p")
319 (let ((pad (cua--rectangle-padding)) resized) 312 (let (resized)
320 (while (> n 0) 313 (while (> n 0)
321 (setq n (1- n)) 314 (setq n (1- n))
322 (if (or (= (cua--rectangle-right) 0) 315 (if (or (= (cua--rectangle-right) 0)
323 (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0))) 316 (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0)))
324 (setq n 0) 317 (setq n 0)
325 (cond 318 (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) 319 ((cua--rectangle-right-side)
330 (backward-char 1) 320 (cua--rectangle-right (1- (cua--rectangle-right)))
331 (cua--rectangle-right (current-column))) 321 (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 322 (t
336 (backward-char 1) 323 (cua--rectangle-left (1- (cua--rectangle-left)))
337 (cua--rectangle-left (current-column)))) 324 (move-to-column (cua--rectangle-right))))
338 (setq resized t))) 325 (setq resized t)))
339 (if resized 326 (if resized
340 (cua--rectangle-resized)))) 327 (cua--rectangle-resized))))
@@ -342,20 +329,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
342(defun cua-resize-rectangle-down (n) 329(defun cua-resize-rectangle-down (n)
343 "Resize rectangle downwards." 330 "Resize rectangle downwards."
344 (interactive "p") 331 (interactive "p")
345 (let ((pad (cua--rectangle-padding)) resized) 332 (let (resized)
346 (while (> n 0) 333 (while (> n 0)
347 (setq n (1- n)) 334 (setq n (1- n))
348 (cond 335 (cond
349 ((>= (cua--rectangle-corner) 2) 336 ((>= (cua--rectangle-corner) 2)
350 (goto-char (cua--rectangle-bot)) 337 (goto-char (cua--rectangle-bot))
351 (when (cua--forward-line 1 pad) 338 (when (cua--forward-line 1)
352 (move-to-column (cua--rectangle-column) pad) 339 (move-to-column (cua--rectangle-column))
353 (cua--rectangle-bot t) 340 (cua--rectangle-bot t)
354 (setq resized t))) 341 (setq resized t)))
355 (t 342 (t
356 (goto-char (cua--rectangle-top)) 343 (goto-char (cua--rectangle-top))
357 (when (cua--forward-line 1 pad) 344 (when (cua--forward-line 1)
358 (move-to-column (cua--rectangle-column) pad) 345 (move-to-column (cua--rectangle-column))
359 (cua--rectangle-top t) 346 (cua--rectangle-top t)
360 (setq resized t))))) 347 (setq resized t)))))
361 (if resized 348 (if resized
@@ -364,20 +351,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
364(defun cua-resize-rectangle-up (n) 351(defun cua-resize-rectangle-up (n)
365 "Resize rectangle upwards." 352 "Resize rectangle upwards."
366 (interactive "p") 353 (interactive "p")
367 (let ((pad (cua--rectangle-padding)) resized) 354 (let (resized)
368 (while (> n 0) 355 (while (> n 0)
369 (setq n (1- n)) 356 (setq n (1- n))
370 (cond 357 (cond
371 ((>= (cua--rectangle-corner) 2) 358 ((>= (cua--rectangle-corner) 2)
372 (goto-char (cua--rectangle-bot)) 359 (goto-char (cua--rectangle-bot))
373 (when (cua--forward-line -1 pad) 360 (when (cua--forward-line -1)
374 (move-to-column (cua--rectangle-column) pad) 361 (move-to-column (cua--rectangle-column))
375 (cua--rectangle-bot t) 362 (cua--rectangle-bot t)
376 (setq resized t))) 363 (setq resized t)))
377 (t 364 (t
378 (goto-char (cua--rectangle-top)) 365 (goto-char (cua--rectangle-top))
379 (when (cua--forward-line -1 pad) 366 (when (cua--forward-line -1)
380 (move-to-column (cua--rectangle-column) pad) 367 (move-to-column (cua--rectangle-column))
381 (cua--rectangle-top t) 368 (cua--rectangle-top t)
382 (setq resized t))))) 369 (setq resized t)))))
383 (if resized 370 (if resized
@@ -408,7 +395,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
408 "Resize rectangle to bottom of buffer." 395 "Resize rectangle to bottom of buffer."
409 (interactive) 396 (interactive)
410 (goto-char (point-max)) 397 (goto-char (point-max))
411 (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) 398 (move-to-column (cua--rectangle-column))
412 (cua--rectangle-bot t) 399 (cua--rectangle-bot t)
413 (cua--rectangle-resized)) 400 (cua--rectangle-resized))
414 401
@@ -416,31 +403,29 @@ Knows about CUA rectangle highlighting in addition to standard undo."
416 "Resize rectangle to top of buffer." 403 "Resize rectangle to top of buffer."
417 (interactive) 404 (interactive)
418 (goto-char (point-min)) 405 (goto-char (point-min))
419 (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) 406 (move-to-column (cua--rectangle-column))
420 (cua--rectangle-top t) 407 (cua--rectangle-top t)
421 (cua--rectangle-resized)) 408 (cua--rectangle-resized))
422 409
423(defun cua-resize-rectangle-page-up () 410(defun cua-resize-rectangle-page-up ()
424 "Resize rectangle upwards by one scroll page." 411 "Resize rectangle upwards by one scroll page."
425 (interactive) 412 (interactive)
426 (let ((pad (cua--rectangle-padding))) 413 (scroll-down)
427 (scroll-down) 414 (move-to-column (cua--rectangle-column))
428 (move-to-column (cua--rectangle-column) pad) 415 (if (>= (cua--rectangle-corner) 2)
429 (if (>= (cua--rectangle-corner) 2) 416 (cua--rectangle-bot t)
430 (cua--rectangle-bot t) 417 (cua--rectangle-top t))
431 (cua--rectangle-top t)) 418 (cua--rectangle-resized))
432 (cua--rectangle-resized)))
433 419
434(defun cua-resize-rectangle-page-down () 420(defun cua-resize-rectangle-page-down ()
435 "Resize rectangle downwards by one scroll page." 421 "Resize rectangle downwards by one scroll page."
436 (interactive) 422 (interactive)
437 (let ((pad (cua--rectangle-padding))) 423 (scroll-up)
438 (scroll-up) 424 (move-to-column (cua--rectangle-column))
439 (move-to-column (cua--rectangle-column) pad) 425 (if (>= (cua--rectangle-corner) 2)
440 (if (>= (cua--rectangle-corner) 2) 426 (cua--rectangle-bot t)
441 (cua--rectangle-bot t) 427 (cua--rectangle-top t))
442 (cua--rectangle-top t)) 428 (cua--rectangle-resized))
443 (cua--rectangle-resized)))
444 429
445;;; Mouse support 430;;; Mouse support
446 431
@@ -450,7 +435,8 @@ Knows about CUA rectangle highlighting in addition to standard undo."
450 "Set rectangle corner at mouse click position." 435 "Set rectangle corner at mouse click position."
451 (interactive "e") 436 (interactive "e")
452 (mouse-set-point event) 437 (mouse-set-point event)
453 (if (cua--rectangle-padding) 438 ;; FIX ME -- need to calculate virtual column.
439 (if (cua--rectangle-virtual-edges)
454 (move-to-column (car (posn-col-row (event-end event))) t)) 440 (move-to-column (car (posn-col-row (event-end event))) t))
455 (if (cua--rectangle-right-side) 441 (if (cua--rectangle-right-side)
456 (cua--rectangle-right (current-column)) 442 (cua--rectangle-right (current-column))
@@ -470,6 +456,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
470 (cua--deactivate t)) 456 (cua--deactivate t))
471 (setq cua--last-rectangle nil) 457 (setq cua--last-rectangle nil)
472 (mouse-set-point event) 458 (mouse-set-point event)
459 ;; FIX ME -- need to calculate virtual column.
473 (cua-set-rectangle-mark) 460 (cua-set-rectangle-mark)
474 (setq cua--buffer-and-point-before-command nil) 461 (setq cua--buffer-and-point-before-command nil)
475 (setq cua--mouse-last-pos nil)) 462 (setq cua--mouse-last-pos nil))
@@ -489,13 +476,13 @@ If command is repeated at same position, delete the rectangle."
489 (let ((cua-keep-region-after-copy t)) 476 (let ((cua-keep-region-after-copy t))
490 (cua-copy-rectangle arg) 477 (cua-copy-rectangle arg)
491 (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle))))) 478 (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
479
492(defun cua--mouse-ignore (event) 480(defun cua--mouse-ignore (event)
493 (interactive "e") 481 (interactive "e")
494 (setq this-command last-command)) 482 (setq this-command last-command))
495 483
496(defun cua--rectangle-move (dir) 484(defun cua--rectangle-move (dir)
497 (let ((pad (cua--rectangle-padding)) 485 (let ((moved t)
498 (moved t)
499 (top (cua--rectangle-top)) 486 (top (cua--rectangle-top))
500 (bot (cua--rectangle-bot)) 487 (bot (cua--rectangle-bot))
501 (l (cua--rectangle-left)) 488 (l (cua--rectangle-left))
@@ -503,17 +490,17 @@ If command is repeated at same position, delete the rectangle."
503 (cond 490 (cond
504 ((eq dir 'up) 491 ((eq dir 'up)
505 (goto-char top) 492 (goto-char top)
506 (when (cua--forward-line -1 pad) 493 (when (cua--forward-line -1)
507 (cua--rectangle-top t) 494 (cua--rectangle-top t)
508 (goto-char bot) 495 (goto-char bot)
509 (forward-line -1) 496 (forward-line -1)
510 (cua--rectangle-bot t))) 497 (cua--rectangle-bot t)))
511 ((eq dir 'down) 498 ((eq dir 'down)
512 (goto-char bot) 499 (goto-char bot)
513 (when (cua--forward-line 1 pad) 500 (when (cua--forward-line 1)
514 (cua--rectangle-bot t) 501 (cua--rectangle-bot t)
515 (goto-char top) 502 (goto-char top)
516 (cua--forward-line 1 pad) 503 (cua--forward-line 1)
517 (cua--rectangle-top t))) 504 (cua--rectangle-top t)))
518 ((eq dir 'left) 505 ((eq dir 'left)
519 (when (> l 0) 506 (when (> l 0)
@@ -526,19 +513,37 @@ If command is repeated at same position, delete the rectangle."
526 (setq moved nil))) 513 (setq moved nil)))
527 (when moved 514 (when moved
528 (setq cua--buffer-and-point-before-command nil) 515 (setq cua--buffer-and-point-before-command nil)
529 (cua--pad-rectangle)
530 (cua--rectangle-set-corners) 516 (cua--rectangle-set-corners)
531 (cua--keep-active)))) 517 (cua--keep-active))))
532 518
533 519
534;;; Operations on current rectangle 520;;; Operations on current rectangle
535 521
536(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct) 522(defun cua--tabify-start (start end)
523 ;; Return position where auto-tabify should start (or nil if not required).
524 (save-excursion
525 (save-restriction
526 (widen)
527 (and (not buffer-read-only)
528 cua-auto-tabify-rectangles
529 (if (or (not (integerp cua-auto-tabify-rectangles))
530 (= (point-min) (point-max))
531 (progn
532 (goto-char (max (point-min)
533 (- start cua-auto-tabify-rectangles)))
534 (search-forward "\t" (min (point-max)
535 (+ end cua-auto-tabify-rectangles)) t)))
536 start)))))
537
538(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: 539 ;; Call FCT for each line of region with 4 parameters:
538 ;; Region start, end, left-col, right-col 540 ;; Region start, end, left-col, right-col
539 ;; Point is at start when FCT is called 541 ;; Point is at start when FCT is called
542 ;; Call fct with (s,e) = whole lines if VISIBLE non-nil.
543 ;; Only call fct for visible lines if VISIBLE==t.
540 ;; Set undo boundary if UNDO is non-nil. 544 ;; Set undo boundary if UNDO is non-nil.
541 ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding) 545 ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
546 ;; 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. 547 ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
543 (let* ((start (cua--rectangle-top)) 548 (let* ((start (cua--rectangle-top))
544 (end (cua--rectangle-bot)) 549 (end (cua--rectangle-bot))
@@ -546,11 +551,12 @@ If command is repeated at same position, delete the rectangle."
546 (r (1+ (cua--rectangle-right))) 551 (r (1+ (cua--rectangle-right)))
547 (m (make-marker)) 552 (m (make-marker))
548 (tabpad (and (integerp pad) (= pad 2))) 553 (tabpad (and (integerp pad) (= pad 2)))
549 (sel (cua--rectangle-restriction))) 554 (sel (cua--rectangle-restriction))
555 (tabify-start (and tabify (cua--tabify-start start end))))
550 (if undo 556 (if undo
551 (cua--rectangle-undo-boundary)) 557 (cua--rectangle-undo-boundary))
552 (if (integerp pad) 558 (if (integerp pad)
553 (setq pad (cua--rectangle-padding))) 559 (setq pad (cua--rectangle-virtual-edges)))
554 (save-excursion 560 (save-excursion
555 (save-restriction 561 (save-restriction
556 (widen) 562 (widen)
@@ -558,7 +564,7 @@ If command is repeated at same position, delete the rectangle."
558 (goto-char end) 564 (goto-char end)
559 (and (bolp) (not (eolp)) (not (eobp)) 565 (and (bolp) (not (eolp)) (not (eobp))
560 (setq end (1+ end)))) 566 (setq end (1+ end))))
561 (when visible 567 (when (eq visible t)
562 (setq start (max (window-start) start)) 568 (setq start (max (window-start) start))
563 (setq end (min (window-end) end))) 569 (setq end (min (window-end) end)))
564 (goto-char end) 570 (goto-char end)
@@ -575,7 +581,7 @@ If command is repeated at same position, delete the rectangle."
575 (forward-char 1)) 581 (forward-char 1))
576 (set-marker m (point)) 582 (set-marker m (point))
577 (move-to-column l pad) 583 (move-to-column l pad)
578 (if (and fct (>= (current-column) l) (<= (current-column) r)) 584 (if (and fct (or visible (and (>= (current-column) l) (<= (current-column) r))))
579 (let ((v t) (p (point))) 585 (let ((v t) (p (point)))
580 (when sel 586 (when sel
581 (if (car (cdr sel)) 587 (if (car (cdr sel))
@@ -585,8 +591,7 @@ If command is repeated at same position, delete the rectangle."
585 (if (car (cdr (cdr sel))) 591 (if (car (cdr (cdr sel)))
586 (setq v (null v)))) 592 (setq v (null v))))
587 (if visible 593 (if visible
588 (unless (eolp) 594 (funcall fct p m l r v)
589 (funcall fct p m l r v))
590 (if v 595 (if v
591 (funcall fct p m l r))))) 596 (funcall fct p m l r)))))
592 (set-marker m nil) 597 (set-marker m nil)
@@ -594,7 +599,9 @@ If command is repeated at same position, delete the rectangle."
594 (if (not visible) 599 (if (not visible)
595 (cua--rectangle-bot t)) 600 (cua--rectangle-bot t))
596 (if post-fct 601 (if post-fct
597 (funcall post-fct l r)))) 602 (funcall post-fct l r))
603 (when tabify-start
604 (tabify tabify-start (point)))))
598 (cond 605 (cond
599 ((eq keep-clear 'keep) 606 ((eq keep-clear 'keep)
600 (cua--keep-active)) 607 (cua--keep-active))
@@ -607,48 +614,96 @@ If command is repeated at same position, delete the rectangle."
607 614
608(put 'cua--rectangle-operation 'lisp-indent-function 4) 615(put 'cua--rectangle-operation 'lisp-indent-function 4)
609 616
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 () 617(defun cua--delete-rectangle ()
615 (cua--rectangle-operation nil nil t 2 618 (let ((lines 0))
616 '(lambda (s e l r) 619 (if (not (cua--rectangle-virtual-edges))
617 (if (and (> e s) (<= e (point-max))) 620 (cua--rectangle-operation nil nil t 2 t
618 (delete-region s e))))) 621 '(lambda (s e l r v)
622 (setq lines (1+ lines))
623 (if (and (> e s) (<= e (point-max)))
624 (delete-region s e))))
625 (cua--rectangle-operation nil 1 t nil t
626 '(lambda (s e l r v)
627 (setq lines (1+ lines))
628 (when (and (> e s) (<= e (point-max)))
629 (delete-region s e)))))
630 lines))
619 631
620(defun cua--extract-rectangle () 632(defun cua--extract-rectangle ()
621 (let (rect) 633 (let (rect)
622 (cua--rectangle-operation nil nil nil 1 634 (if (not (cua--rectangle-virtual-edges))
623 '(lambda (s e l r) 635 (cua--rectangle-operation nil nil nil nil nil ; do not tabify
624 (setq rect (cons (buffer-substring-no-properties s e) rect)))) 636 '(lambda (s e l r)
625 (nreverse rect))) 637 (setq rect (cons (buffer-substring-no-properties s e) rect))))
626 638 (cua--rectangle-operation nil 1 nil nil nil ; do not tabify
627(defun cua--insert-rectangle (rect &optional below) 639 '(lambda (s e l r v)
640 (let ((copy t) (bs 0) (as 0) row)
641 (if (= s e) (setq e (1+ e)))
642 (goto-char s)
643 (move-to-column l)
644 (if (= (point) (line-end-position))
645 (setq bs (- r l)
646 copy nil)
647 (skip-chars-forward "\s\t" e)
648 (setq bs (- (min r (current-column)) l)
649 s (point))
650 (move-to-column r)
651 (skip-chars-backward "\s\t" s)
652 (setq as (- r (max (current-column) l))
653 e (point)))
654 (setq row (if (and copy (> e s))
655 (buffer-substring-no-properties s e)
656 ""))
657 (when (> bs 0)
658 (setq row (concat (make-string bs ?\s) row)))
659 (when (> as 0)
660 (setq row (concat row (make-string as ?\s))))
661 (setq rect (cons row rect))))))
662 (nreverse rect)))
663
664(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 665 ;; 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 666 ;; 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. 667 ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines.
631 (if (and below (eq below 'auto)) 668 (if (eq below 'auto)
632 (setq below (and (bolp) 669 (setq below (and (bolp)
633 (or (eolp) (eobp) (= (1+ (point)) (point-max)))))) 670 (or (eolp) (eobp) (= (1+ (point)) (point-max))))))
671 (unless paste-column
672 (setq paste-column (current-column)))
634 (let ((lines rect) 673 (let ((lines rect)
635 (insertcolumn (current-column))
636 (first t) 674 (first t)
675 (tabify-start (cua--tabify-start (point) (point)))
676 last-column
637 p) 677 p)
638 (while (or lines below) 678 (while (or lines below)
639 (or first 679 (or first
640 (if overwrite-mode 680 (if overwrite-mode
641 (insert ?\n) 681 (insert ?\n)
642 (forward-line 1) 682 (forward-line 1)
643 (or (bolp) (insert ?\n)) 683 (or (bolp) (insert ?\n))))
644 (move-to-column insertcolumn t))) 684 (unless overwrite-mode
685 (move-to-column paste-column t))
645 (if (not lines) 686 (if (not lines)
646 (setq below nil) 687 (setq below nil)
647 (insert-for-yank (car lines)) 688 (insert-for-yank (car lines))
689 (unless last-column
690 (setq last-column (current-column)))
648 (setq lines (cdr lines)) 691 (setq lines (cdr lines))
649 (and first (not below) 692 (and first (not below)
650 (setq p (point)))) 693 (setq p (point))))
651 (setq first nil)) 694 (setq first nil)
695 (if (and line-count (= (setq line-count (1- line-count)) 0))
696 (setq lines nil)))
697 (when (and line-count last-column (not overwrite-mode))
698 (while (> line-count 0)
699 (forward-line 1)
700 (or (bolp) (insert ?\n))
701 (move-to-column paste-column t)
702 (insert-char ?\s (- last-column paste-column -1))
703 (setq line-count (1- line-count))))
704 (when (and tabify-start
705 (not overwrite-mode))
706 (tabify tabify-start (point)))
652 (and p (not overwrite-mode) 707 (and p (not overwrite-mode)
653 (goto-char p)))) 708 (goto-char p))))
654 709
@@ -662,7 +717,7 @@ If command is repeated at same position, delete the rectangle."
662 (function (lambda (row) (concat row "\n"))) 717 (function (lambda (row) (concat row "\n")))
663 killed-rectangle ""))))) 718 killed-rectangle "")))))
664 719
665(defun cua--activate-rectangle (&optional force) 720(defun cua--activate-rectangle ()
666 ;; Turn on rectangular marking mode by disabling transient mark mode 721 ;; Turn on rectangular marking mode by disabling transient mark mode
667 ;; and manually handling highlighting from a post command hook. 722 ;; and manually handling highlighting from a post command hook.
668 ;; Be careful if we are already marking a rectangle. 723 ;; Be careful if we are already marking a rectangle.
@@ -671,12 +726,8 @@ If command is repeated at same position, delete the rectangle."
671 (eq (car cua--last-rectangle) (current-buffer)) 726 (eq (car cua--last-rectangle) (current-buffer))
672 (eq (car (cdr cua--last-rectangle)) (point))) 727 (eq (car (cdr cua--last-rectangle)) (point)))
673 (cdr (cdr cua--last-rectangle)) 728 (cdr (cdr cua--last-rectangle))
674 (cua--rectangle-get-corners 729 (cua--rectangle-get-corners))
675 (and (not buffer-read-only) 730 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)) 731 cua--last-rectangle nil))
681 732
682;; (defvar cua-save-point nil) 733;; (defvar cua-save-point nil)
@@ -698,7 +749,7 @@ If command is repeated at same position, delete the rectangle."
698 ;; Each overlay extends across all the columns of the rectangle. 749 ;; Each overlay extends across all the columns of the rectangle.
699 ;; We try to reuse overlays where possible because this is more efficient 750 ;; We try to reuse overlays where possible because this is more efficient
700 ;; and results in less flicker. 751 ;; and results in less flicker.
701 ;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines, 752 ;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or short lines,
702 ;; the higlighted region may not be perfectly rectangular. 753 ;; the higlighted region may not be perfectly rectangular.
703 (let ((deactivate-mark deactivate-mark) 754 (let ((deactivate-mark deactivate-mark)
704 (old cua--rectangle-overlays) 755 (old cua--rectangle-overlays)
@@ -707,12 +758,59 @@ If command is repeated at same position, delete the rectangle."
707 (right (1+ (cua--rectangle-right)))) 758 (right (1+ (cua--rectangle-right))))
708 (when (/= left right) 759 (when (/= left right)
709 (sit-for 0) ; make window top/bottom reliable 760 (sit-for 0) ; make window top/bottom reliable
710 (cua--rectangle-operation nil t nil nil 761 (cua--rectangle-operation nil t nil nil nil ; do not tabify
711 '(lambda (s e l r v) 762 '(lambda (s e l r v)
712 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) 763 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face))
713 overlay) 764 overlay bs as)
714 ;; Trim old leading overlays.
715 (if (= s e) (setq e (1+ e))) 765 (if (= s e) (setq e (1+ e)))
766 (when (cua--rectangle-virtual-edges)
767 (let ((lb (line-beginning-position))
768 (le (line-end-position))
769 cl cl0 pl cr cr0 pr)
770 (goto-char s)
771 (setq cl (move-to-column l)
772 pl (point))
773 (setq cr (move-to-column r)
774 pr (point))
775 (if (= lb pl)
776 (setq cl0 0)
777 (goto-char (1- pl))
778 (setq cl0 (current-column)))
779 (if (= lb le)
780 (setq cr0 0)
781 (goto-char (1- pr))
782 (setq cr0 (current-column)))
783 (unless (and (= cl l) (= cr r))
784 (when (/= cl l)
785 (setq bs (propertize
786 (make-string
787 (- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
788 (if cua--virtual-edges-debug ?. ?\s))
789 'face 'default))
790 (if (/= pl le)
791 (setq s (1- s))))
792 (cond
793 ((= cr r)
794 (if (and (/= cr0 (1- cr))
795 (= (mod cr tab-width) 0))
796 (setq e (1- e))))
797 ((= cr cl)
798 (setq bs (concat bs
799 (propertize
800 (make-string
801 (- r l)
802 (if cua--virtual-edges-debug ?, ?\s))
803 'face rface)))
804 (setq rface nil))
805 (t
806 (setq as (propertize
807 (make-string
808 (- r cr0 (if (= le pr) 1 0))
809 (if cua--virtual-edges-debug ?~ ?\s))
810 'face rface))
811 (if (/= pr le)
812 (setq e (1- e))))))))
813 ;; Trim old leading overlays.
716 (while (and old 814 (while (and old
717 (setq overlay (car old)) 815 (setq overlay (car old))
718 (< (overlay-start overlay) s) 816 (< (overlay-start overlay) s)
@@ -728,8 +826,10 @@ If command is repeated at same position, delete the rectangle."
728 (move-overlay overlay s e) 826 (move-overlay overlay s e)
729 (setq old (cdr old))) 827 (setq old (cdr old)))
730 (setq overlay (make-overlay s e))) 828 (setq overlay (make-overlay s e)))
731 (overlay-put overlay 'face rface) 829 (overlay-put overlay 'before-string bs)
732 (setq new (cons overlay new)))))) 830 (overlay-put overlay 'after-string as)
831 (overlay-put overlay 'face rface)
832 (setq new (cons overlay new))))))
733 ;; Trim old trailing overlays. 833 ;; Trim old trailing overlays.
734 (mapcar (function delete-overlay) old) 834 (mapcar (function delete-overlay) old)
735 (setq cua--rectangle-overlays (nreverse new)))) 835 (setq cua--rectangle-overlays (nreverse new))))
@@ -737,9 +837,9 @@ If command is repeated at same position, delete the rectangle."
737(defun cua--indent-rectangle (&optional ch to-col clear) 837(defun cua--indent-rectangle (&optional ch to-col clear)
738 ;; Indent current rectangle. 838 ;; Indent current rectangle.
739 (let ((col (cua--rectangle-insert-col)) 839 (let ((col (cua--rectangle-insert-col))
740 (pad (cua--rectangle-padding)) 840 (pad (cua--rectangle-virtual-edges))
741 indent) 841 indent)
742 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad 842 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad t
743 '(lambda (s e l r) 843 '(lambda (s e l r)
744 (move-to-column col pad) 844 (move-to-column col pad)
745 (if (and (eolp) 845 (if (and (eolp)
@@ -877,21 +977,18 @@ With prefix argument, the toggle restriction."
877 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) 977 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
878 (cua--rectangle-set-corners)) 978 (cua--rectangle-set-corners))
879 979
880(defun cua-toggle-rectangle-padding () 980(defun cua-toggle-rectangle-virtual-edges ()
881 (interactive) 981 (interactive)
882 (if buffer-read-only 982 (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges)))
883 (message "Cannot do padding in read-only buffer.") 983 (cua--rectangle-set-corners)
884 (cua--rectangle-padding t (not (cua--rectangle-padding))) 984 (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)) 985 (cua--keep-active))
889 986
890(defun cua-do-rectangle-padding () 987(defun cua-do-rectangle-padding ()
891 (interactive) 988 (interactive)
892 (if buffer-read-only 989 (if buffer-read-only
893 (message "Cannot do padding in read-only buffer.") 990 (message "Cannot do padding in read-only buffer.")
894 (cua--pad-rectangle t) 991 (cua--rectangle-operation nil nil t t t)
895 (cua--rectangle-set-corners)) 992 (cua--rectangle-set-corners))
896 (cua--keep-active)) 993 (cua--keep-active))
897 994
@@ -900,7 +997,7 @@ With prefix argument, the toggle restriction."
900The text previously in the region is not overwritten by the blanks, 997The text previously in the region is not overwritten by the blanks,
901but instead winds up to the right of the rectangle." 998but instead winds up to the right of the rectangle."
902 (interactive) 999 (interactive)
903 (cua--rectangle-operation 'corners nil t 1 1000 (cua--rectangle-operation 'corners nil t 1 nil
904 '(lambda (s e l r) 1001 '(lambda (s e l r)
905 (skip-chars-forward " \t") 1002 (skip-chars-forward " \t")
906 (let ((ws (- (current-column) l)) 1003 (let ((ws (- (current-column) l))
@@ -915,7 +1012,7 @@ On each line in the rectangle, all continuous whitespace starting
915at that column is deleted. 1012at that column is deleted.
916With prefix arg, also delete whitespace to the left of that column." 1013With prefix arg, also delete whitespace to the left of that column."
917 (interactive "P") 1014 (interactive "P")
918 (cua--rectangle-operation 'clear nil t 1 1015 (cua--rectangle-operation 'clear nil t 1 nil
919 '(lambda (s e l r) 1016 '(lambda (s e l r)
920 (when arg 1017 (when arg
921 (skip-syntax-backward " " (line-beginning-position)) 1018 (skip-syntax-backward " " (line-beginning-position))
@@ -927,7 +1024,7 @@ With prefix arg, also delete whitespace to the left of that column."
927 "Blank out CUA rectangle. 1024 "Blank out CUA rectangle.
928The text previously in the rectangle is overwritten by the blanks." 1025The text previously in the rectangle is overwritten by the blanks."
929 (interactive) 1026 (interactive)
930 (cua--rectangle-operation 'keep nil nil 1 1027 (cua--rectangle-operation 'keep nil nil 1 nil
931 '(lambda (s e l r) 1028 '(lambda (s e l r)
932 (goto-char e) 1029 (goto-char e)
933 (skip-syntax-forward " " (line-end-position)) 1030 (skip-syntax-forward " " (line-end-position))
@@ -942,7 +1039,7 @@ The text previously in the rectangle is overwritten by the blanks."
942 "Align rectangle lines to left column." 1039 "Align rectangle lines to left column."
943 (interactive) 1040 (interactive)
944 (let (x) 1041 (let (x)
945 (cua--rectangle-operation 'clear nil t t 1042 (cua--rectangle-operation 'clear nil t t nil
946 '(lambda (s e l r) 1043 '(lambda (s e l r)
947 (let ((b (line-beginning-position))) 1044 (let ((b (line-beginning-position)))
948 (skip-syntax-backward "^ " b) 1045 (skip-syntax-backward "^ " b)
@@ -984,7 +1081,7 @@ The text previously in the rectangle is overwritten by the blanks."
984 "Replace CUA rectangle contents with STRING on each line. 1081 "Replace CUA rectangle contents with STRING on each line.
985The length of STRING need not be the same as the rectangle width." 1082The length of STRING need not be the same as the rectangle width."
986 (interactive "sString rectangle: ") 1083 (interactive "sString rectangle: ")
987 (cua--rectangle-operation 'keep nil t t 1084 (cua--rectangle-operation 'keep nil t t nil
988 '(lambda (s e l r) 1085 '(lambda (s e l r)
989 (delete-region s e) 1086 (delete-region s e)
990 (skip-chars-forward " \t") 1087 (skip-chars-forward " \t")
@@ -999,7 +1096,7 @@ The length of STRING need not be the same as the rectangle width."
999(defun cua-fill-char-rectangle (ch) 1096(defun cua-fill-char-rectangle (ch)
1000 "Replace CUA rectangle contents with CHARACTER." 1097 "Replace CUA rectangle contents with CHARACTER."
1001 (interactive "cFill rectangle with character: ") 1098 (interactive "cFill rectangle with character: ")
1002 (cua--rectangle-operation 'clear nil t 1 1099 (cua--rectangle-operation 'clear nil t 1 nil
1003 '(lambda (s e l r) 1100 '(lambda (s e l r)
1004 (delete-region s e) 1101 (delete-region s e)
1005 (move-to-column l t) 1102 (move-to-column l t)
@@ -1010,7 +1107,7 @@ The length of STRING need not be the same as the rectangle width."
1010 (interactive "sReplace regexp: \nsNew text: ") 1107 (interactive "sReplace regexp: \nsNew text: ")
1011 (if buffer-read-only 1108 (if buffer-read-only
1012 (message "Cannot replace in read-only buffer") 1109 (message "Cannot replace in read-only buffer")
1013 (cua--rectangle-operation 'keep nil t 1 1110 (cua--rectangle-operation 'keep nil t 1 nil
1014 '(lambda (s e l r) 1111 '(lambda (s e l r)
1015 (if (re-search-forward regexp e t) 1112 (if (re-search-forward regexp e t)
1016 (replace-match newtext nil nil)))))) 1113 (replace-match newtext nil nil))))))
@@ -1018,7 +1115,7 @@ The length of STRING need not be the same as the rectangle width."
1018(defun cua-incr-rectangle (increment) 1115(defun cua-incr-rectangle (increment)
1019 "Increment each line of CUA rectangle by prefix amount." 1116 "Increment each line of CUA rectangle by prefix amount."
1020 (interactive "p") 1117 (interactive "p")
1021 (cua--rectangle-operation 'keep nil t 1 1118 (cua--rectangle-operation 'keep nil t 1 nil
1022 '(lambda (s e l r) 1119 '(lambda (s e l r)
1023 (cond 1120 (cond
1024 ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) 1121 ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
@@ -1051,36 +1148,36 @@ The numbers are formatted according to the FORMAT string."
1051 (if (= (length fmt) 0) 1148 (if (= (length fmt) 0)
1052 (setq fmt cua--rectangle-seq-format) 1149 (setq fmt cua--rectangle-seq-format)
1053 (setq cua--rectangle-seq-format fmt)) 1150 (setq cua--rectangle-seq-format fmt))
1054 (cua--rectangle-operation 'clear nil t 1 1151 (cua--rectangle-operation 'clear nil t 1 nil
1055 '(lambda (s e l r) 1152 '(lambda (s e l r)
1056 (delete-region s e) 1153 (delete-region s e)
1057 (insert (format fmt first)) 1154 (insert (format fmt first))
1058 (setq first (+ first incr))))) 1155 (setq first (+ first incr)))))
1059 1156
1060(defmacro cua--convert-rectangle-as (command) 1157(defmacro cua--convert-rectangle-as (command tabify)
1061 `(cua--rectangle-operation 'clear nil nil nil 1158 `(cua--rectangle-operation 'clear nil nil nil ,tabify
1062 '(lambda (s e l r) 1159 '(lambda (s e l r)
1063 (,command s e)))) 1160 (,command s e))))
1064 1161
1065(defun cua-upcase-rectangle () 1162(defun cua-upcase-rectangle ()
1066 "Convert the rectangle to upper case." 1163 "Convert the rectangle to upper case."
1067 (interactive) 1164 (interactive)
1068 (cua--convert-rectangle-as upcase-region)) 1165 (cua--convert-rectangle-as upcase-region nil))
1069 1166
1070(defun cua-downcase-rectangle () 1167(defun cua-downcase-rectangle ()
1071 "Convert the rectangle to lower case." 1168 "Convert the rectangle to lower case."
1072 (interactive) 1169 (interactive)
1073 (cua--convert-rectangle-as downcase-region)) 1170 (cua--convert-rectangle-as downcase-region nil))
1074 1171
1075(defun cua-upcase-initials-rectangle () 1172(defun cua-upcase-initials-rectangle ()
1076 "Convert the rectangle initials to upper case." 1173 "Convert the rectangle initials to upper case."
1077 (interactive) 1174 (interactive)
1078 (cua--convert-rectangle-as upcase-initials-region)) 1175 (cua--convert-rectangle-as upcase-initials-region nil))
1079 1176
1080(defun cua-capitalize-rectangle () 1177(defun cua-capitalize-rectangle ()
1081 "Convert the rectangle to proper case." 1178 "Convert the rectangle to proper case."
1082 (interactive) 1179 (interactive)
1083 (cua--convert-rectangle-as capitalize-region)) 1180 (cua--convert-rectangle-as capitalize-region nil))
1084 1181
1085 1182
1086;;; Replace/rearrange text in current rectangle 1183;;; Replace/rearrange text in current rectangle
@@ -1116,7 +1213,7 @@ The numbers are formatted according to the FORMAT string."
1116 (setq z (reverse z)) 1213 (setq z (reverse z))
1117 (if cua--debug 1214 (if cua--debug
1118 (print z auxbuf)) 1215 (print z auxbuf))
1119 (cua--rectangle-operation nil nil t pad 1216 (cua--rectangle-operation nil nil t pad nil
1120 '(lambda (s e l r) 1217 '(lambda (s e l r)
1121 (let (cc) 1218 (let (cc)
1122 (goto-char e) 1219 (goto-char e)
@@ -1232,9 +1329,9 @@ With prefix arg, indent to that column."
1232 "Delete char to left or right of rectangle." 1329 "Delete char to left or right of rectangle."
1233 (interactive) 1330 (interactive)
1234 (let ((col (cua--rectangle-insert-col)) 1331 (let ((col (cua--rectangle-insert-col))
1235 (pad (cua--rectangle-padding)) 1332 (pad (cua--rectangle-virtual-edges))
1236 indent) 1333 indent)
1237 (cua--rectangle-operation 'corners nil t pad 1334 (cua--rectangle-operation 'corners nil t pad nil
1238 '(lambda (s e l r) 1335 '(lambda (s e l r)
1239 (move-to-column 1336 (move-to-column
1240 (if (cua--rectangle-right-side t) 1337 (if (cua--rectangle-right-side t)
@@ -1282,10 +1379,7 @@ With prefix arg, indent to that column."
1282 (cua--rectangle-left (current-column))) 1379 (cua--rectangle-left (current-column)))
1283 (if (>= (cua--rectangle-corner) 2) 1380 (if (>= (cua--rectangle-corner) 2)
1284 (cua--rectangle-bot t) 1381 (cua--rectangle-bot t)
1285 (cua--rectangle-top t)) 1382 (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 1383 (if cua--rectangle
1290 (if (and mark-active 1384 (if (and mark-active
1291 (not deactivate-mark)) 1385 (not deactivate-mark))
@@ -1379,7 +1473,7 @@ With prefix arg, indent to that column."
1379 (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) 1473 (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text)
1380 (cua--rect-M/H-key ?n 'cua-sequence-rectangle) 1474 (cua--rect-M/H-key ?n 'cua-sequence-rectangle)
1381 (cua--rect-M/H-key ?o 'cua-open-rectangle) 1475 (cua--rect-M/H-key ?o 'cua-open-rectangle)
1382 (cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding) 1476 (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges)
1383 (cua--rect-M/H-key ?P 'cua-do-rectangle-padding) 1477 (cua--rect-M/H-key ?P 'cua-do-rectangle-padding)
1384 (cua--rect-M/H-key ?q 'cua-refill-rectangle) 1478 (cua--rect-M/H-key ?q 'cua-refill-rectangle)
1385 (cua--rect-M/H-key ?r 'cua-replace-in-rectangle) 1479 (cua--rect-M/H-key ?r 'cua-replace-in-rectangle)