diff options
| author | Stefan Monnier | 2013-11-03 22:06:54 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2013-11-03 22:06:54 -0500 |
| commit | 4aca7145ffb6e532ed3939950d0ed6b4efec2c6c (patch) | |
| tree | 8923c78c18eb0c884e9eb7c24a55579d45be1b48 | |
| parent | 8b77446f3f4e49780e29cd936211eeee1453ca6c (diff) | |
| download | emacs-4aca7145ffb6e532ed3939950d0ed6b4efec2c6c.tar.gz emacs-4aca7145ffb6e532ed3939950d0ed6b4efec2c6c.zip | |
* lisp/rect.el (rectangle-mark-mode): Rename from rectangle-mark.
Make it into a proper minor mode.
(rectangle--region): (implicitly) rename to rectangle-mark-mode.
(rectangle-mark-mode-map): New keymap.
(rectangle--highlight-for-redisplay): Fix some corner cases.
Fixes: debbugs:15796
| -rw-r--r-- | lisp/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/rect.el | 46 |
2 files changed, 37 insertions, 17 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 522181b3e4f..9a1dc4bd13c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,11 @@ | |||
| 1 | 2013-11-04 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * rect.el (rectangle-mark-mode): Rename from rectangle-mark. | ||
| 4 | Make it into a proper minor mode. | ||
| 5 | (rectangle--region): (implicitly) rename to rectangle-mark-mode. | ||
| 6 | (rectangle-mark-mode-map): New keymap. | ||
| 7 | (rectangle--highlight-for-redisplay): Fix some corner cases (bug#15796). | ||
| 8 | |||
| 1 | 2013-11-04 Glenn Morris <rgm@gnu.org> | 9 | 2013-11-04 Glenn Morris <rgm@gnu.org> |
| 2 | 10 | ||
| 3 | * startup.el (command-line-1): Allow `-L :...' to append to load-path. | 11 | * startup.el (command-line-1): Allow `-L :...' to append to load-path. |
diff --git a/lisp/rect.el b/lisp/rect.el index 44799f2616a..5f4f1672bdd 100644 --- a/lisp/rect.el +++ b/lisp/rect.el | |||
| @@ -420,11 +420,8 @@ with a prefix argument, prompt for START-AT and FORMAT." | |||
| 420 | ;; - lots of commands handle the region without paying attention to its | 420 | ;; - lots of commands handle the region without paying attention to its |
| 421 | ;; rectangular shape. | 421 | ;; rectangular shape. |
| 422 | 422 | ||
| 423 | (defvar-local rectangle--region nil | ||
| 424 | "If non-nil, the region is meant to delimit a rectangle.") | ||
| 425 | |||
| 426 | (add-hook 'deactivate-mark-hook | 423 | (add-hook 'deactivate-mark-hook |
| 427 | (lambda () (kill-local-variable 'rectangle--region))) | 424 | (lambda () (rectangle-mark-mode -1))) |
| 428 | 425 | ||
| 429 | (add-function :around redisplay-highlight-region-function | 426 | (add-function :around redisplay-highlight-region-function |
| 430 | #'rectangle--highlight-for-redisplay) | 427 | #'rectangle--highlight-for-redisplay) |
| @@ -433,17 +430,25 @@ with a prefix argument, prompt for START-AT and FORMAT." | |||
| 433 | (add-function :around region-extract-function | 430 | (add-function :around region-extract-function |
| 434 | #'rectangle--extract-region) | 431 | #'rectangle--extract-region) |
| 435 | 432 | ||
| 433 | (defvar rectangle-mark-mode-map | ||
| 434 | (let ((map (make-sparse-keymap))) | ||
| 435 | (define-key map [?\C-o] 'open-rectangle) | ||
| 436 | (define-key map [?\C-t] 'string-rectangle) | ||
| 437 | ;; (define-key map [remap open-line] 'open-rectangle) | ||
| 438 | ;; (define-key map [remap transpose-chars] 'string-rectangle) | ||
| 439 | map) | ||
| 440 | "Keymap used while marking a rectangular region.") | ||
| 441 | |||
| 436 | ;;;###autoload | 442 | ;;;###autoload |
| 437 | (defun rectangle-mark () | 443 | (define-minor-mode rectangle-mark-mode |
| 438 | "Toggle the region as rectangular." | 444 | "Toggle the region as rectangular. |
| 439 | (interactive) | 445 | Activates the region if needed. Only lasts until the region is deactivated." |
| 440 | (if rectangle--region | 446 | nil nil nil |
| 441 | (kill-local-variable 'rectangle--region) | 447 | (when rectangle-mark-mode |
| 442 | (unless (region-active-p) (push-mark-command t)) | 448 | (unless (region-active-p) (push-mark-command t)))) |
| 443 | (setq rectangle--region t))) | ||
| 444 | 449 | ||
| 445 | (defun rectangle--extract-region (orig &optional delete) | 450 | (defun rectangle--extract-region (orig &optional delete) |
| 446 | (if (not rectangle--region) | 451 | (if (not rectangle-mark-mode) |
| 447 | (funcall orig delete) | 452 | (funcall orig delete) |
| 448 | (let* ((strs (funcall (if delete | 453 | (let* ((strs (funcall (if delete |
| 449 | #'delete-extract-rectangle | 454 | #'delete-extract-rectangle |
| @@ -473,7 +478,7 @@ with a prefix argument, prompt for START-AT and FORMAT." | |||
| 473 | 478 | ||
| 474 | (defun rectangle--highlight-for-redisplay (orig start end window rol) | 479 | (defun rectangle--highlight-for-redisplay (orig start end window rol) |
| 475 | (cond | 480 | (cond |
| 476 | ((not rectangle--region) | 481 | ((not rectangle-mark-mode) |
| 477 | (funcall orig start end window rol)) | 482 | (funcall orig start end window rol)) |
| 478 | ((and (eq 'rectangle (car-safe rol)) | 483 | ((and (eq 'rectangle (car-safe rol)) |
| 479 | (eq (nth 1 rol) (buffer-modified-tick)) | 484 | (eq (nth 1 rol) (buffer-modified-tick)) |
| @@ -535,10 +540,17 @@ with a prefix argument, prompt for START-AT and FORMAT." | |||
| 535 | (eq (char-before right) ?\t)) | 540 | (eq (char-before right) ?\t)) |
| 536 | (setq right (1- right)) | 541 | (setq right (1- right)) |
| 537 | (move-overlay ol left right) | 542 | (move-overlay ol left right) |
| 538 | (goto-char right) | 543 | (if (= rightcol leftcol) |
| 539 | (let ((str (make-string (- rightcol (current-column)) ?\s))) | 544 | (overlay-put ol 'after-string nil) |
| 540 | (put-text-property 0 (length str) 'face 'region str) | 545 | (goto-char right) |
| 541 | (overlay-put ol 'after-string str))) | 546 | (let ((str (make-string |
| 547 | (- rightcol (max leftcol (current-column))) ?\s))) | ||
| 548 | (put-text-property 0 (length str) 'face 'region str) | ||
| 549 | (when (= left right) | ||
| 550 | ;; If cursor happens to be here, draw it *before* rather | ||
| 551 | ;; than after this highlighted pseudo-text. | ||
| 552 | (put-text-property 0 1 'cursor 1 str)) | ||
| 553 | (overlay-put ol 'after-string str)))) | ||
| 542 | ((overlay-get ol 'after-string) | 554 | ((overlay-get ol 'after-string) |
| 543 | (overlay-put ol 'after-string nil))) | 555 | (overlay-put ol 'after-string nil))) |
| 544 | (when (= leftcol rightcol) | 556 | (when (= leftcol rightcol) |