From: "Mattias Engdegård" <mattias.engdegard@gmail.com>
To: Michael Heerdegen <michael_heerdegen@web.de>
Cc: Eli Zaretskii <eliz@gnu.org>,
72830@debbugs.gnu.org, Stefan Monnier <monnier@iro.umontreal.ca>,
Juri Linkov <juri@linkov.net>
Subject: bug#72830: Big rectangular selections are slow
Date: Thu, 29 Aug 2024 12:22:08 +0200 [thread overview]
Message-ID: <AE14E0AC-FBE5-49FD-8931-D39FAD343EE9@gmail.com> (raw)
In-Reply-To: <87zfow2d90.fsf@web.de>
[-- Attachment #1: Type: text/plain, Size: 535 bytes --]
29 aug. 2024 kl. 05.56 skrev Michael Heerdegen <michael_heerdegen@web.de>:
> My idea would be: highlight from or up to "rectangle point" maximally
> (window-height) lines.
Here I was digging into the redisplay code in the hope of finding an obscure hook to subvert, and you turn up and give us the obvious, simple and correct solution right away. Thank you, Michael!
The patch below is crude but seems to work. Please give it a try.
If the original recipe is still stuttering, try setting `select-active-regions` to nil.
[-- Attachment #2: rect-highlight.diff --]
[-- Type: application/octet-stream, Size: 10422 bytes --]
diff --git a/lisp/rect.el b/lisp/rect.el
index 93007824679..1fadb4c768a 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -869,81 +869,107 @@ rectangle--highlight-for-redisplay
(cl-assert (eq (window-buffer window) (current-buffer)))
;; `rectangle--pos-cols' looks up the `selected-window's parameter!
(with-selected-window window
- (apply-on-rectangle
- (lambda (leftcol rightcol)
- (let* ((mleft (move-to-column leftcol))
- (left (point))
- ;; BEWARE: In the presence of other overlays with
- ;; before/after/display-strings, this happens to move to
- ;; the column "as if the overlays were not applied", which
- ;; is sometimes what we want, tho it can be
- ;; considered a bug in move-to-column (it should arguably
- ;; pay attention to the before/after-string/display
- ;; properties when computing the column).
- (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 (rectangle--space-to leftcol))
- (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 (rectangle--space-to leftcol)))
- ((overlay-get ol 'before-string)
- (overlay-put ol 'before-string nil)))
- (cond
- ;; While doing rectangle--string-preview, the two sets of
- ;; overlays steps on the other's toes. I fixed some of the
- ;; problems, but others remain. The main one is the two
- ;; (rectangle--space-to rightcol) below which try to virtually
- ;; insert missing text, but during "preview", the text is not
- ;; missing (it's provided by preview's own overlay).
- (rectangle--string-preview-state
- (if (overlay-get ol 'after-string)
- (overlay-put ol 'after-string nil)))
- ((< mright rightcol) ;`rightcol' is past EOL.
- (let ((str (rectangle--space-to rightcol)))
- (put-text-property 0 (length str) 'face 'region str)
- ;; If cursor happens to be here, draw it at the right place.
- (rectangle--place-cursor leftcol left 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 (rectangle--space-to rightcol)))
- (put-text-property 0 (length str) 'face 'region str)
- (when (= left right)
- (rectangle--place-cursor leftcol left str))
- (overlay-put ol 'after-string str))))
- ((overlay-get ol 'after-string)
- (overlay-put ol 'after-string nil)))
- (when (and (= leftcol rightcol) (display-graphic-p))
- ;; 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)))
- start end))
+ (let* ((pt (point))
+ (cols (rectangle--pos-cols start end))
+ (startcol (car cols))
+ (endcol (cdr cols))
+ (leftcol (min startcol endcol))
+ (rightcol (max startcol endcol))
+ ;; We don't know what lines will actually be displayed,
+ ;; so add highlight overlays on lines within the window
+ ;; height from point.
+ (height (window-height))
+ (start-pt (max (point-min) start
+ (progn (forward-line (- height)) (point))))
+ (end-pt (min (point-max) end
+ (progn (goto-char pt)
+ (forward-line height)
+ (point)))))
+ (goto-char start-pt)
+ (beginning-of-line)
+ (while
+ (let* ((mleft (move-to-column leftcol))
+ (left (point))
+ ;; BEWARE: In the presence of other overlays with
+ ;; before/after/display-strings, this happens to move to
+ ;; the column "as if the overlays were not applied",
+ ;; which is sometimes what we want, tho it can be
+ ;; considered a bug in move-to-column (it should
+ ;; arguably pay attention to the
+ ;; before/after-string/display properties when computing
+ ;; the column).
+ (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
+ (rectangle--space-to leftcol))
+ (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
+ (rectangle--space-to leftcol)))
+ ((overlay-get ol 'before-string)
+ (overlay-put ol 'before-string nil)))
+ (cond
+ ;; While doing rectangle--string-preview, the two sets of
+ ;; overlays steps on the other's toes. I fixed some of the
+ ;; problems, but others remain. The main one is the two
+ ;; (rectangle--space-to rightcol) below which try to
+ ;; virtually insert missing text, but during "preview", the
+ ;; text is not missing (it's provided by preview's own
+ ;; overlay).
+ (rectangle--string-preview-state
+ (if (overlay-get ol 'after-string)
+ (overlay-put ol 'after-string nil)))
+ ((< mright rightcol) ;`rightcol' is past EOL.
+ (let ((str (rectangle--space-to rightcol)))
+ (put-text-property 0 (length str) 'face 'region str)
+ ;; If cursor happens to be here, draw it at the right
+ ;; place.
+ (rectangle--place-cursor leftcol left str)
+ (overlay-put ol 'after-string str)))
+ ((and (> mright rightcol) ;`rightcol' 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 (rectangle--space-to rightcol)))
+ (put-text-property 0 (length str) 'face 'region str)
+ (when (= left right)
+ (rectangle--place-cursor leftcol left str))
+ (overlay-put ol 'after-string str))))
+ ((overlay-get ol 'after-string)
+ (overlay-put ol 'after-string nil)))
+ (when (and (= leftcol rightcol) (display-graphic-p))
+ ;; 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))
+ (bolp)
+ (<= (point) end-pt))))
+ )
+ )
(mapc #'delete-overlay old)
`(rectangle ,(buffer-chars-modified-tick)
,start ,end ,(rectangle--crutches)
next prev parent reply other threads:[~2024-08-29 10:22 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-08-27 12:39 bug#72830: Big rectangular selections are slow Mattias Engdegård
2024-08-27 13:48 ` Eli Zaretskii
2024-08-27 14:04 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-27 16:42 ` Mattias Engdegård
2024-08-27 17:47 ` Eli Zaretskii
2024-08-27 19:16 ` Eli Zaretskii
2024-08-27 18:23 ` Juri Linkov
2024-08-27 18:55 ` Drew Adams via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-27 19:03 ` Eli Zaretskii
2024-08-27 19:44 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-29 3:56 ` Michael Heerdegen via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-29 10:22 ` Mattias Engdegård [this message]
2024-08-29 11:18 ` Mattias Engdegård
2024-08-29 8:09 ` Mattias Engdegård
2024-08-29 20:04 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-30 15:20 ` Mattias Engdegård
2024-09-20 12:53 ` Mattias Engdegård
2024-08-29 0:45 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-29 3:39 ` Michael Heerdegen via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-29 4:44 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-29 0:40 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=AE14E0AC-FBE5-49FD-8931-D39FAD343EE9@gmail.com \
--to=mattias.engdegard@gmail.com \
--cc=72830@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=juri@linkov.net \
--cc=michael_heerdegen@web.de \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).