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