User: adrian Date: 05/02/23 23:09:16 Modified: xemacs/lisp ChangeLog replace.el Log: [PATCH] xemacs-21.5-clean: Avoid prohibitive string consing and GC <r7j8tbas.fsf(a)smtprelay.t-online.de&gt; Revision Changes Path 1.645 +7 -0 XEmacs/xemacs/lisp/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v retrieving revision 1.644 retrieving revision 1.645 diff -u -r1.644 -r1.645 --- ChangeLog 2005/02/22 23:38:49 1.644 +++ ChangeLog 2005/02/23 22:09:13 1.645 ＠＠ -1,3 +1,10 ＠＠ +2005-02-20 Adrian Aichner <adrian(a)xemacs.org&gt; + + * replace.el (operate-on-non-matching-lines): Append matching + lines to temp buffer to avoid prohibitive GC as a result of + enormous string consing. + * replace.el (operate-on-matching-lines): Ditto. + 2005-02-21 Ben Wing <ben(a)xemacs.org&gt; * glyphs.el: 1.11 +24 -20 XEmacs/xemacs/lisp/replace.el Index: replace.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/replace.el,v retrieving revision 1.10 retrieving revision 1.11 diff -u -r1.10 -r1.11 --- replace.el 2003/05/12 05:12:10 1.10 +++ replace.el 2005/02/23 22:09:15 1.11 ＠＠ -247,7 +247,9 ＠＠ (let ((matched-text nil) (curmatch-start (point)) - (limit (copy-marker (point-max)))) + (limit (copy-marker (point-max))) + (matched-text-buffer (generate-new-buffer " *matched-text*")) + lines-matched) ;; Limit search if limits were specified. (when end (setq limit (copy-marker end))) ＠＠ -259,32 +261,33 ＠＠ ;; curmatch-start is first char not preserved by previous match. (if (not (re-search-forward regexp limit 'move)) (let ((curmatch-end limit)) - (setq matched-text (concat matched-text (buffer-substring curmatch-start curmatch-end))) + (append-to-buffer matched-text-buffer curmatch-start curmatch-end) (if delete (delete-region curmatch-start curmatch-end))) (let ((curmatch-end (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line) - (point)))) + (beginning-of-line) + (point)))) ;; Now curmatch-end is first char preserved by the new match. (if (< curmatch-start curmatch-end) (progn - (setq matched-text (concat matched-text (buffer-substring curmatch-start curmatch-end))) + (append-to-buffer matched-text-buffer curmatch-start curmatch-end) (if delete (delete-region curmatch-start curmatch-end)))))) (setq curmatch-start (save-excursion (forward-line 1) - (point))) + (point))) ;; If the match was empty, avoid matching again at same place. (and (not (eobp)) (= (match-beginning 0) (match-end 0)) (forward-char 1))) ;; If any lines were matched and KILL is non-nil, insert the ;; matched lines into the kill ring. + (setq matched-text (buffer-string matched-text-buffer)) (if (and matched-text kill) (kill-new matched-text)) ;; Return the number of matched lines. - (with-temp-buffer - ;; Use concat to make a string even if matched-text is nil. - (insert (concat matched-text)) - (count-lines (point-min) (point-max))) - )))) + (setq lines-matched + (with-current-buffer matched-text-buffer + (count-lines (point-min) (point-max)))) + (kill-buffer matched-text-buffer) + lines-matched)))) (define-function 'keep-lines 'delete-non-matching-lines) (defun delete-non-matching-lines (regexp) ＠＠ -358,8 +361,9 ＠＠ (let ((matched-text nil) (curmatch-start nil) (curmatch-end nil) - (limit nil)) - + (limit nil) + (matched-text-buffer (generate-new-buffer " *matched-text*")) + lines-matched) ;; Limit search if limits were specified. (when beg (goto-char beg)) (when end (setq limit (copy-marker end))) ＠＠ -370,17 +374,17 ＠＠ (beginning-of-line) (point))) (setq curmatch-end (progn (forward-line 1) (point))) - (setq matched-text (concat matched-text (buffer-substring curmatch-start curmatch-end))) + (append-to-buffer matched-text-buffer curmatch-start curmatch-end) (if delete (delete-region curmatch-start curmatch-end))) - + (setq matched-text (buffer-string matched-text-buffer)) (if (and matched-text kill) (kill-new matched-text)) ;; Return the number of matched lines. - (with-temp-buffer - ;; Use concat to make a string even if matched-text is nil. - (insert (concat matched-text)) - (count-lines (point-min) (point-max))) - )))) + (setq lines-matched + (with-current-buffer matched-text-buffer + (count-lines (point-min) (point-max)))) + (kill-buffer matched-text-buffer) + lines-matched)))) (define-function 'flush-lines 'delete-matching-lines) (defun delete-matching-lines (regexp)