* 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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).