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 13:18:01 +0200 [thread overview]
Message-ID: <41AF14A6-33A9-4EAB-ACBF-34079135AE8F@gmail.com> (raw)
In-Reply-To: <AE14E0AC-FBE5-49FD-8931-D39FAD343EE9@gmail.com>
[-- Attachment #1: Type: text/plain, Size: 429 bytes --]
29 aug. 2024 kl. 12.22 skrev Mattias Engdegård <mattias.engdegard@gmail.com>:
> The patch below is crude but seems to work.
That phrase is highly effective for forcing bugs into daylight. Here is an improved version.
Previously, `exchange-point-and-mark` didn't regenerate the overlays because it wasn't necessary, but now it is, so we save point in our rectangle overlay tuple. (Should use a struct at this point.)
[-- Attachment #2: rect-highlight.diff --]
[-- Type: application/octet-stream, Size: 11525 bytes --]
diff --git a/lisp/rect.el b/lisp/rect.el
index 93007824679..5d68a6bafab 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -857,102 +857,131 @@ rectangle--highlight-for-redisplay
(eq (nth 1 rol) (buffer-chars-modified-tick))
(eq start (nth 2 rol))
(eq end (nth 3 rol))
- (equal (rectangle--crutches) (nth 4 rol)))
+ (equal (rectangle--crutches) (nth 4 rol))
+ (eq (nth 5 rol) (point)))
rol)
(t
(save-excursion
- (let* ((nrol nil)
+ (let* ((pt (point))
+ (nrol nil)
(old (if (eq 'rectangle (car-safe rol))
- (nthcdr 5 rol)
+ (nthcdr 6 rol)
(funcall redisplay-unhighlight-region-function rol)
nil)))
(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* ((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 start (progn (forward-line (- height))
+ (point))))
+ (end-pt (min end (progn (goto-char pt)
+ (forward-line height)
+ (point)))))
+ ;; (printf
+ ;; "pt %S (%S) height %S start %S end %S start-pt %S end-pt %S\n"
+ ;; pt (point) height start end start-pt end-pt)
+ (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)
+ ,start ,end ,(rectangle--crutches) ,pt
,@nrol))))))
(defun rectangle--unhighlight-for-redisplay (orig rol)
(if (not (eq 'rectangle (car-safe rol)))
(funcall orig rol)
- (mapc #'delete-overlay (nthcdr 5 rol))
+ (mapc #'delete-overlay (nthcdr 6 rol))
(setcar (cdr rol) nil)))
(defun rectangle--duplicate-right (n displacement)
next prev parent reply other threads:[~2024-08-29 11:18 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
2024-08-29 11:18 ` Mattias Engdegård [this message]
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=41AF14A6-33A9-4EAB-ACBF-34079135AE8F@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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.