diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-12-08 02:32:01 -0500 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-12-08 02:32:01 -0500 |
commit | 02033d491fa708e28bb3568ff85dab4d0ceb076b (patch) | |
tree | f45b338a7b45d6f2a56e4d2ed51a6a8bdf854a7c /lisp/rect.el | |
parent | 6407822c66a86abe01eea33d7eca662e3e7c2b60 (diff) | |
download | emacs-02033d491fa708e28bb3568ff85dab4d0ceb076b.tar.gz |
* lisp/rect.el (rectangle-mark-mode): Activate mark even if
transient-mark-mode is off.
(rectangle--highlight-for-redisplay): Fix boundary condition when point
is > mark and at bolp.
Fixes: debbugs:16066
Diffstat (limited to 'lisp/rect.el')
-rw-r--r-- | lisp/rect.el | 134 |
1 files changed, 69 insertions, 65 deletions
diff --git a/lisp/rect.el b/lisp/rect.el index ad94663fc96..be29517e087 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -443,7 +443,9 @@ with a prefix argument, prompt for START-AT and FORMAT." 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)))) + (unless (region-active-p) + (push-mark) + (activate-mark)))) (defun rectangle--extract-region (orig &optional delete) (if (not rectangle-mark-mode) @@ -495,70 +497,72 @@ Activates the region if needed. Only lasts until the region is deactivated." (leftcol (min ptcol markcol)) (rightcol (max ptcol markcol))) (goto-char start) - (while (< (point) end) - (let* ((mleft (move-to-column leftcol)) - (left (point)) - (mright (move-to-column rightcol)) - (right (point)) - (ol - (if (not old) - (let ((ol (make-overlay left right))) - (overlay-put ol 'window window) - (overlay-put ol 'face 'region) - ol) - (let ((ol (pop old))) - (move-overlay ol left right (current-buffer)) - ol)))) - ;; `move-to-column' may stop before the column (if bumping into - ;; EOL) or overshoot it a little, when column is in the middle - ;; of a char. - (cond - ((< mleft leftcol) ;`leftcol' is past EOL. - (overlay-put ol 'before-string - (spaces-string (- leftcol mleft))) - (setq mright (max mright leftcol))) - ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. - (eq (char-before left) ?\t)) - (setq left (1- left)) - (move-overlay ol left right) - (goto-char left) - (overlay-put ol 'before-string - (spaces-string (- leftcol (current-column))))) - ((overlay-get ol 'before-string) - (overlay-put ol 'before-string nil))) - (cond - ((< mright rightcol) ;`rightcol' is past EOL. - (let ((str (make-string (- rightcol mright) ?\s))) - (put-text-property 0 (length str) 'face 'region str) - ;; If cursor happens to be here, draw it *before* rather than - ;; after this highlighted pseudo-text. - (put-text-property 0 1 'cursor t str) - (overlay-put ol 'after-string str))) - ((and (> mright rightcol) ;`rightcol' is in the middle of a char. - (eq (char-before right) ?\t)) - (setq right (1- right)) - (move-overlay ol left right) - (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) - ;; Make zero-width rectangles visible! - (overlay-put ol 'after-string - (concat (propertize " " - 'face '(region (:height 0.2))) - (overlay-get ol 'after-string)))) - (push ol nrol)) - (forward-line 1)) + (while + (let* ((mleft (move-to-column leftcol)) + (left (point)) + (mright (move-to-column rightcol)) + (right (point)) + (ol + (if (not old) + (let ((ol (make-overlay left right))) + (overlay-put ol 'window window) + (overlay-put ol 'face 'region) + ol) + (let ((ol (pop old))) + (move-overlay ol left right (current-buffer)) + ol)))) + ;; `move-to-column' may stop before the column (if bumping into + ;; EOL) or overshoot it a little, when column is in the middle + ;; of a char. + (cond + ((< mleft leftcol) ;`leftcol' is past EOL. + (overlay-put ol 'before-string + (spaces-string (- leftcol mleft))) + (setq mright (max mright leftcol))) + ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. + (eq (char-before left) ?\t)) + (setq left (1- left)) + (move-overlay ol left right) + (goto-char left) + (overlay-put ol 'before-string + (spaces-string (- leftcol (current-column))))) + ((overlay-get ol 'before-string) + (overlay-put ol 'before-string nil))) + (cond + ((< mright rightcol) ;`rightcol' is past EOL. + (let ((str (make-string (- rightcol mright) ?\s))) + (put-text-property 0 (length str) 'face 'region str) + ;; If cursor happens to be here, draw it *before* rather than + ;; after this highlighted pseudo-text. + (put-text-property 0 1 'cursor t str) + (overlay-put ol 'after-string str))) + ((and (> mright rightcol) ;`rightcol's in the middle of a char. + (eq (char-before right) ?\t)) + (setq right (1- right)) + (move-overlay ol left right) + (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) + ;; Make zero-width rectangles visible! + (overlay-put ol 'after-string + (concat (propertize " " + 'face '(region (:height 0.2))) + (overlay-get ol 'after-string)))) + (push ol nrol) + (and (zerop (forward-line 1)) + (<= (point) end)))) (mapc #'delete-overlay old) `(rectangle ,(buffer-chars-modified-tick) ,start ,end ,@nrol)))))) |