Re: Occur multi-line matches

[Juri Linkov]

> I'll try to do the second task for context lines later.

This is the second task implemented.  I hope a unit test framework
will be added to Emacs soon, so tests could be rewritten for the
test framework.

=== modified file 'etc/TODO'
--- etc/TODO    2010-03-23 16:09:45 +0000
+++ etc/TODO    2010-03-27 19:48:33 +0000
@@ -128,8 +128,6 @@
 
 ** 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?
 
=== modified file 'lisp/replace.el'
--- lisp/replace.el     2010-03-23 19:00:11 +0000
+++ lisp/replace.el     2010-03-27 19:48:35 +0000
@@ -1005,8 +1005,10 @@ (defcustom occur-excluded-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,6 +1191,8 @@ (defun occur-engine (regexp buffers out-
        (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)
@@ -1271,14 +1275,17 @@ (defun occur-engine (regexp buffers out-
                                ;; The simple display style
                                out-line
                              ;; The complex multi-line display style.
-                             (occur-context-lines out-line nlines keep-props)
+                             (setq prev-after-lines
+                                   (occur-context-lines
+                                    out-line nlines keep-props begpt endpt
+                                    lines prev-lines prev-after-lines))
+                             (prog1 (nth 0 prev-after-lines)
+                               (setq prev-after-lines (nth 1 
prev-after-lines)))
                              )))
                      ;; 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 +1296,12 @@ (defun occur-engine (regexp buffers out-
                                       (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 (and (> nlines 0) prev-after-lines)
+                 (with-current-buffer out-buf
+                   (insert (occur-context-lines nil nil nil nil nil nil nil 
prev-after-lines))))))
            (when (not (zerop matches)) ;; is the count zero?
              (setq globalcount (+ globalcount matches))
              (with-current-buffer out-buf
@@ -1352,18 +1364,63 @@ (defun occur-engine-context-lines (lines
 ;; 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
+(defun occur-context-lines (out-line nlines keep-props begpt endpt
+                           lines prev-lines prev-after-lines)
+  (if (null out-line)
+      ;; Flush remaining context after-lines.
+      (apply #'concat (occur-engine-add-prefix prev-after-lines))
+    ;; Otherwise, find after- and before-context lines.
+    (let ((before-lines
           (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)))))))
+                          (- (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.

=== modified file 'test/occur-testsuite.el'
--- test/occur-testsuite.el     2010-03-23 17:04:49 +0000
+++ test/occur-testsuite.el     2010-03-27 19:44:16 +0000
@@ -107,30 +107,74 @@ (defconst occur-tests
        :fx
        :
 ")
-    ;; * Test overlapping context lines.
-    ("x" 2 "\
+    ;; * Test non-overlapping context lines with matches at bob/eob.
+    ("x" 1 "\
 ax
 b
-cx
+c
 d
 ex
+f
+g
+hx
 " "\
 3 matches for \"x\" in buffer:  *temp*
       1:ax
        :b
-       :cx
 -------
-       :b
-      3:cx
        :d
-       :ex
+      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
 -------
-       :cx
        :d
       5:ex
--------
+       :f
 ")
-    ;; * Test non-overlapping context lines.
+    ;; * 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
@@ -138,22 +182,139 @@ (defconst occur-tests
 d
 e
 f
-g
+gx
 h
-ix
+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 negative non-overlapping 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 negative overlapping 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).")

-- 
Juri Linkov
http://www.jurta.org/emacs/