From 4aca7145ffb6e532ed3939950d0ed6b4efec2c6c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Nov 2013 22:06:54 -0500 Subject: [PATCH] * 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 --- lisp/ChangeLog | 8 ++++++++ lisp/rect.el | 46 +++++++++++++++++++++++++++++----------------- 2 files changed, 37 insertions(+), 17 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 522181b3e4..9a1dc4bd13 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2013-11-04 Stefan Monnier + + * 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 (bug#15796). + 2013-11-04 Glenn Morris * startup.el (command-line-1): Allow `-L :...' to append to load-path. diff --git a/lisp/rect.el b/lisp/rect.el index 44799f2616..5f4f1672bd 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -420,11 +420,8 @@ with a prefix argument, prompt for START-AT and FORMAT." ;; - lots of commands handle the region without paying attention to its ;; rectangular shape. -(defvar-local rectangle--region nil - "If non-nil, the region is meant to delimit a rectangle.") - (add-hook 'deactivate-mark-hook - (lambda () (kill-local-variable 'rectangle--region))) + (lambda () (rectangle-mark-mode -1))) (add-function :around redisplay-highlight-region-function #'rectangle--highlight-for-redisplay) @@ -433,17 +430,25 @@ with a prefix argument, prompt for START-AT and FORMAT." (add-function :around region-extract-function #'rectangle--extract-region) +(defvar rectangle-mark-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [?\C-o] 'open-rectangle) + (define-key map [?\C-t] 'string-rectangle) + ;; (define-key map [remap open-line] 'open-rectangle) + ;; (define-key map [remap transpose-chars] 'string-rectangle) + map) + "Keymap used while marking a rectangular region.") + ;;;###autoload -(defun rectangle-mark () - "Toggle the region as rectangular." - (interactive) - (if rectangle--region - (kill-local-variable 'rectangle--region) - (unless (region-active-p) (push-mark-command t)) - (setq rectangle--region t))) +(define-minor-mode rectangle-mark-mode + "Toggle the region as rectangular. +Activates the region if needed. Only lasts until the region is deactivated." + nil nil nil + (when rectangle-mark-mode + (unless (region-active-p) (push-mark-command t)))) (defun rectangle--extract-region (orig &optional delete) - (if (not rectangle--region) + (if (not rectangle-mark-mode) (funcall orig delete) (let* ((strs (funcall (if delete #'delete-extract-rectangle @@ -473,7 +478,7 @@ with a prefix argument, prompt for START-AT and FORMAT." (defun rectangle--highlight-for-redisplay (orig start end window rol) (cond - ((not rectangle--region) + ((not rectangle-mark-mode) (funcall orig start end window rol)) ((and (eq 'rectangle (car-safe rol)) (eq (nth 1 rol) (buffer-modified-tick)) @@ -535,10 +540,17 @@ with a prefix argument, prompt for START-AT and FORMAT." (eq (char-before right) ?\t)) (setq right (1- right)) (move-overlay ol left right) - (goto-char right) - (let ((str (make-string (- rightcol (current-column)) ?\s))) - (put-text-property 0 (length str) 'face 'region str) - (overlay-put ol 'after-string str))) + (if (= rightcol leftcol) + (overlay-put ol 'after-string nil) + (goto-char right) + (let ((str (make-string + (- rightcol (max leftcol (current-column))) ?\s))) + (put-text-property 0 (length str) 'face 'region str) + (when (= left right) + ;; If cursor happens to be here, draw it *before* rather + ;; than after this highlighted pseudo-text. + (put-text-property 0 1 'cursor 1 str)) + (overlay-put ol 'after-string str)))) ((overlay-get ol 'after-string) (overlay-put ol 'after-string nil))) (when (= leftcol rightcol) -- 2.20.1