diff options
| author | Kim F. Storm | 2004-08-29 20:57:19 +0000 |
|---|---|---|
| committer | Kim F. Storm | 2004-08-29 20:57:19 +0000 |
| commit | 7279710840de2d2d67d6a91ebfa0a857372de5ec (patch) | |
| tree | cff8f92406a7479052aeef66d65985429148386c | |
| parent | 2661eae951908207096f1893eb3159c4944cf2e2 (diff) | |
| download | emacs-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.el | 388 |
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." | |||
| 900 | The text previously in the region is not overwritten by the blanks, | 997 | The text previously in the region is not overwritten by the blanks, |
| 901 | but instead winds up to the right of the rectangle." | 998 | but 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 | |||
| 915 | at that column is deleted. | 1012 | at that column is deleted. |
| 916 | With prefix arg, also delete whitespace to the left of that column." | 1013 | With 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. |
| 928 | The text previously in the rectangle is overwritten by the blanks." | 1025 | The 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. |
| 985 | The length of STRING need not be the same as the rectangle width." | 1082 | The 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) |