From dc2d2590b24f7e4ee648b5d073ba744fbda7a4d8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 30 Mar 2010 19:03:08 +0300 Subject: [PATCH] Make occur handle multi-line matches cleanly with context. http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01280.html * replace.el (occur-accumulate-lines): Add optional arg `pt'. (occur-engine): Add local variables `ret', `prev-after-lines', `prev-lines'. Use more arguments for `occur-context-lines'. Set first elem of its returned list to `data', and the second elem to `prev-after-lines'. Don't print the separator line. In the end, print remaining context after-lines. (occur-context-lines): Add new arguments `begpt', `endpt', `lines', `prev-lines', `prev-after-lines'. Rewrite to combine after-lines of the previous match with before-lines of the current match and not overlap them. Return a list with two values: the output line and the list of context after-lines. * search.texi (Other Repeating Search): Remove line that `occur' can not handle multiline matches. * occur-testsuite.el (occur-tests): Add tests for context lines. --- doc/emacs/ChangeLog | 5 + doc/emacs/search.texi | 3 +- etc/TODO | 2 - lisp/ChangeLog | 17 ++++ lisp/replace.el | 90 +++++++++++++---- test/ChangeLog | 4 + test/occur-testsuite.el | 209 +++++++++++++++++++++++++++++++++++++++- 7 files changed, 308 insertions(+), 22 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index e23f129a16..b13b3ac1ee 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2010-03-30 Juri Linkov + + * search.texi (Other Repeating Search): Remove line that `occur' + can not handle multiline matches. + 2010-03-30 Eli Zaretskii * mule.texi (International): Mention support of bidirectional editing. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 8c49a3fa69..890dd48df9 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1311,8 +1311,7 @@ Prompt for a regexp, and display a list showing each line in the buffer that contains a match for it. To limit the search to part of the buffer, narrow to that part (@pxref{Narrowing}). A numeric argument @var{n} specifies that @var{n} lines of context are to be -displayed before and after each matching line. Currently, -@code{occur} can not correctly handle multiline matches. +displayed before and after each matching line. @kindex RET @r{(Occur mode)} @kindex o @r{(Occur mode)} diff --git a/etc/TODO b/etc/TODO index 6ce2947bd9..f21d105b2c 100644 --- a/etc/TODO +++ b/etc/TODO @@ -128,8 +128,6 @@ for users to customize. ** Enhance scroll-bar to handle tall line (similar to line-move). -** Make occur handle multi-line matches cleanly with context. - ** In Custom buffers, put the option that turns a mode on or off first, using a heuristic of some kind? diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6ef607e802..d3c5610972 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2010-03-30 Juri Linkov + + Make occur handle multi-line matches cleanly with context. + http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01280.html + + * replace.el (occur-accumulate-lines): Add optional arg `pt'. + (occur-engine): Add local variables `ret', `prev-after-lines', + `prev-lines'. Use more arguments for `occur-context-lines'. + Set first elem of its returned list to `data', and the second elem + to `prev-after-lines'. Don't print the separator line. + In the end, print remaining context after-lines. + (occur-context-lines): Add new arguments `begpt', `endpt', + `lines', `prev-lines', `prev-after-lines'. Rewrite to combine + after-lines of the previous match with before-lines of the + current match and not overlap them. Return a list with two + values: the output line and the list of context after-lines. + 2010-03-30 Juri Linkov * replace.el (occur-accumulate-lines): Fix a bug where the first diff --git a/lisp/replace.el b/lisp/replace.el index a74da4b89b..14a1869b4f 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1005,8 +1005,10 @@ which means to discard all text properties." :group 'matching :version "22.1") -(defun occur-accumulate-lines (count &optional keep-props) +(defun occur-accumulate-lines (count &optional keep-props pt) (save-excursion + (when pt + (goto-char pt)) (let ((forwardp (> count 0)) result beg end moved) (while (not (or (zerop count) @@ -1189,12 +1191,15 @@ See also `multi-occur'." (when (buffer-live-p buf) (let ((matches 0) ;; count of matched lines (lines 1) ;; line count + (prev-after-lines nil) ;; context lines of prev match + (prev-lines nil) ;; line number of prev match endpt (matchbeg 0) (origpt nil) (begpt nil) (endpt nil) (marker nil) (curstring "") + (ret nil) (inhibit-field-text-motion t) (headerpt (with-current-buffer out-buf (point)))) (with-current-buffer buf @@ -1271,14 +1276,17 @@ See also `multi-occur'." ;; The simple display style out-line ;; The complex multi-line display style. - (occur-context-lines out-line nlines keep-props) - ))) + (setq ret (occur-context-lines + out-line nlines keep-props begpt endpt + lines prev-lines prev-after-lines)) + ;; Set first elem of the returned list to `data', + ;; and the second elem to `prev-after-lines'. + (setq prev-after-lines (nth 1 ret)) + (nth 0 ret)))) ;; Actually insert the match display data (with-current-buffer out-buf (let ((beg (point)) - (end (progn (insert data) (point)))) - (unless (= nlines 0) - (insert "-------\n"))))) + (end (progn (insert data) (point))))))) (goto-char endpt)) (if endpt (progn @@ -1289,7 +1297,13 @@ See also `multi-occur'." (if (and (bolp) (eolp)) 1 0))) ;; On to the next match... (forward-line 1)) - (goto-char (point-max)))))) + (goto-char (point-max))) + (setq prev-lines (1- lines))) + ;; Flush remaining context after-lines. + (when prev-after-lines + (with-current-buffer out-buf + (insert (apply #'concat (occur-engine-add-prefix + prev-after-lines))))))) (when (not (zerop matches)) ;; is the count zero? (setq globalcount (+ globalcount matches)) (with-current-buffer out-buf @@ -1345,18 +1359,60 @@ See also `multi-occur'." ;; Generate context display for occur. ;; OUT-LINE is the line where the match is. ;; NLINES and KEEP-PROPS are args to occur-engine. +;; LINES is line count of the current match, +;; PREV-LINES is line count of the previous match, +;; PREV-AFTER-LINES is a list of after-context lines of the previous match. ;; Generate a list of lines, add prefixes to all but OUT-LINE, ;; then concatenate them all together. -(defun occur-context-lines (out-line nlines keep-props) - (apply #'concat - (nconc - (occur-engine-add-prefix - (nreverse (cdr (occur-accumulate-lines - (- (1+ (abs nlines))) keep-props)))) - (list out-line) - (if (> nlines 0) - (occur-engine-add-prefix - (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))) +(defun occur-context-lines (out-line nlines keep-props begpt endpt + lines prev-lines prev-after-lines) + ;; Find after- and before-context lines of the current match. + (let ((before-lines + (nreverse (cdr (occur-accumulate-lines + (- (1+ (abs nlines))) keep-props begpt)))) + (after-lines + (cdr (occur-accumulate-lines + (1+ nlines) keep-props endpt))) + separator) + + ;; Combine after-lines of the previous match + ;; with before-lines of the current match. + + (when prev-after-lines + ;; Don't overlap prev after-lines with current before-lines. + (if (>= (+ prev-lines (length prev-after-lines)) + (- lines (length before-lines))) + (setq prev-after-lines + (butlast prev-after-lines + (- (length prev-after-lines) + (- lines prev-lines (length before-lines) 1)))) + ;; Separate non-overlapping context lines with a dashed line. + (setq separator "-------\n"))) + + (when prev-lines + ;; Don't overlap current before-lines with previous match line. + (if (<= (- lines (length before-lines)) + prev-lines) + (setq before-lines + (nthcdr (- (length before-lines) + (- lines prev-lines 1)) + before-lines)) + ;; Separate non-overlapping before-context lines. + (unless (> nlines 0) + (setq separator "-------\n")))) + + (list + ;; Return a list where the first element is the output line. + (apply #'concat + (append + (and prev-after-lines + (occur-engine-add-prefix prev-after-lines)) + (and separator (list separator)) + (occur-engine-add-prefix before-lines) + (list out-line))) + ;; And the second element is the list of context after-lines. + (if (> nlines 0) after-lines)))) + ;; It would be nice to use \\[...], but there is no reasonable way ;; to make that display both SPC and Y. diff --git a/test/ChangeLog b/test/ChangeLog index ee69172241..87847a43ad 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2010-03-30 Juri Linkov + + * occur-testsuite.el (occur-tests): Add tests for context lines. + 2010-03-23 Juri Linkov * occur-testsuite.el: New file. diff --git a/test/occur-testsuite.el b/test/occur-testsuite.el index d817805dd6..a4756c49e2 100644 --- a/test/occur-testsuite.el +++ b/test/occur-testsuite.el @@ -107,7 +107,214 @@ fx :fx : ") - ) + ;; * Test non-overlapping context lines with matches at bob/eob. + ("x" 1 "\ +ax +b +c +d +ex +f +g +hx +" "\ +3 matches for \"x\" in buffer: *temp* + 1:ax + :b +------- + :d + 5:ex + :f +------- + :g + 8:hx +") + ;; * Test non-overlapping context lines with matches not at bob/eob. + ("x" 1 "\ +a +bx +c +d +ex +f +" "\ +2 matches for \"x\" in buffer: *temp* + :a + 2:bx + :c +------- + :d + 5:ex + :f +") + ;; * Test overlapping context lines with matches at bob/eob. + ("x" 2 "\ +ax +bx +c +dx +e +f +gx +h +i +j +kx +" "\ +5 matches for \"x\" in buffer: *temp* + 1:ax + 2:bx + :c + 4:dx + :e + :f + 7:gx + :h + :i + :j + 11:kx +") + ;; * Test overlapping context lines with matches not at bob/eob. + ("x" 2 "\ +a +b +cx +d +e +f +gx +h +i +" "\ +2 matches for \"x\" in buffer: *temp* + :a + :b + 3:cx + :d + :e + :f + 7:gx + :h + :i +") + ;; * Test overlapping context lines with empty first and last line.. + ("x" 2 "\ + +b +cx +d +e +f +gx +h + +" "\ +2 matches for \"x\" in buffer: *temp* + : + :b + 3:cx + :d + :e + :f + 7:gx + :h + : +") + ;; * Test multi-line overlapping context lines. + ("x\n.x" 2 "\ +ax +bx +c +d +ex +fx +g +h +i +jx +kx +" "\ +3 matches for \"x^J.x\" in buffer: *temp* + 1:ax + :bx + :c + :d + 5:ex + :fx + :g + :h + :i + 10:jx + :kx +") + ;; * Test multi-line non-overlapping context lines. + ("x\n.x" 2 "\ +ax +bx +c +d +e +f +gx +hx +" "\ +2 matches for \"x^J.x\" in buffer: *temp* + 1:ax + :bx + :c + :d +------- + :e + :f + 7:gx + :hx +") + ;; * Test non-overlapping negative (before-context) lines. + ("x" -2 "\ +a +bx +c +d +e +fx +g +h +ix +" "\ +3 matches for \"x\" in buffer: *temp* + :a + 2:bx +------- + :d + :e + 6:fx +------- + :g + :h + 9:ix +") + ;; * Test overlapping negative (before-context) lines. + ("x" -3 "\ +a +bx +c +dx +e +f +gx +h +" "\ +3 matches for \"x\" in buffer: *temp* + :a + 2:bx + :c + 4:dx + :e + :f + 7:gx +") + +) "List of tests for `occur'. Each element has the format: \(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).") -- 2.20.1