[Emacs-diffs] /srv/bzr/emacs/trunk r99776: Make occur handle multi-line matches cleanly with context.

[Juri Linkov]

------------------------------------------------------------
revno: 99776
committer: Juri Linkov <address@hidden>
branch nick: trunk
timestamp: Tue 2010-03-30 19:03:08 +0300
message:
  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.
modified:
  doc/emacs/ChangeLog
  doc/emacs/search.texi
  etc/TODO
  lisp/ChangeLog
  lisp/replace.el
  test/ChangeLog
  test/occur-testsuite.el

=== modified file 'doc/emacs/ChangeLog'
--- a/doc/emacs/ChangeLog       2010-03-30 09:13:07 +0000
+++ b/doc/emacs/ChangeLog       2010-03-30 16:03:08 +0000
@@ -1,3 +1,8 @@
+2010-03-30  Juri Linkov  <address@hidden>
+
+       * search.texi (Other Repeating Search): Remove line that `occur'
+       can not handle multiline matches.
+
 2010-03-30  Eli Zaretskii  <address@hidden>
 
        * mule.texi (International): Mention support of bidirectional editing.

=== modified file 'doc/emacs/search.texi'
--- a/doc/emacs/search.texi     2010-03-21 18:32:19 +0000
+++ b/doc/emacs/search.texi     2010-03-30 16:03:08 +0000
@@ -1311,8 +1311,7 @@
 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,
address@hidden can not correctly handle multiline matches.
+displayed before and after each matching line.
 
 @kindex RET @r{(Occur mode)}
 @kindex o @r{(Occur mode)}

=== modified file 'etc/TODO'
--- a/etc/TODO  2010-03-23 16:09:45 +0000
+++ b/etc/TODO  2010-03-30 16:03:08 +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/ChangeLog'
--- a/lisp/ChangeLog    2010-03-30 15:44:50 +0000
+++ b/lisp/ChangeLog    2010-03-30 16:03:08 +0000
@@ -1,5 +1,22 @@
 2010-03-30  Juri Linkov  <address@hidden>
 
+       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  <address@hidden>
+
        * replace.el (occur-accumulate-lines): Fix a bug where the first
        context line at the beginning of the buffer was missing.
 

=== modified file 'lisp/replace.el'
--- a/lisp/replace.el   2010-03-30 15:44:50 +0000
+++ b/lisp/replace.el   2010-03-30 16:03:08 +0000
@@ -1005,8 +1005,10 @@
   :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 @@
        (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 @@
                                ;; 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 @@
                                       (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 @@
 ;; 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.

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2010-03-23 16:18:52 +0000
+++ b/test/ChangeLog    2010-03-30 16:03:08 +0000
@@ -1,3 +1,7 @@
+2010-03-30  Juri Linkov  <address@hidden>
+
+       * occur-testsuite.el (occur-tests): Add tests for context lines.
+
 2010-03-23  Juri Linkov  <address@hidden>
 
        * occur-testsuite.el: New file.

=== modified file 'test/occur-testsuite.el'
--- a/test/occur-testsuite.el   2010-03-23 16:18:52 +0000
+++ b/test/occur-testsuite.el   2010-03-30 16:03:08 +0000
@@ -107,7 +107,214 @@
        :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).")