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

100
eat.el
View file

@ -2409,60 +2409,43 @@ 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))
(setq end (or end (length str)))
(let* ((disp (eat--t-term-display eat--t-term))
(cursor (eat--t-disp-cursor disp))
(scroll-end (eat--t-term-scroll-end eat--t-term))
(charset
(alist-get (car (eat--t-term-charset eat--t-term))
(cdr (eat--t-term-charset eat--t-term))))
(face (eat--t-face-face (eat--t-term-face eat--t-term)))
;; Alist of indices and width of multi-column characters. ;; Alist of indices and width of multi-column characters.
(multi-col-char-indices nil) (multi-col-char-indices nil)
(inserted-till 0)) (inserted-till beg))
;; Copy STR and add face to it. (cl-assert charset)
(setq str (propertize str 'face face))
;; Convert STR to Unicode according to the current character
;; set.
(pcase-exhaustive
(alist-get (car (eat--t-term-charset eat--t-term))
(cdr (eat--t-term-charset eat--t-term)))
;; For `us-ascii', the default, no conversion is
;; necessary.
('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)))))
;; TODO: Comment.
;; REVIEW: This probably needs to be updated.
(let* ((disp (eat--t-term-display eat--t-term))
(cursor (eat--t-disp-cursor disp))
(scroll-end (eat--t-term-scroll-end eat--t-term)))
;; If the position isn't safe, replace the multi-column ;; If the position isn't safe, replace the multi-column
;; character with spaces to make it safe. ;; character with spaces to make it safe.
(eat--t-make-pos-safe) (eat--t-make-pos-safe)
(while (< inserted-till (length str)) ;; TODO: Comment.
;; REVIEW: This probably needs to be updated.
(while (< inserted-till end)
;; Insert STR, and record the width of STR inserted ;; Insert STR, and record the width of STR inserted
;; successfully. ;; successfully.
(let ((ins-count (let ((ins-count
(named-let write (named-let write
((max ((max (min (- (eat--t-disp-width disp)
(min (- (eat--t-disp-width disp)
(1- (eat--t-cur-x cursor))) (1- (eat--t-cur-x cursor)))
(apply #'+ (- (length str) inserted-till) (+ (- end inserted-till)
(mapcar (lambda (p) (1- (cdr p))) (cl-loop
multi-col-char-indices)))) for p in multi-col-char-indices
sum (1- (cdr p))))))
(written 0)) (written 0))
(let* ((next-multi-col (car multi-col-char-indices)) (let* ((next-multi-col (car multi-col-char-indices))
(end (+ inserted-till max)) (end (+ inserted-till max))
@ -2472,16 +2455,39 @@ character to actually show.")
end)) end))
(wrote (- e inserted-till))) (wrote (- e inserted-till)))
(cl-assert (>= wrote 0)) (cl-assert (>= wrote 0))
(insert (substring str inserted-till e)) (let ((s (substring str inserted-till e)))
;; Convert STR to Unicode according to the
;; current character set.
(pcase-exhaustive charset
;; For `us-ascii', the default, no conversion
;; is necessary.
('us-ascii)
;; `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 s))
(when-let*
((r (gethash
(aref s i)
eat--t-dec-line-drawing-chars)))
(aset s i r)))))
;; Add face.
(put-text-property 0 (length s) 'face face s)
(insert s))
(setq inserted-till e) (setq inserted-till e)
(if (or (null next-multi-col) (if (or (null next-multi-col)
(< (- end e) (cdr next-multi-col))) (< (- end e) (cdr next-multi-col)))
;; Either everything is done, or we reached ;; Either everything is done, or we reached
;; the limit. ;; the limit.
(+ written wrote) (+ written wrote)
;; There are many characters which are too narrow ;; There are many characters which are too
;; for `char-width' to return 1. XTerm, Kitty ;; narrow for `char-width' to return 1. XTerm,
;; and St seems to ignore them, so we too. ;; Kitty and St seems to ignore them, so we too.
(if (zerop (cdr next-multi-col)) (if (zerop (cdr next-multi-col))
(cl-incf inserted-till) (cl-incf inserted-till)
(insert (insert
@ -2522,7 +2528,7 @@ character to actually show.")
(when (> (eat--t-cur-x cursor) (eat--t-disp-width disp)) (when (> (eat--t-cur-x cursor) (eat--t-disp-width disp))
(if (not (eat--t-term-auto-margin eat--t-term)) (if (not (eat--t-term-auto-margin eat--t-term))
(eat--t-cur-left 1) (eat--t-cur-left 1)
(when (< inserted-till (length str)) (when (< inserted-till end)
(when (= (eat--t-cur-y cursor) scroll-end) (when (= (eat--t-cur-y cursor) scroll-end)
(eat--t-scroll-up 1 'as-side-effect)) (eat--t-scroll-up 1 'as-side-effect))
(if (= (eat--t-cur-y cursor) scroll-end) (if (= (eat--t-cur-y cursor) scroll-end)
@ -2533,7 +2539,7 @@ character to actually show.")
'eat--t-wrap-line t) 'eat--t-wrap-line t)
(forward-char)) (forward-char))
(1value (setf (eat--t-cur-x cursor) 1)) (1value (setf (eat--t-cur-x cursor) 1))
(cl-incf (eat--t-cur-y cursor))))))))))) (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)