all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* Occur multi-line matches
@ 2010-03-23  7:27 Juri Linkov
  2010-03-23  7:42 ` Juri Linkov
                   ` (2 more replies)
  0 siblings, 3 replies; 6+ messages in thread
From: Juri Linkov @ 2010-03-23  7:27 UTC (permalink / raw)
  To: emacs-devel

To reduce the size of etc/TODO, I implemented one of the two
related tasks:

  ** Make occur correctly handle matches that span more than one line,
     as well as overlapping matches.

  ** Make occur handle multi-line matches cleanly with context.

and fixed all problems of multi-line matches discussed
in http://thread.gmane.org/gmane.emacs.devel/38918
with the following patch (I'll try to do the second task
for context lines later):

=== modified file 'lisp/replace.el'
--- lisp/replace.el	2010-03-22 23:02:56 +0000
+++ lisp/replace.el	2010-03-23 07:27:03 +0000
@@ -1045,7 +1045,7 @@ (defun occur-rename-buffer (&optional un
 
 (defun occur (regexp &optional nlines)
   "Show all lines in the current buffer containing a match for REGEXP.
-This function can not handle matches that span more than one line.
+If a match spreads across multiple lines, all those lines are shown.
 
 Each line is displayed with NLINES lines before and after, or -NLINES
 before if NLINES is negative.
@@ -1210,11 +1210,14 @@ (defun occur-engine (regexp buffers out-
 		  (when (setq endpt (re-search-forward regexp nil t))
 		    (setq matches (1+ matches)) ;; increment match count
 		    (setq matchbeg (match-beginning 0))
-		    (setq lines (+ lines (1- (count-lines origpt endpt))))
+		    ;; Get beginning of first match line and end of the last.
 		    (save-excursion
 		      (goto-char matchbeg)
-		      (setq begpt (line-beginning-position)
-			    endpt (line-end-position)))
+		      (setq begpt (line-beginning-position))
+		      (goto-char endpt)
+		      (setq endpt (line-end-position)))
+		    ;; Sum line numbers up to the first match line.
+		    (setq lines (+ lines (count-lines origpt begpt)))
 		    (setq marker (make-marker))
 		    (set-marker marker matchbeg)
 		    (setq curstring (occur-engine-line begpt endpt))
@@ -1234,24 +1237,33 @@ (defun occur-engine (regexp buffers out-
 			 curstring)
 			(setq start (match-end 0))))
 		    ;; Generate the string to insert for this match
-		    (let* ((out-line
+		    (let* ((match-prefix
+			    ;; Using 7 digits aligns tabs properly.
+			    (apply #'propertize (format "%7d:" lines)
+				   (append
+				    (when prefix-face
+				      `(font-lock-face prefix-face))
+				    `(occur-prefix t mouse-face (highlight)
+						   occur-target ,marker follow-link t
+						   help-echo "mouse-2: go to this occurrence"))))
+			   (match-str
+			    ;; We don't put `mouse-face' on the newline,
+			    ;; because that loses.  And don't put it
+			    ;; on context lines to reduce flicker.
+			    (propertize curstring 'mouse-face (list 'highlight)
+					'occur-target marker
+					'follow-link t
+					'help-echo
+					"mouse-2: go to this occurrence"))
+			   (out-line
 			    (concat
-			     ;; Using 7 digits aligns tabs properly.
-			     (apply #'propertize (format "%7d:" lines)
-				    (append
-				     (when prefix-face
-				       `(font-lock-face prefix-face))
-				     `(occur-prefix t mouse-face (highlight)
-				       occur-target ,marker follow-link t
-				       help-echo "mouse-2: go to this occurrence")))
-			     ;; We don't put `mouse-face' on the newline,
-			     ;; because that loses.  And don't put it
-			     ;; on context lines to reduce flicker.
-			     (propertize curstring 'mouse-face (list 'highlight)
-					 'occur-target marker
-					 'follow-link t
-					 'help-echo
-					 "mouse-2: go to this occurrence")
+			     match-prefix
+			     ;; Add non-numeric prefix to all non-first lines
+			     ;; of multi-line matches.
+			     (replace-regexp-in-string
+			      "\n"
+			      "\n       :"
+			      match-str)
 			     ;; Add marker at eol, but no mouse props.
 			     (propertize "\n" 'occur-target marker)))
 			   (data
@@ -1270,7 +1282,11 @@ (defun occur-engine (regexp buffers out-
 		    (goto-char endpt))
 		  (if endpt
 		      (progn
-			(setq lines (1+ lines))
+			;; Sum line numbers between first and last match lines.
+			(setq lines (+ lines (count-lines begpt endpt)
+				       ;; Add 1 for empty last match line since
+				       ;; count-lines returns 1 line less.
+				       (if (and (bolp) (eolp)) 1 0)))
 			;; On to the next match...
 			(forward-line 1))
 		    (goto-char (point-max))))))

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




^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Occur multi-line matches
  2010-03-23  7:27 Occur multi-line matches Juri Linkov
@ 2010-03-23  7:42 ` Juri Linkov
  2010-03-23 13:01   ` Stefan Monnier
  2010-03-23 15:19 ` Richard Stallman
  2010-03-27 19:51 ` Juri Linkov
  2 siblings, 1 reply; 6+ messages in thread
From: Juri Linkov @ 2010-03-23  7:42 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 184 bytes --]

There is a new file occur-testsuite.el for the `test' subdir
to test regressions in occur functionality.  I could port tests
to unit test frameworks when they will be added to Emacs.


[-- Attachment #2: occur-testsuite.el --]
[-- Type: application/emacs-lisp, Size: 3240 bytes --]

[-- Attachment #3: Type: text/plain, Size: 45 bytes --]


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

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Occur multi-line matches
  2010-03-23  7:42 ` Juri Linkov
@ 2010-03-23 13:01   ` Stefan Monnier
  0 siblings, 0 replies; 6+ messages in thread
From: Stefan Monnier @ 2010-03-23 13:01 UTC (permalink / raw)
  To: Juri Linkov; +Cc: emacs-devel

> There is a new file occur-testsuite.el for the `test' subdir
> to test regressions in occur functionality.

Wonderful, please install it in the test subdir,


        Stefan




^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Occur multi-line matches
  2010-03-23  7:27 Occur multi-line matches Juri Linkov
  2010-03-23  7:42 ` Juri Linkov
@ 2010-03-23 15:19 ` Richard Stallman
  2010-03-27 19:51 ` Juri Linkov
  2 siblings, 0 replies; 6+ messages in thread
From: Richard Stallman @ 2010-03-23 15:19 UTC (permalink / raw)
  To: Juri Linkov; +Cc: emacs-devel

Thank you very much for working on TODO tasks.




^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Occur multi-line matches
  2010-03-23  7:27 Occur multi-line matches Juri Linkov
  2010-03-23  7:42 ` Juri Linkov
  2010-03-23 15:19 ` Richard Stallman
@ 2010-03-27 19:51 ` Juri Linkov
  2010-03-30 16:05   ` Juri Linkov
  2 siblings, 1 reply; 6+ messages in thread
From: Juri Linkov @ 2010-03-27 19:51 UTC (permalink / raw)
  To: emacs-devel

> 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)))))
+
 \f
 ;; 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/




^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: Occur multi-line matches
  2010-03-27 19:51 ` Juri Linkov
@ 2010-03-30 16:05   ` Juri Linkov
  0 siblings, 0 replies; 6+ messages in thread
From: Juri Linkov @ 2010-03-30 16:05 UTC (permalink / raw)
  To: emacs-devel

If someone for some reason might want to keep the old behaviour,
then a new option could be added.  This patch gives a hint where
to use such an option to restore the old behaviour:

=== modified file 'lisp/replace.el'
--- lisp/replace.el	2010-03-28 23:16:36 +0000
+++ lisp/replace.el	2010-03-29 16:02:35 +0000
@@ -1379,7 +1379,7 @@ (defun occur-context-lines (out-line nli
       ;; Combine after-lines of the previous match
       ;; with before-lines of the current match.
 
-      (when prev-after-lines
+      (when nil   ;; use some new option
 	;; Don't overlap prev after-lines with current before-lines.
 	(if (>= (+ prev-lines (length prev-after-lines))
 		(- lines      (length before-lines)))
@@ -1390,7 +1390,7 @@ (defun occur-context-lines (out-line nli
 	  ;; Separate non-overlapping context lines with a dashed line.
 	  (setq separator "-------\n")))
 
-      (when prev-lines
+      (when nil   ;; use some new option
 	;; Don't overlap current before-lines with previous match line.
 	(if (<= (- lines (length before-lines))
 		prev-lines)
@@ -1408,7 +1408,7 @@ (defun occur-context-lines (out-line nli
 	      (append
 	       (and prev-after-lines
 		    (occur-engine-add-prefix prev-after-lines))
-	       (and separator (list separator))
+	       (and prev-after-lines (list "-------\n"))
 	       (occur-engine-add-prefix before-lines)
 	       (list out-line)))
        ;; And the second element is the list of context after-lines.

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




^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2010-03-30 16:05 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-03-23  7:27 Occur multi-line matches Juri Linkov
2010-03-23  7:42 ` Juri Linkov
2010-03-23 13:01   ` Stefan Monnier
2010-03-23 15:19 ` Richard Stallman
2010-03-27 19:51 ` Juri Linkov
2010-03-30 16:05   ` Juri Linkov

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.