44 |
(require 'rect) |
(require 'rect) |
45 |
|
|
46 |
;; If non-nil, restrict current region to this rectangle. |
;; If non-nil, restrict current region to this rectangle. |
47 |
;; Value is a vector [top bot left right corner ins pad select]. |
;; 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. |
;; 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. |
;; 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. |
;; If VIRT is non-nil, virtual straight edges are enabled. |
51 |
;; If SELECT is a regexp, only lines starting with that regexp are affected.") |
;; If SELECT is a regexp, only lines starting with that regexp are affected.") |
52 |
(defvar cua--rectangle nil) |
(defvar cua--rectangle nil) |
53 |
(make-variable-buffer-local 'cua--rectangle) |
(make-variable-buffer-local 'cua--rectangle) |
65 |
(defvar cua--rectangle-overlays nil) |
(defvar cua--rectangle-overlays nil) |
66 |
(make-variable-buffer-local 'cua--rectangle-overlays) |
(make-variable-buffer-local 'cua--rectangle-overlays) |
67 |
|
|
68 |
|
(defvar cua--overlay-keymap |
69 |
|
(let ((map (make-sparse-keymap))) |
70 |
|
(define-key map "\r" 'cua-rotate-rectangle))) |
71 |
|
|
72 |
|
(defvar cua--virtual-edges-debug nil) |
73 |
|
|
74 |
;; Per-buffer CUA mode undo list. |
;; Per-buffer CUA mode undo list. |
75 |
(defvar cua--undo-list nil) |
(defvar cua--undo-list nil) |
76 |
(make-variable-buffer-local 'cua--undo-list) |
(make-variable-buffer-local 'cua--undo-list) |
103 |
(defvar cua--tidy-undo-counter 0 |
(defvar cua--tidy-undo-counter 0 |
104 |
"Number of times `cua--tidy-undo-lists' have run successfully.") |
"Number of times `cua--tidy-undo-lists' have run successfully.") |
105 |
|
|
106 |
;; Clean out danling entries from cua's undo list. |
;; Clean out dangling entries from cua's undo list. |
107 |
;; Since this list contains pointers into the standard undo list, |
;; Since this list contains pointers into the standard undo list, |
108 |
;; such references are only meningful as undo information if the |
;; such references are only meningful as undo information if the |
109 |
;; corresponding entry is still on the standard undo list. |
;; corresponding entry is still on the standard undo list. |
209 |
(aref cua--rectangle 5)) |
(aref cua--rectangle 5)) |
210 |
(cua--rectangle-left)))) |
(cua--rectangle-left)))) |
211 |
|
|
212 |
(defun cua--rectangle-padding (&optional set val) |
(defun cua--rectangle-virtual-edges (&optional set val) |
213 |
;; Current setting of rectangle padding |
;; Current setting of rectangle virtual-edges |
214 |
(if set |
(if set |
215 |
(aset cua--rectangle 6 val)) |
(aset cua--rectangle 6 val)) |
216 |
(and (not buffer-read-only) |
(and ;(not buffer-read-only) |
217 |
(aref cua--rectangle 6))) |
(aref cua--rectangle 6))) |
218 |
|
|
219 |
(defun cua--rectangle-restriction (&optional val bounded negated) |
(defun cua--rectangle-restriction (&optional val bounded negated) |
232 |
(if (< (cua--rectangle-bot) (cua--rectangle-top)) |
(if (< (cua--rectangle-bot) (cua--rectangle-top)) |
233 |
(message "rectangle bot < top"))) |
(message "rectangle bot < top"))) |
234 |
|
|
235 |
(defun cua--rectangle-get-corners (&optional pad) |
(defun cua--rectangle-get-corners () |
236 |
;; Calculate the rectangular region represented by point and mark, |
;; Calculate the rectangular region represented by point and mark, |
237 |
;; putting start in the upper left corner and end in the |
;; putting start in the upper left corner and end in the |
238 |
;; bottom right corner. |
;; bottom right corner. |
251 |
(setq r (1- r))) |
(setq r (1- r))) |
252 |
(setq l (prog1 r (setq r l))) |
(setq l (prog1 r (setq r l))) |
253 |
(goto-char top) |
(goto-char top) |
254 |
(move-to-column l pad) |
(move-to-column l) |
255 |
(setq top (point)) |
(setq top (point)) |
256 |
(goto-char bot) |
(goto-char bot) |
257 |
(move-to-column r pad) |
(move-to-column r) |
258 |
(setq bot (point)))) |
(setq bot (point)))) |
259 |
(vector top bot l r corner 0 pad nil))) |
(vector top bot l r corner 0 cua-virtual-rectangle-edges nil))) |
260 |
|
|
261 |
(defun cua--rectangle-set-corners () |
(defun cua--rectangle-set-corners () |
262 |
;; Set mark and point in opposite corners of current rectangle. |
;; Set mark and point in opposite corners of current rectangle. |
275 |
(setq pp (cua--rectangle-bot) pc (cua--rectangle-right) |
(setq pp (cua--rectangle-bot) pc (cua--rectangle-right) |
276 |
mp (cua--rectangle-top) mc (cua--rectangle-left)))) |
mp (cua--rectangle-top) mc (cua--rectangle-left)))) |
277 |
(goto-char mp) |
(goto-char mp) |
278 |
(move-to-column mc (cua--rectangle-padding)) |
(move-to-column mc) |
279 |
(set-mark (point)) |
(set-mark (point)) |
280 |
(goto-char pp) |
(goto-char pp) |
281 |
(move-to-column pc (cua--rectangle-padding)))) |
;; Move cursor inside rectangle, except if char at rigth edge is a tab. |
282 |
|
(if (and (if (cua--rectangle-right-side) |
283 |
|
(and (= (move-to-column pc) (- pc tab-width)) |
284 |
|
(not (eolp))) |
285 |
|
(> (move-to-column pc) pc)) |
286 |
|
(not (bolp))) |
287 |
|
(backward-char 1)) |
288 |
|
)) |
289 |
|
|
290 |
;;; Rectangle resizing |
;;; Rectangle resizing |
291 |
|
|
292 |
(defun cua--forward-line (n pad) |
(defun cua--forward-line (n) |
293 |
;; Move forward/backward one line. Returns t if movement. |
;; Move forward/backward one line. Returns t if movement. |
294 |
(if (or (not pad) (< n 0)) |
(let ((pt (point))) |
295 |
(= (forward-line n) 0) |
(and (= (forward-line n) 0) |
296 |
(next-line 1) |
;; Deal with end of buffer |
297 |
t)) |
(or (not (eobp)) |
298 |
|
(goto-char pt))))) |
299 |
|
|
300 |
(defun cua--rectangle-resized () |
(defun cua--rectangle-resized () |
301 |
;; Refresh state after resizing rectangle |
;; Refresh state after resizing rectangle |
302 |
(setq cua--buffer-and-point-before-command nil) |
(setq cua--buffer-and-point-before-command nil) |
|
(cua--pad-rectangle) |
|
303 |
(cua--rectangle-insert-col 0) |
(cua--rectangle-insert-col 0) |
304 |
(cua--rectangle-set-corners) |
(cua--rectangle-set-corners) |
305 |
(cua--keep-active)) |
(cua--keep-active)) |
307 |
(defun cua-resize-rectangle-right (n) |
(defun cua-resize-rectangle-right (n) |
308 |
"Resize rectangle to the right." |
"Resize rectangle to the right." |
309 |
(interactive "p") |
(interactive "p") |
310 |
(let ((pad (cua--rectangle-padding)) (resized (> n 0))) |
(let ((resized (> n 0))) |
311 |
(while (> n 0) |
(while (> n 0) |
312 |
(setq n (1- n)) |
(setq n (1- n)) |
313 |
(cond |
(cond |
|
((and (cua--rectangle-right-side) (or pad (eolp))) |
|
|
(cua--rectangle-right (1+ (cua--rectangle-right))) |
|
|
(move-to-column (cua--rectangle-right) pad)) |
|
314 |
((cua--rectangle-right-side) |
((cua--rectangle-right-side) |
315 |
(forward-char 1) |
(cua--rectangle-right (1+ (cua--rectangle-right))) |
316 |
(cua--rectangle-right (current-column))) |
(move-to-column (cua--rectangle-right))) |
|
((or pad (eolp)) |
|
|
(cua--rectangle-left (1+ (cua--rectangle-left))) |
|
|
(move-to-column (cua--rectangle-right) pad)) |
|
317 |
(t |
(t |
318 |
(forward-char 1) |
(cua--rectangle-left (1+ (cua--rectangle-left))) |
319 |
(cua--rectangle-left (current-column))))) |
(move-to-column (cua--rectangle-right))))) |
320 |
(if resized |
(if resized |
321 |
(cua--rectangle-resized)))) |
(cua--rectangle-resized)))) |
322 |
|
|
323 |
(defun cua-resize-rectangle-left (n) |
(defun cua-resize-rectangle-left (n) |
324 |
"Resize rectangle to the left." |
"Resize rectangle to the left." |
325 |
(interactive "p") |
(interactive "p") |
326 |
(let ((pad (cua--rectangle-padding)) resized) |
(let (resized) |
327 |
(while (> n 0) |
(while (> n 0) |
328 |
(setq n (1- n)) |
(setq n (1- n)) |
329 |
(if (or (= (cua--rectangle-right) 0) |
(if (or (= (cua--rectangle-right) 0) |
330 |
(and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0))) |
(and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0))) |
331 |
(setq n 0) |
(setq n 0) |
332 |
(cond |
(cond |
|
((and (cua--rectangle-right-side) (or pad (eolp) (bolp))) |
|
|
(cua--rectangle-right (1- (cua--rectangle-right))) |
|
|
(move-to-column (cua--rectangle-right) pad)) |
|
333 |
((cua--rectangle-right-side) |
((cua--rectangle-right-side) |
334 |
(backward-char 1) |
(cua--rectangle-right (1- (cua--rectangle-right))) |
335 |
(cua--rectangle-right (current-column))) |
(move-to-column (cua--rectangle-right))) |
|
((or pad (eolp) (bolp)) |
|
|
(cua--rectangle-left (1- (cua--rectangle-left))) |
|
|
(move-to-column (cua--rectangle-right) pad)) |
|
336 |
(t |
(t |
337 |
(backward-char 1) |
(cua--rectangle-left (1- (cua--rectangle-left))) |
338 |
(cua--rectangle-left (current-column)))) |
(move-to-column (cua--rectangle-right)))) |
339 |
(setq resized t))) |
(setq resized t))) |
340 |
(if resized |
(if resized |
341 |
(cua--rectangle-resized)))) |
(cua--rectangle-resized)))) |
343 |
(defun cua-resize-rectangle-down (n) |
(defun cua-resize-rectangle-down (n) |
344 |
"Resize rectangle downwards." |
"Resize rectangle downwards." |
345 |
(interactive "p") |
(interactive "p") |
346 |
(let ((pad (cua--rectangle-padding)) resized) |
(let (resized) |
347 |
(while (> n 0) |
(while (> n 0) |
348 |
(setq n (1- n)) |
(setq n (1- n)) |
349 |
(cond |
(cond |
350 |
((>= (cua--rectangle-corner) 2) |
((>= (cua--rectangle-corner) 2) |
351 |
(goto-char (cua--rectangle-bot)) |
(goto-char (cua--rectangle-bot)) |
352 |
(when (cua--forward-line 1 pad) |
(when (cua--forward-line 1) |
353 |
(move-to-column (cua--rectangle-column) pad) |
(move-to-column (cua--rectangle-column)) |
354 |
(cua--rectangle-bot t) |
(cua--rectangle-bot t) |
355 |
(setq resized t))) |
(setq resized t))) |
356 |
(t |
(t |
357 |
(goto-char (cua--rectangle-top)) |
(goto-char (cua--rectangle-top)) |
358 |
(when (cua--forward-line 1 pad) |
(when (cua--forward-line 1) |
359 |
(move-to-column (cua--rectangle-column) pad) |
(move-to-column (cua--rectangle-column)) |
360 |
(cua--rectangle-top t) |
(cua--rectangle-top t) |
361 |
(setq resized t))))) |
(setq resized t))))) |
362 |
(if resized |
(if resized |
365 |
(defun cua-resize-rectangle-up (n) |
(defun cua-resize-rectangle-up (n) |
366 |
"Resize rectangle upwards." |
"Resize rectangle upwards." |
367 |
(interactive "p") |
(interactive "p") |
368 |
(let ((pad (cua--rectangle-padding)) resized) |
(let (resized) |
369 |
(while (> n 0) |
(while (> n 0) |
370 |
(setq n (1- n)) |
(setq n (1- n)) |
371 |
(cond |
(cond |
372 |
((>= (cua--rectangle-corner) 2) |
((>= (cua--rectangle-corner) 2) |
373 |
(goto-char (cua--rectangle-bot)) |
(goto-char (cua--rectangle-bot)) |
374 |
(when (cua--forward-line -1 pad) |
(when (cua--forward-line -1) |
375 |
(move-to-column (cua--rectangle-column) pad) |
(move-to-column (cua--rectangle-column)) |
376 |
(cua--rectangle-bot t) |
(cua--rectangle-bot t) |
377 |
(setq resized t))) |
(setq resized t))) |
378 |
(t |
(t |
379 |
(goto-char (cua--rectangle-top)) |
(goto-char (cua--rectangle-top)) |
380 |
(when (cua--forward-line -1 pad) |
(when (cua--forward-line -1) |
381 |
(move-to-column (cua--rectangle-column) pad) |
(move-to-column (cua--rectangle-column)) |
382 |
(cua--rectangle-top t) |
(cua--rectangle-top t) |
383 |
(setq resized t))))) |
(setq resized t))))) |
384 |
(if resized |
(if resized |
409 |
"Resize rectangle to bottom of buffer." |
"Resize rectangle to bottom of buffer." |
410 |
(interactive) |
(interactive) |
411 |
(goto-char (point-max)) |
(goto-char (point-max)) |
412 |
(move-to-column (cua--rectangle-column) (cua--rectangle-padding)) |
(move-to-column (cua--rectangle-column)) |
413 |
(cua--rectangle-bot t) |
(cua--rectangle-bot t) |
414 |
(cua--rectangle-resized)) |
(cua--rectangle-resized)) |
415 |
|
|
417 |
"Resize rectangle to top of buffer." |
"Resize rectangle to top of buffer." |
418 |
(interactive) |
(interactive) |
419 |
(goto-char (point-min)) |
(goto-char (point-min)) |
420 |
(move-to-column (cua--rectangle-column) (cua--rectangle-padding)) |
(move-to-column (cua--rectangle-column)) |
421 |
(cua--rectangle-top t) |
(cua--rectangle-top t) |
422 |
(cua--rectangle-resized)) |
(cua--rectangle-resized)) |
423 |
|
|
424 |
(defun cua-resize-rectangle-page-up () |
(defun cua-resize-rectangle-page-up () |
425 |
"Resize rectangle upwards by one scroll page." |
"Resize rectangle upwards by one scroll page." |
426 |
(interactive) |
(interactive) |
427 |
(let ((pad (cua--rectangle-padding))) |
(scroll-down) |
428 |
(scroll-down) |
(move-to-column (cua--rectangle-column)) |
429 |
(move-to-column (cua--rectangle-column) pad) |
(if (>= (cua--rectangle-corner) 2) |
430 |
(if (>= (cua--rectangle-corner) 2) |
(cua--rectangle-bot t) |
431 |
(cua--rectangle-bot t) |
(cua--rectangle-top t)) |
432 |
(cua--rectangle-top t)) |
(cua--rectangle-resized)) |
|
(cua--rectangle-resized))) |
|
433 |
|
|
434 |
(defun cua-resize-rectangle-page-down () |
(defun cua-resize-rectangle-page-down () |
435 |
"Resize rectangle downwards by one scroll page." |
"Resize rectangle downwards by one scroll page." |
436 |
(interactive) |
(interactive) |
437 |
(let ((pad (cua--rectangle-padding))) |
(scroll-up) |
438 |
(scroll-up) |
(move-to-column (cua--rectangle-column)) |
439 |
(move-to-column (cua--rectangle-column) pad) |
(if (>= (cua--rectangle-corner) 2) |
440 |
(if (>= (cua--rectangle-corner) 2) |
(cua--rectangle-bot t) |
441 |
(cua--rectangle-bot t) |
(cua--rectangle-top t)) |
442 |
(cua--rectangle-top t)) |
(cua--rectangle-resized)) |
|
(cua--rectangle-resized))) |
|
443 |
|
|
444 |
;;; Mouse support |
;;; Mouse support |
445 |
|
|
449 |
"Set rectangle corner at mouse click position." |
"Set rectangle corner at mouse click position." |
450 |
(interactive "e") |
(interactive "e") |
451 |
(mouse-set-point event) |
(mouse-set-point event) |
452 |
(if (cua--rectangle-padding) |
;; FIX ME -- need to calculate virtual column. |
453 |
|
(if (cua--rectangle-virtual-edges) |
454 |
(move-to-column (car (posn-col-row (event-end event))) t)) |
(move-to-column (car (posn-col-row (event-end event))) t)) |
455 |
(if (cua--rectangle-right-side) |
(if (cua--rectangle-right-side) |
456 |
(cua--rectangle-right (current-column)) |
(cua--rectangle-right (current-column)) |
470 |
(cua--deactivate t)) |
(cua--deactivate t)) |
471 |
(setq cua--last-rectangle nil) |
(setq cua--last-rectangle nil) |
472 |
(mouse-set-point event) |
(mouse-set-point event) |
473 |
|
;; FIX ME -- need to calculate virtual column. |
474 |
(cua-set-rectangle-mark) |
(cua-set-rectangle-mark) |
475 |
(setq cua--buffer-and-point-before-command nil) |
(setq cua--buffer-and-point-before-command nil) |
476 |
(setq cua--mouse-last-pos nil)) |
(setq cua--mouse-last-pos nil)) |
490 |
(let ((cua-keep-region-after-copy t)) |
(let ((cua-keep-region-after-copy t)) |
491 |
(cua-copy-rectangle arg) |
(cua-copy-rectangle arg) |
492 |
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle))))) |
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle))))) |
493 |
|
|
494 |
(defun cua--mouse-ignore (event) |
(defun cua--mouse-ignore (event) |
495 |
(interactive "e") |
(interactive "e") |
496 |
(setq this-command last-command)) |
(setq this-command last-command)) |
497 |
|
|
498 |
(defun cua--rectangle-move (dir) |
(defun cua--rectangle-move (dir) |
499 |
(let ((pad (cua--rectangle-padding)) |
(let ((moved t) |
|
(moved t) |
|
500 |
(top (cua--rectangle-top)) |
(top (cua--rectangle-top)) |
501 |
(bot (cua--rectangle-bot)) |
(bot (cua--rectangle-bot)) |
502 |
(l (cua--rectangle-left)) |
(l (cua--rectangle-left)) |
504 |
(cond |
(cond |
505 |
((eq dir 'up) |
((eq dir 'up) |
506 |
(goto-char top) |
(goto-char top) |
507 |
(when (cua--forward-line -1 pad) |
(when (cua--forward-line -1) |
508 |
(cua--rectangle-top t) |
(cua--rectangle-top t) |
509 |
(goto-char bot) |
(goto-char bot) |
510 |
(forward-line -1) |
(forward-line -1) |
511 |
(cua--rectangle-bot t))) |
(cua--rectangle-bot t))) |
512 |
((eq dir 'down) |
((eq dir 'down) |
513 |
(goto-char bot) |
(goto-char bot) |
514 |
(when (cua--forward-line 1 pad) |
(when (cua--forward-line 1) |
515 |
(cua--rectangle-bot t) |
(cua--rectangle-bot t) |
516 |
(goto-char top) |
(goto-char top) |
517 |
(cua--forward-line 1 pad) |
(cua--forward-line 1) |
518 |
(cua--rectangle-top t))) |
(cua--rectangle-top t))) |
519 |
((eq dir 'left) |
((eq dir 'left) |
520 |
(when (> l 0) |
(when (> l 0) |
527 |
(setq moved nil))) |
(setq moved nil))) |
528 |
(when moved |
(when moved |
529 |
(setq cua--buffer-and-point-before-command nil) |
(setq cua--buffer-and-point-before-command nil) |
|
(cua--pad-rectangle) |
|
530 |
(cua--rectangle-set-corners) |
(cua--rectangle-set-corners) |
531 |
(cua--keep-active)))) |
(cua--keep-active)))) |
532 |
|
|
533 |
|
|
534 |
;;; Operations on current rectangle |
;;; Operations on current rectangle |
535 |
|
|
536 |
(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct) |
(defun cua--tabify-start (start end) |
537 |
|
;; Return position where auto-tabify should start (or nil if not required). |
538 |
|
(save-excursion |
539 |
|
(save-restriction |
540 |
|
(widen) |
541 |
|
(and (not buffer-read-only) |
542 |
|
cua-auto-tabify-rectangles |
543 |
|
(if (or (not (integerp cua-auto-tabify-rectangles)) |
544 |
|
(= (point-min) (point-max)) |
545 |
|
(progn |
546 |
|
(goto-char (max (point-min) |
547 |
|
(- start cua-auto-tabify-rectangles))) |
548 |
|
(search-forward "\t" (min (point-max) |
549 |
|
(+ end cua-auto-tabify-rectangles)) t))) |
550 |
|
start))))) |
551 |
|
|
552 |
|
(defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct) |
553 |
;; Call FCT for each line of region with 4 parameters: |
;; Call FCT for each line of region with 4 parameters: |
554 |
;; Region start, end, left-col, right-col |
;; Region start, end, left-col, right-col |
555 |
;; Point is at start when FCT is called |
;; Point is at start when FCT is called |
556 |
|
;; Call fct with (s,e) = whole lines if VISIBLE non-nil. |
557 |
|
;; Only call fct for visible lines if VISIBLE==t. |
558 |
;; Set undo boundary if UNDO is non-nil. |
;; Set undo boundary if UNDO is non-nil. |
559 |
;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding) |
;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) |
560 |
|
;; Perform auto-tabify after operation if TABIFY is non-nil. |
561 |
;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. |
;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. |
562 |
(let* ((start (cua--rectangle-top)) |
(let* ((start (cua--rectangle-top)) |
563 |
(end (cua--rectangle-bot)) |
(end (cua--rectangle-bot)) |
565 |
(r (1+ (cua--rectangle-right))) |
(r (1+ (cua--rectangle-right))) |
566 |
(m (make-marker)) |
(m (make-marker)) |
567 |
(tabpad (and (integerp pad) (= pad 2))) |
(tabpad (and (integerp pad) (= pad 2))) |
568 |
(sel (cua--rectangle-restriction))) |
(sel (cua--rectangle-restriction)) |
569 |
|
(tabify-start (and tabify (cua--tabify-start start end)))) |
570 |
(if undo |
(if undo |
571 |
(cua--rectangle-undo-boundary)) |
(cua--rectangle-undo-boundary)) |
572 |
(if (integerp pad) |
(if (integerp pad) |
573 |
(setq pad (cua--rectangle-padding))) |
(setq pad (cua--rectangle-virtual-edges))) |
574 |
(save-excursion |
(save-excursion |
575 |
(save-restriction |
(save-restriction |
576 |
(widen) |
(widen) |
578 |
(goto-char end) |
(goto-char end) |
579 |
(and (bolp) (not (eolp)) (not (eobp)) |
(and (bolp) (not (eolp)) (not (eobp)) |
580 |
(setq end (1+ end)))) |
(setq end (1+ end)))) |
581 |
(when visible |
(when (eq visible t) |
582 |
(setq start (max (window-start) start)) |
(setq start (max (window-start) start)) |
583 |
(setq end (min (window-end) end))) |
(setq end (min (window-end) end))) |
584 |
(goto-char end) |
(goto-char end) |
585 |
(setq end (line-end-position)) |
(setq end (line-end-position)) |
586 |
|
(if (and visible (bolp) (not (eobp))) |
587 |
|
(setq end (1+ end))) |
588 |
(goto-char start) |
(goto-char start) |
589 |
(setq start (line-beginning-position)) |
(setq start (line-beginning-position)) |
590 |
(narrow-to-region start end) |
(narrow-to-region start end) |
597 |
(forward-char 1)) |
(forward-char 1)) |
598 |
(set-marker m (point)) |
(set-marker m (point)) |
599 |
(move-to-column l pad) |
(move-to-column l pad) |
600 |
(if (and fct (>= (current-column) l) (<= (current-column) r)) |
(if (and fct (or visible (and (>= (current-column) l) (<= (current-column) r)))) |
601 |
(let ((v t) (p (point))) |
(let ((v t) (p (point))) |
602 |
(when sel |
(when sel |
603 |
(if (car (cdr sel)) |
(if (car (cdr sel)) |
607 |
(if (car (cdr (cdr sel))) |
(if (car (cdr (cdr sel))) |
608 |
(setq v (null v)))) |
(setq v (null v)))) |
609 |
(if visible |
(if visible |
610 |
(unless (eolp) |
(funcall fct p m l r v) |
|
(funcall fct p m l r v)) |
|
611 |
(if v |
(if v |
612 |
(funcall fct p m l r))))) |
(funcall fct p m l r))))) |
613 |
(set-marker m nil) |
(set-marker m nil) |
615 |
(if (not visible) |
(if (not visible) |
616 |
(cua--rectangle-bot t)) |
(cua--rectangle-bot t)) |
617 |
(if post-fct |
(if post-fct |
618 |
(funcall post-fct l r)))) |
(funcall post-fct l r)) |
619 |
|
(when tabify-start |
620 |
|
(tabify tabify-start (point))))) |
621 |
(cond |
(cond |
622 |
((eq keep-clear 'keep) |
((eq keep-clear 'keep) |
623 |
(cua--keep-active)) |
(cua--keep-active)) |
630 |
|
|
631 |
(put 'cua--rectangle-operation 'lisp-indent-function 4) |
(put 'cua--rectangle-operation 'lisp-indent-function 4) |
632 |
|
|
|
(defun cua--pad-rectangle (&optional pad) |
|
|
(if (or pad (cua--rectangle-padding)) |
|
|
(cua--rectangle-operation nil nil t t))) |
|
|
|
|
633 |
(defun cua--delete-rectangle () |
(defun cua--delete-rectangle () |
634 |
(cua--rectangle-operation nil nil t 2 |
(let ((lines 0)) |
635 |
'(lambda (s e l r) |
(if (not (cua--rectangle-virtual-edges)) |
636 |
(if (and (> e s) (<= e (point-max))) |
(cua--rectangle-operation nil nil t 2 t |
637 |
(delete-region s e))))) |
'(lambda (s e l r v) |
638 |
|
(setq lines (1+ lines)) |
639 |
|
(if (and (> e s) (<= e (point-max))) |
640 |
|
(delete-region s e)))) |
641 |
|
(cua--rectangle-operation nil 1 t nil t |
642 |
|
'(lambda (s e l r v) |
643 |
|
(setq lines (1+ lines)) |
644 |
|
(when (and (> e s) (<= e (point-max))) |
645 |
|
(delete-region s e))))) |
646 |
|
lines)) |
647 |
|
|
648 |
(defun cua--extract-rectangle () |
(defun cua--extract-rectangle () |
649 |
(let (rect) |
(let (rect) |
650 |
(cua--rectangle-operation nil nil nil 1 |
(if (not (cua--rectangle-virtual-edges)) |
651 |
'(lambda (s e l r) |
(cua--rectangle-operation nil nil nil nil nil ; do not tabify |
652 |
(setq rect (cons (buffer-substring-no-properties s e) rect)))) |
'(lambda (s e l r) |
653 |
(nreverse rect))) |
(setq rect (cons (buffer-substring-no-properties s e) rect)))) |
654 |
|
(cua--rectangle-operation nil 1 nil nil nil ; do not tabify |
655 |
|
'(lambda (s e l r v) |
656 |
|
(let ((copy t) (bs 0) (as 0) row) |
657 |
|
(if (= s e) (setq e (1+ e))) |
658 |
|
(goto-char s) |
659 |
|
(move-to-column l) |
660 |
|
(if (= (point) (line-end-position)) |
661 |
|
(setq bs (- r l) |
662 |
|
copy nil) |
663 |
|
(skip-chars-forward "\s\t" e) |
664 |
|
(setq bs (- (min r (current-column)) l) |
665 |
|
s (point)) |
666 |
|
(move-to-column r) |
667 |
|
(skip-chars-backward "\s\t" s) |
668 |
|
(setq as (- r (max (current-column) l)) |
669 |
|
e (point))) |
670 |
|
(setq row (if (and copy (> e s)) |
671 |
|
(buffer-substring-no-properties s e) |
672 |
|
"")) |
673 |
|
(when (> bs 0) |
674 |
|
(setq row (concat (make-string bs ?\s) row))) |
675 |
|
(when (> as 0) |
676 |
|
(setq row (concat row (make-string as ?\s)))) |
677 |
|
(setq rect (cons row rect)))))) |
678 |
|
(nreverse rect))) |
679 |
|
|
680 |
(defun cua--insert-rectangle (rect &optional below) |
(defun cua--insert-rectangle (rect &optional below paste-column line-count) |
681 |
;; Insert rectangle as insert-rectangle, but don't set mark and exit with |
;; Insert rectangle as insert-rectangle, but don't set mark and exit with |
682 |
;; point at either next to top right or below bottom left corner |
;; point at either next to top right or below bottom left corner |
683 |
;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. |
;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. |
684 |
(if (and below (eq below 'auto)) |
(if (eq below 'auto) |
685 |
(setq below (and (bolp) |
(setq below (and (bolp) |
686 |
(or (eolp) (eobp) (= (1+ (point)) (point-max)))))) |
(or (eolp) (eobp) (= (1+ (point)) (point-max)))))) |
687 |
|
(unless paste-column |
688 |
|
(setq paste-column (current-column))) |
689 |
(let ((lines rect) |
(let ((lines rect) |
|
(insertcolumn (current-column)) |
|
690 |
(first t) |
(first t) |
691 |
|
(tabify-start (cua--tabify-start (point) (point))) |
692 |
|
last-column |
693 |
p) |
p) |
694 |
(while (or lines below) |
(while (or lines below) |
695 |
(or first |
(or first |
696 |
(if overwrite-mode |
(if overwrite-mode |
697 |
(insert ?\n) |
(insert ?\n) |
698 |
(forward-line 1) |
(forward-line 1) |
699 |
(or (bolp) (insert ?\n)) |
(or (bolp) (insert ?\n)))) |
700 |
(move-to-column insertcolumn t))) |
(unless overwrite-mode |
701 |
|
(move-to-column paste-column t)) |
702 |
(if (not lines) |
(if (not lines) |
703 |
(setq below nil) |
(setq below nil) |
704 |
(insert-for-yank (car lines)) |
(insert-for-yank (car lines)) |
705 |
|
(unless last-column |
706 |
|
(setq last-column (current-column))) |
707 |
(setq lines (cdr lines)) |
(setq lines (cdr lines)) |
708 |
(and first (not below) |
(and first (not below) |
709 |
(setq p (point)))) |
(setq p (point)))) |
710 |
(setq first nil)) |
(setq first nil) |
711 |
|
(if (and line-count (= (setq line-count (1- line-count)) 0)) |
712 |
|
(setq lines nil))) |
713 |
|
(when (and line-count last-column (not overwrite-mode)) |
714 |
|
(while (> line-count 0) |
715 |
|
(forward-line 1) |
716 |
|
(or (bolp) (insert ?\n)) |
717 |
|
(move-to-column paste-column t) |
718 |
|
(insert-char ?\s (- last-column paste-column -1)) |
719 |
|
(setq line-count (1- line-count)))) |
720 |
|
(when (and tabify-start |
721 |
|
(not overwrite-mode)) |
722 |
|
(tabify tabify-start (point))) |
723 |
(and p (not overwrite-mode) |
(and p (not overwrite-mode) |
724 |
(goto-char p)))) |
(goto-char p)))) |
725 |
|
|
733 |
(function (lambda (row) (concat row "\n"))) |
(function (lambda (row) (concat row "\n"))) |
734 |
killed-rectangle ""))))) |
killed-rectangle ""))))) |
735 |
|
|
736 |
(defun cua--activate-rectangle (&optional force) |
(defun cua--activate-rectangle () |
737 |
;; Turn on rectangular marking mode by disabling transient mark mode |
;; Turn on rectangular marking mode by disabling transient mark mode |
738 |
;; and manually handling highlighting from a post command hook. |
;; and manually handling highlighting from a post command hook. |
739 |
;; Be careful if we are already marking a rectangle. |
;; Be careful if we are already marking a rectangle. |
742 |
(eq (car cua--last-rectangle) (current-buffer)) |
(eq (car cua--last-rectangle) (current-buffer)) |
743 |
(eq (car (cdr cua--last-rectangle)) (point))) |
(eq (car (cdr cua--last-rectangle)) (point))) |
744 |
(cdr (cdr cua--last-rectangle)) |
(cdr (cdr cua--last-rectangle)) |
745 |
(cua--rectangle-get-corners |
(cua--rectangle-get-corners)) |
746 |
(and (not buffer-read-only) |
cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "") |
|
(or cua-auto-expand-rectangles |
|
|
force |
|
|
(eq major-mode 'picture-mode))))) |
|
|
cua--status-string (if (cua--rectangle-padding) " Pad" "") |
|
747 |
cua--last-rectangle nil)) |
cua--last-rectangle nil)) |
748 |
|
|
749 |
;; (defvar cua-save-point nil) |
;; (defvar cua-save-point nil) |
765 |
;; Each overlay extends across all the columns of the rectangle. |
;; Each overlay extends across all the columns of the rectangle. |
766 |
;; We try to reuse overlays where possible because this is more efficient |
;; We try to reuse overlays where possible because this is more efficient |
767 |
;; and results in less flicker. |
;; and results in less flicker. |
768 |
;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines, |
;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or short lines, |
769 |
;; the higlighted region may not be perfectly rectangular. |
;; the higlighted region may not be perfectly rectangular. |
770 |
(let ((deactivate-mark deactivate-mark) |
(let ((deactivate-mark deactivate-mark) |
771 |
(old cua--rectangle-overlays) |
(old cua--rectangle-overlays) |
774 |
(right (1+ (cua--rectangle-right)))) |
(right (1+ (cua--rectangle-right)))) |
775 |
(when (/= left right) |
(when (/= left right) |
776 |
(sit-for 0) ; make window top/bottom reliable |
(sit-for 0) ; make window top/bottom reliable |
777 |
(cua--rectangle-operation nil t nil nil |
(cua--rectangle-operation nil t nil nil nil ; do not tabify |
778 |
'(lambda (s e l r v) |
'(lambda (s e l r v) |
779 |
(let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) |
(let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) |
780 |
overlay) |
overlay bs ms as) |
|
;; Trim old leading overlays. |
|
781 |
(if (= s e) (setq e (1+ e))) |
(if (= s e) (setq e (1+ e))) |
782 |
|
(when (cua--rectangle-virtual-edges) |
783 |
|
(let ((lb (line-beginning-position)) |
784 |
|
(le (line-end-position)) |
785 |
|
cl cl0 pl cr cr0 pr) |
786 |
|
(goto-char s) |
787 |
|
(setq cl (move-to-column l) |
788 |
|
pl (point)) |
789 |
|
(setq cr (move-to-column r) |
790 |
|
pr (point)) |
791 |
|
(if (= lb pl) |
792 |
|
(setq cl0 0) |
793 |
|
(goto-char (1- pl)) |
794 |
|
(setq cl0 (current-column))) |
795 |
|
(if (= lb le) |
796 |
|
(setq cr0 0) |
797 |
|
(goto-char (1- pr)) |
798 |
|
(setq cr0 (current-column))) |
799 |
|
(unless (and (= cl l) (= cr r)) |
800 |
|
(when (/= cl l) |
801 |
|
(setq bs (propertize |
802 |
|
(make-string |
803 |
|
(- l cl0 (if (and (= le pl) (/= le lb)) 1 0)) |
804 |
|
(if cua--virtual-edges-debug ?. ?\s)) |
805 |
|
'face 'default)) |
806 |
|
(if (/= pl le) |
807 |
|
(setq s (1- s)))) |
808 |
|
(cond |
809 |
|
((= cr r) |
810 |
|
(if (and (/= pr le) |
811 |
|
(/= cr0 (1- cr)) |
812 |
|
(or bs (/= cr0 (- cr tab-width))) |
813 |
|
(/= (mod cr tab-width) 0)) |
814 |
|
(setq e (1- e)))) |
815 |
|
((= cr cl) |
816 |
|
(setq ms (propertize |
817 |
|
(make-string |
818 |
|
(- r l) |
819 |
|
(if cua--virtual-edges-debug ?, ?\s)) |
820 |
|
'face rface)) |
821 |
|
(if (cua--rectangle-right-side) |
822 |
|
(put-text-property (1- (length ms)) (length ms) 'cursor t ms) |
823 |
|
(put-text-property 0 1 'cursor t ms)) |
824 |
|
(setq bs (concat bs ms)) |
825 |
|
(setq rface nil)) |
826 |
|
(t |
827 |
|
(setq as (propertize |
828 |
|
(make-string |
829 |
|
(- r cr0 (if (= le pr) 1 0)) |
830 |
|
(if cua--virtual-edges-debug ?~ ?\s)) |
831 |
|
'face rface)) |
832 |
|
(if (cua--rectangle-right-side) |
833 |
|
(put-text-property (1- (length as)) (length as) 'cursor t as) |
834 |
|
(put-text-property 0 1 'cursor t as)) |
835 |
|
(if (/= pr le) |
836 |
|
(setq e (1- e)))))))) |
837 |
|
;; Trim old leading overlays. |
838 |
(while (and old |
(while (and old |
839 |
(setq overlay (car old)) |
(setq overlay (car old)) |
840 |
(< (overlay-start overlay) s) |
(< (overlay-start overlay) s) |
850 |
(move-overlay overlay s e) |
(move-overlay overlay s e) |
851 |
(setq old (cdr old))) |
(setq old (cdr old))) |
852 |
(setq overlay (make-overlay s e))) |
(setq overlay (make-overlay s e))) |
853 |
(overlay-put overlay 'face rface) |
(overlay-put overlay 'before-string bs) |
854 |
(setq new (cons overlay new)))))) |
(overlay-put overlay 'after-string as) |
855 |
|
(overlay-put overlay 'face rface) |
856 |
|
(overlay-put overlay 'keymap cua--overlay-keymap) |
857 |
|
(setq new (cons overlay new)))))) |
858 |
;; Trim old trailing overlays. |
;; Trim old trailing overlays. |
859 |
(mapcar (function delete-overlay) old) |
(mapcar (function delete-overlay) old) |
860 |
(setq cua--rectangle-overlays (nreverse new)))) |
(setq cua--rectangle-overlays (nreverse new)))) |
862 |
(defun cua--indent-rectangle (&optional ch to-col clear) |
(defun cua--indent-rectangle (&optional ch to-col clear) |
863 |
;; Indent current rectangle. |
;; Indent current rectangle. |
864 |
(let ((col (cua--rectangle-insert-col)) |
(let ((col (cua--rectangle-insert-col)) |
865 |
(pad (cua--rectangle-padding)) |
(pad (cua--rectangle-virtual-edges)) |
866 |
indent) |
indent) |
867 |
(cua--rectangle-operation (if clear 'clear 'corners) nil t pad |
(cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil |
868 |
'(lambda (s e l r) |
'(lambda (s e l r) |
869 |
(move-to-column col pad) |
(move-to-column col pad) |
870 |
(if (and (eolp) |
(if (and (eolp) |
1000 |
(defun cua-rotate-rectangle () |
(defun cua-rotate-rectangle () |
1001 |
(interactive) |
(interactive) |
1002 |
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) |
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) |
1003 |
(cua--rectangle-set-corners)) |
(cua--rectangle-set-corners) |
1004 |
|
(if (cua--rectangle-virtual-edges) |
1005 |
|
(setq cua--buffer-and-point-before-command nil))) |
1006 |
|
|
1007 |
(defun cua-toggle-rectangle-padding () |
(defun cua-toggle-rectangle-virtual-edges () |
1008 |
(interactive) |
(interactive) |
1009 |
(if buffer-read-only |
(cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges))) |
1010 |
(message "Cannot do padding in read-only buffer.") |
(cua--rectangle-set-corners) |
1011 |
(cua--rectangle-padding t (not (cua--rectangle-padding))) |
(setq cua--status-string (and (cua--rectangle-virtual-edges) " [R]")) |
|
(cua--pad-rectangle) |
|
|
(cua--rectangle-set-corners)) |
|
|
(setq cua--status-string (and (cua--rectangle-padding) " Pad")) |
|
1012 |
(cua--keep-active)) |
(cua--keep-active)) |
1013 |
|
|
1014 |
(defun cua-do-rectangle-padding () |
(defun cua-do-rectangle-padding () |
1015 |
(interactive) |
(interactive) |
1016 |
(if buffer-read-only |
(if buffer-read-only |
1017 |
(message "Cannot do padding in read-only buffer.") |
(message "Cannot do padding in read-only buffer.") |
1018 |
(cua--pad-rectangle t) |
(cua--rectangle-operation nil nil t t t) |
1019 |
(cua--rectangle-set-corners)) |
(cua--rectangle-set-corners)) |
1020 |
(cua--keep-active)) |
(cua--keep-active)) |
1021 |
|
|
1024 |
The text previously in the region is not overwritten by the blanks, |
The text previously in the region is not overwritten by the blanks, |
1025 |
but instead winds up to the right of the rectangle." |
but instead winds up to the right of the rectangle." |
1026 |
(interactive) |
(interactive) |
1027 |
(cua--rectangle-operation 'corners nil t 1 |
(cua--rectangle-operation 'corners nil t 1 nil |
1028 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1029 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
1030 |
(let ((ws (- (current-column) l)) |
(let ((ws (- (current-column) l)) |
1039 |
at that column is deleted. |
at that column is deleted. |
1040 |
With prefix arg, also delete whitespace to the left of that column." |
With prefix arg, also delete whitespace to the left of that column." |
1041 |
(interactive "P") |
(interactive "P") |
1042 |
(cua--rectangle-operation 'clear nil t 1 |
(cua--rectangle-operation 'clear nil t 1 nil |
1043 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1044 |
(when arg |
(when arg |
1045 |
(skip-syntax-backward " " (line-beginning-position)) |
(skip-syntax-backward " " (line-beginning-position)) |
1051 |
"Blank out CUA rectangle. |
"Blank out CUA rectangle. |
1052 |
The text previously in the rectangle is overwritten by the blanks." |
The text previously in the rectangle is overwritten by the blanks." |
1053 |
(interactive) |
(interactive) |
1054 |
(cua--rectangle-operation 'keep nil nil 1 |
(cua--rectangle-operation 'keep nil nil 1 nil |
1055 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1056 |
(goto-char e) |
(goto-char e) |
1057 |
(skip-syntax-forward " " (line-end-position)) |
(skip-syntax-forward " " (line-end-position)) |
1066 |
"Align rectangle lines to left column." |
"Align rectangle lines to left column." |
1067 |
(interactive) |
(interactive) |
1068 |
(let (x) |
(let (x) |
1069 |
(cua--rectangle-operation 'clear nil t t |
(cua--rectangle-operation 'clear nil t t nil |
1070 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1071 |
(let ((b (line-beginning-position))) |
(let ((b (line-beginning-position))) |
1072 |
(skip-syntax-backward "^ " b) |
(skip-syntax-backward "^ " b) |
1108 |
"Replace CUA rectangle contents with STRING on each line. |
"Replace CUA rectangle contents with STRING on each line. |
1109 |
The length of STRING need not be the same as the rectangle width." |
The length of STRING need not be the same as the rectangle width." |
1110 |
(interactive "sString rectangle: ") |
(interactive "sString rectangle: ") |
1111 |
(cua--rectangle-operation 'keep nil t t |
(cua--rectangle-operation 'keep nil t t nil |
1112 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1113 |
(delete-region s e) |
(delete-region s e) |
1114 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
1123 |
(defun cua-fill-char-rectangle (ch) |
(defun cua-fill-char-rectangle (ch) |
1124 |
"Replace CUA rectangle contents with CHARACTER." |
"Replace CUA rectangle contents with CHARACTER." |
1125 |
(interactive "cFill rectangle with character: ") |
(interactive "cFill rectangle with character: ") |
1126 |
(cua--rectangle-operation 'clear nil t 1 |
(cua--rectangle-operation 'clear nil t 1 nil |
1127 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1128 |
(delete-region s e) |
(delete-region s e) |
1129 |
(move-to-column l t) |
(move-to-column l t) |
1134 |
(interactive "sReplace regexp: \nsNew text: ") |
(interactive "sReplace regexp: \nsNew text: ") |
1135 |
(if buffer-read-only |
(if buffer-read-only |
1136 |
(message "Cannot replace in read-only buffer") |
(message "Cannot replace in read-only buffer") |
1137 |
(cua--rectangle-operation 'keep nil t 1 |
(cua--rectangle-operation 'keep nil t 1 nil |
1138 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1139 |
(if (re-search-forward regexp e t) |
(if (re-search-forward regexp e t) |
1140 |
(replace-match newtext nil nil)))))) |
(replace-match newtext nil nil)))))) |
1142 |
(defun cua-incr-rectangle (increment) |
(defun cua-incr-rectangle (increment) |
1143 |
"Increment each line of CUA rectangle by prefix amount." |
"Increment each line of CUA rectangle by prefix amount." |
1144 |
(interactive "p") |
(interactive "p") |
1145 |
(cua--rectangle-operation 'keep nil t 1 |
(cua--rectangle-operation 'keep nil t 1 nil |
1146 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1147 |
(cond |
(cond |
1148 |
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) |
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) |
1175 |
(if (= (length fmt) 0) |
(if (= (length fmt) 0) |
1176 |
(setq fmt cua--rectangle-seq-format) |
(setq fmt cua--rectangle-seq-format) |
1177 |
(setq cua--rectangle-seq-format fmt)) |
(setq cua--rectangle-seq-format fmt)) |
1178 |
(cua--rectangle-operation 'clear nil t 1 |
(cua--rectangle-operation 'clear nil t 1 nil |
1179 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1180 |
(delete-region s e) |
(delete-region s e) |
1181 |
(insert (format fmt first)) |
(insert (format fmt first)) |
1182 |
(setq first (+ first incr))))) |
(setq first (+ first incr))))) |
1183 |
|
|
1184 |
(defmacro cua--convert-rectangle-as (command) |
(defmacro cua--convert-rectangle-as (command tabify) |
1185 |
`(cua--rectangle-operation 'clear nil nil nil |
`(cua--rectangle-operation 'clear nil nil nil ,tabify |
1186 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1187 |
(,command s e)))) |
(,command s e)))) |
1188 |
|
|
1189 |
(defun cua-upcase-rectangle () |
(defun cua-upcase-rectangle () |
1190 |
"Convert the rectangle to upper case." |
"Convert the rectangle to upper case." |
1191 |
(interactive) |
(interactive) |
1192 |
(cua--convert-rectangle-as upcase-region)) |
(cua--convert-rectangle-as upcase-region nil)) |
1193 |
|
|
1194 |
(defun cua-downcase-rectangle () |
(defun cua-downcase-rectangle () |
1195 |
"Convert the rectangle to lower case." |
"Convert the rectangle to lower case." |
1196 |
(interactive) |
(interactive) |
1197 |
(cua--convert-rectangle-as downcase-region)) |
(cua--convert-rectangle-as downcase-region nil)) |
1198 |
|
|
1199 |
(defun cua-upcase-initials-rectangle () |
(defun cua-upcase-initials-rectangle () |
1200 |
"Convert the rectangle initials to upper case." |
"Convert the rectangle initials to upper case." |
1201 |
(interactive) |
(interactive) |
1202 |
(cua--convert-rectangle-as upcase-initials-region)) |
(cua--convert-rectangle-as upcase-initials-region nil)) |
1203 |
|
|
1204 |
(defun cua-capitalize-rectangle () |
(defun cua-capitalize-rectangle () |
1205 |
"Convert the rectangle to proper case." |
"Convert the rectangle to proper case." |
1206 |
(interactive) |
(interactive) |
1207 |
(cua--convert-rectangle-as capitalize-region)) |
(cua--convert-rectangle-as capitalize-region nil)) |
1208 |
|
|
1209 |
|
|
1210 |
;;; Replace/rearrange text in current rectangle |
;;; Replace/rearrange text in current rectangle |
1240 |
(setq z (reverse z)) |
(setq z (reverse z)) |
1241 |
(if cua--debug |
(if cua--debug |
1242 |
(print z auxbuf)) |
(print z auxbuf)) |
1243 |
(cua--rectangle-operation nil nil t pad |
(cua--rectangle-operation nil nil t pad nil |
1244 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1245 |
(let (cc) |
(let (cc) |
1246 |
(goto-char e) |
(goto-char e) |
1356 |
"Delete char to left or right of rectangle." |
"Delete char to left or right of rectangle." |
1357 |
(interactive) |
(interactive) |
1358 |
(let ((col (cua--rectangle-insert-col)) |
(let ((col (cua--rectangle-insert-col)) |
1359 |
(pad (cua--rectangle-padding)) |
(pad (cua--rectangle-virtual-edges)) |
1360 |
indent) |
indent) |
1361 |
(cua--rectangle-operation 'corners nil t pad |
(cua--rectangle-operation 'corners nil t pad nil |
1362 |
'(lambda (s e l r) |
'(lambda (s e l r) |
1363 |
(move-to-column |
(move-to-column |
1364 |
(if (cua--rectangle-right-side t) |
(if (cua--rectangle-right-side t) |
1406 |
(cua--rectangle-left (current-column))) |
(cua--rectangle-left (current-column))) |
1407 |
(if (>= (cua--rectangle-corner) 2) |
(if (>= (cua--rectangle-corner) 2) |
1408 |
(cua--rectangle-bot t) |
(cua--rectangle-bot t) |
1409 |
(cua--rectangle-top t)) |
(cua--rectangle-top t)))) |
|
(if (cua--rectangle-padding) |
|
|
(setq unread-command-events |
|
|
(cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events))))) |
|
1410 |
(if cua--rectangle |
(if cua--rectangle |
1411 |
(if (and mark-active |
(if (and mark-active |
1412 |
(not deactivate-mark)) |
(not deactivate-mark)) |
1500 |
(cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) |
(cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) |
1501 |
(cua--rect-M/H-key ?n 'cua-sequence-rectangle) |
(cua--rect-M/H-key ?n 'cua-sequence-rectangle) |
1502 |
(cua--rect-M/H-key ?o 'cua-open-rectangle) |
(cua--rect-M/H-key ?o 'cua-open-rectangle) |
1503 |
(cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding) |
(cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges) |
1504 |
(cua--rect-M/H-key ?P 'cua-do-rectangle-padding) |
(cua--rect-M/H-key ?P 'cua-do-rectangle-padding) |
1505 |
(cua--rect-M/H-key ?q 'cua-refill-rectangle) |
(cua--rect-M/H-key ?q 'cua-refill-rectangle) |
1506 |
(cua--rect-M/H-key ?r 'cua-replace-in-rectangle) |
(cua--rect-M/H-key ?r 'cua-replace-in-rectangle) |