aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-11-03 22:06:54 -0500
committerStefan Monnier2013-11-03 22:06:54 -0500
commit4aca7145ffb6e532ed3939950d0ed6b4efec2c6c (patch)
tree8923c78c18eb0c884e9eb7c24a55579d45be1b48
parent8b77446f3f4e49780e29cd936211eeee1453ca6c (diff)
downloademacs-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/ChangeLog8
-rw-r--r--lisp/rect.el46
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 @@
12013-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
12013-11-04 Glenn Morris <rgm@gnu.org> 92013-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) 445Activates 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)