(xref--collect-matches-1): Remove some intermediate allocations

* lisp/progmodes/xref.el: (xref--collect-matches-1):
Rewrite to remove some intermediate allocations.
Modest performance improvement.
This commit is contained in:
Dmitry Gutov 2021-10-08 18:25:55 +03:00
parent 1c7d056f4d
commit 59782839cb

View file

@ -1878,34 +1878,36 @@ Such as the current syntax table and the applied syntax properties."
syntax-needed))))) syntax-needed)))))
(defun xref--collect-matches-1 (regexp file line line-beg line-end syntax-needed) (defun xref--collect-matches-1 (regexp file line line-beg line-end syntax-needed)
(let (match-pairs matches) (let (matches
stop beg end
last-beg last-end
summary-end)
(when syntax-needed (when syntax-needed
(syntax-propertize line-end)) (syntax-propertize line-end))
(while (and (while (not stop)
;; REGEXP might match an empty string. Or line. (if (and
(or (null match-pairs) ;; REGEXP might match an empty string. Or line.
(> (point) line-beg)) (not (and last-beg (eql end line-beg)))
(re-search-forward regexp line-end t)) (re-search-forward regexp line-end t))
(push (cons (match-beginning 0) (setq beg (match-beginning 0)
(match-end 0)) end (match-end 0)
match-pairs)) summary-end beg)
(setq match-pairs (nreverse match-pairs)) (setq stop t
(while match-pairs summary-end line-end))
(let* ((beg-end (pop match-pairs)) (when last-beg
(beg-column (- (car beg-end) line-beg)) (let* ((beg-column (- last-beg line-beg))
(end-column (- (cdr beg-end) line-beg)) (end-column (- last-end line-beg))
(loc (xref-make-file-location file line beg-column)) (summary-start (if matches last-beg line-beg))
(summary (buffer-substring (if matches (car beg-end) line-beg) (summary (buffer-substring summary-start
(if match-pairs summary-end))
(caar match-pairs) (loc (xref-make-file-location file line beg-column)))
line-end)))) (add-face-text-property (- last-beg summary-start)
(when matches (- last-end summary-start)
(cl-decf beg-column (- (car beg-end) line-beg)) 'xref-match t summary)
(cl-decf end-column (- (car beg-end) line-beg))) (push (xref-make-match summary loc (- end-column beg-column))
(add-face-text-property beg-column end-column 'xref-match matches)))
t summary) (setq last-beg beg
(push (xref-make-match summary loc (- end-column beg-column)) last-end end))
matches)))
(nreverse matches))) (nreverse matches)))
(defun xref--find-file-buffer (file) (defun xref--find-file-buffer (file)