Luj/eat-emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Avoid copying STR to the extent possible

Browse source 
* eat.el (eat--t-write): Take two more optional arguments BEG
and END to avoid copying STR multiple times unneccessarily.
This commit is contained in:
Akib Azmain Turja 2022-11-28 20:50:58 +06:00
parent 9d14bbeaa5
commit bc4bd45fa6
No known key found for this signature in database
GPG key ID: 5535FCF54D88616B
1 changed files with 126 additions and 120 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

246
eat.el
View file

@ -2409,131 +2409,137 @@ character or its the internal invisible spaces."
The key is the output character from client, and value of the The key is the output character from client, and value of the
character to actually show.") character to actually show.")
(defun eat--t-write (str) (defun eat--t-write (str &optional beg end)
"Write STR on display." "Write STR from BEG to END on display."
(let ((face (eat--t-face-face (eat--t-term-face eat--t-term))) (setq beg (or beg 0))
;; Alist of indices and width of multi-column characters. (setq end (or end (length str)))
(multi-col-char-indices nil) (let* ((disp (eat--t-term-display eat--t-term))
(inserted-till 0)) (cursor (eat--t-disp-cursor disp))
;; Copy STR and add face to it. (scroll-end (eat--t-term-scroll-end eat--t-term))
(setq str (propertize str 'face face)) (charset
;; Convert STR to Unicode according to the current character (alist-get (car (eat--t-term-charset eat--t-term))
;; set. (cdr (eat--t-term-charset eat--t-term))))
(pcase-exhaustive (face (eat--t-face-face (eat--t-term-face eat--t-term)))
(alist-get (car (eat--t-term-charset eat--t-term)) ;; Alist of indices and width of multi-column characters.
(cdr (eat--t-term-charset eat--t-term))) (multi-col-char-indices nil)
;; For `us-ascii', the default, no conversion is (inserted-till beg))
;; necessary. (cl-assert charset)
('us-ascii
str)
;; `dec-line-drawing' contains various characters useful
;; for drawing line diagram, so it is a must. This is
;; also possible with `us-ascii', thanks to Unicode, but
;; the character set `dec-line-drawing' is usually less
;; expensive in terms of bytes needed to transfer than
;; `us-ascii'.
('dec-line-drawing
(dotimes (i (length str))
(let ((replacement
(gethash (aref str i) eat--t-dec-line-drawing-chars)))
(when replacement
(aset str i replacement))))))
;; Find all the multi-column wide characters in ST; hopefully it ;; Find all the multi-column wide characters in ST; hopefully it
;; won't slow down showing plain ASCII. ;; won't slow down showing plain ASCII.
(setq multi-col-char-indices (setq multi-col-char-indices
(cl-loop for i from 0 to (1- (length str)) (cl-loop for i from beg to (1- end)
when (/= (char-width (aref str i)) 1) when (/= (char-width (aref str i)) 1)
collect (cons i (char-width (aref str i))))) collect (cons i (char-width (aref str i)))))
;; If the position isn't safe, replace the multi-column
;; character with spaces to make it safe.
(eat--t-make-pos-safe)
;; TODO: Comment. ;; TODO: Comment.
;; REVIEW: This probably needs to be updated. ;; REVIEW: This probably needs to be updated.
(let* ((disp (eat--t-term-display eat--t-term)) (while (< inserted-till end)
(cursor (eat--t-disp-cursor disp)) ;; Insert STR, and record the width of STR inserted
(scroll-end (eat--t-term-scroll-end eat--t-term))) ;; successfully.
;; If the position isn't safe, replace the multi-column (let ((ins-count
;; character with spaces to make it safe. (named-let write
(eat--t-make-pos-safe) ((max (min (- (eat--t-disp-width disp)
(while (< inserted-till (length str)) (1- (eat--t-cur-x cursor)))
;; Insert STR, and record the width of STR inserted (+ (- end inserted-till)
;; successfully. (cl-loop
(let ((ins-count for p in multi-col-char-indices
(named-let write sum (1- (cdr p))))))
((max (written 0))
(min (- (eat--t-disp-width disp) (let* ((next-multi-col (car multi-col-char-indices))
(1- (eat--t-cur-x cursor))) (end (+ inserted-till max))
(apply #'+ (- (length str) inserted-till) (e (if next-multi-col
(mapcar (lambda (p) (1- (cdr p))) ;; Exclude the multi-column character.
multi-col-char-indices)))) (min (car next-multi-col) end)
(written 0)) end))
(let* ((next-multi-col (car multi-col-char-indices)) (wrote (- e inserted-till)))
(end (+ inserted-till max)) (cl-assert (>= wrote 0))
(e (if next-multi-col (let ((s (substring str inserted-till e)))
;; Exclude the multi-column character. ;; Convert STR to Unicode according to the
(min (car next-multi-col) end) ;; current character set.
end)) (pcase-exhaustive charset
(wrote (- e inserted-till))) ;; For `us-ascii', the default, no conversion
(cl-assert (>= wrote 0)) ;; is necessary.
(insert (substring str inserted-till e)) ('us-ascii)
(setq inserted-till e) ;; `dec-line-drawing' contains various
(if (or (null next-multi-col) ;; characters useful for drawing line diagram,
(< (- end e) (cdr next-multi-col))) ;; so it is a must. This is also possible
;; Either everything is done, or we reached ;; with `us-ascii', thanks to Unicode, but the
;; the limit. ;; character set `dec-line-drawing' is usually
(+ written wrote) ;; less expensive in terms of bytes needed to
;; There are many characters which are too narrow ;; transfer than `us-ascii'.
;; for `char-width' to return 1. XTerm, Kitty ('dec-line-drawing
;; and St seems to ignore them, so we too. (dotimes (i (length s))
(if (zerop (cdr next-multi-col)) (when-let*
(cl-incf inserted-till) ((r (gethash
(insert (aref s i)
;; Make sure the multi-column character eat--t-dec-line-drawing-chars)))
;; occupies the same number of characters as (aset s i r)))))
;; its width. ;; Add face.
(propertize (put-text-property 0 (length s) 'face face s)
(make-string (1- (cdr next-multi-col)) ?\s) (insert s))
'invisible t 'face face (setq inserted-till e)
'eat--t-invisible-space t (if (or (null next-multi-col)
'eat--t-char-width (cdr next-multi-col)) (< (- end e) (cdr next-multi-col)))
;; Now insert the multi-column character. ;; Either everything is done, or we reached
(propertize ;; the limit.
(substring str inserted-till (+ written wrote)
(cl-incf inserted-till)) ;; There are many characters which are too
'face face ;; narrow for `char-width' to return 1. XTerm,
'eat--t-char-width (cdr next-multi-col)))) ;; Kitty and St seems to ignore them, so we too.
(setf multi-col-char-indices (if (zerop (cdr next-multi-col))
(cdr multi-col-char-indices)) (cl-incf inserted-till)
(write (- max wrote (cdr next-multi-col)) (insert
(+ written wrote ;; Make sure the multi-column character
(cdr next-multi-col)))))))) ;; occupies the same number of characters as
(cl-incf (eat--t-cur-x cursor) ins-count) ;; its width.
(if (eat--t-term-ins-mode eat--t-term) (propertize
(delete-region (make-string (1- (cdr next-multi-col)) ?\s)
(save-excursion 'invisible t 'face face
(eat--t-col-motion (- (eat--t-disp-width disp) 'eat--t-invisible-space t
(1- (eat--t-cur-x cursor)))) 'eat--t-char-width (cdr next-multi-col))
;; Make sure the point is safe. ;; Now insert the multi-column character.
(eat--t-move-before-to-safe) (propertize
(point)) (substring str inserted-till
(car (eat--t-eol))) (cl-incf inserted-till))
(delete-region (point) (min (+ ins-count (point)) 'face face
(car (eat--t-eol)))) 'eat--t-char-width (cdr next-multi-col))))
;; Replace any partially-overwritten character with (setf multi-col-char-indices
;; spaces. (cdr multi-col-char-indices))
(eat--t-fix-partial-multi-col-char)) (write (- max wrote (cdr next-multi-col))
(when (> (eat--t-cur-x cursor) (eat--t-disp-width disp)) (+ written wrote
(if (not (eat--t-term-auto-margin eat--t-term)) (cdr next-multi-col))))))))
(eat--t-cur-left 1) (cl-incf (eat--t-cur-x cursor) ins-count)
(when (< inserted-till (length str)) (if (eat--t-term-ins-mode eat--t-term)
(when (= (eat--t-cur-y cursor) scroll-end) (delete-region
(eat--t-scroll-up 1 'as-side-effect)) (save-excursion
(if (= (eat--t-cur-y cursor) scroll-end) (eat--t-col-motion (- (eat--t-disp-width disp)
(eat--t-carriage-return) (1- (eat--t-cur-x cursor))))
(if (= (point) (point-max)) ;; Make sure the point is safe.
(insert #("\n" 0 1 (eat--t-wrap-line t))) (eat--t-move-before-to-safe)
(put-text-property (point) (1+ (point)) (point))
'eat--t-wrap-line t) (car (eat--t-eol)))
(forward-char)) (delete-region (point) (min (+ ins-count (point))
(1value (setf (eat--t-cur-x cursor) 1)) (car (eat--t-eol))))
(cl-incf (eat--t-cur-y cursor))))))))))) ;; Replace any partially-overwritten character with
;; spaces.
(eat--t-fix-partial-multi-col-char))
(when (> (eat--t-cur-x cursor) (eat--t-disp-width disp))
(if (not (eat--t-term-auto-margin eat--t-term))
(eat--t-cur-left 1)
(when (< inserted-till end)
(when (= (eat--t-cur-y cursor) scroll-end)
(eat--t-scroll-up 1 'as-side-effect))
(if (= (eat--t-cur-y cursor) scroll-end)
(eat--t-carriage-return)
(if (= (point) (point-max))
(insert #("\n" 0 1 (eat--t-wrap-line t)))
(put-text-property (point) (1+ (point))
'eat--t-wrap-line t)
(forward-char))
(1value (setf (eat--t-cur-x cursor) 1))
(cl-incf (eat--t-cur-y cursor))))))))))
(defun eat--t-horizontal-tab (&optional n) (defun eat--t-horizontal-tab (&optional n)
"Go to the Nth next tabulation stop. "Go to the Nth next tabulation stop.
@ -3667,13 +3673,13 @@ DATA is the selection data encoded in base64."
;; The regex didn't match, so everything left to handle ;; The regex didn't match, so everything left to handle
;; is just plain text. ;; is just plain text.
(progn (progn
(eat--t-write (substring output index)) (eat--t-write output index)
(setq index (length output))) (setq index (length output)))
(when (/= match index) (when (/= match index)
;; The regex matched, and the position is after the ;; The regex matched, and the position is after the
;; current position. Process the plain text between ;; current position. Process the plain text between
;; them and advance to the control sequence. ;; them and advance to the control sequence.
(eat--t-write (substring output index match)) (eat--t-write output index match)
(setq index match)) (setq index match))
;; Dispatch control sequence. ;; Dispatch control sequence.
(cl-incf index) (cl-incf index)