procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/rect.el (rectangle-mark-mode): Activate mark even if

Browse source 
transient-mark-mode is off.
(rectangle--highlight-for-redisplay): Fix boundary condition when point
is > mark and at bolp.

Fixes: debbugs:16066
This commit is contained in:
Stefan Monnier 2013-12-08 02:32:01 -05:00
parent 6407822c66
commit 02033d491f
2 changed files with 74 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/ChangeLog
View file

@ -7,6 +7,11 @@
2013-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
* rect.el (rectangle-mark-mode): Activate mark even if
transient-mark-mode is off (bug#16066).
(rectangle--highlight-for-redisplay): Fix boundary condition when point
is > mark and at bolp.
* emulation/cua-rect.el (cua--rectangle-region-extract): New function.
(region-extract-function): Use it.
(cua-mouse-save-then-kill-rectangle): Use cua-copy-region.

134
lisp/rect.el
View file

@ -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))))))