From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.devel Subject: Re: Occur multi-line matches Date: Sat, 27 Mar 2010 21:51:31 +0200 Organization: JURTA Message-ID: <87k4sxfsqk.fsf@mail.jurta.org> References: <87fx3rmrie.fsf@mail.jurta.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: dough.gmane.org 1269720542 32617 80.91.229.12 (27 Mar 2010 20:09:02 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 27 Mar 2010 20:09:02 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Mar 27 21:08:57 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1NvcJV-000715-3C for ged-emacs-devel@m.gmane.org; Sat, 27 Mar 2010 21:08:57 +0100 Original-Received: from localhost ([127.0.0.1]:37324 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NvcJU-0006KZ-DN for ged-emacs-devel@m.gmane.org; Sat, 27 Mar 2010 16:08:56 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1NvcHg-0005SQ-Sk for emacs-devel@gnu.org; Sat, 27 Mar 2010 16:07:04 -0400 Original-Received: from [140.186.70.92] (port=57257 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NvcHd-0005Pd-0o for emacs-devel@gnu.org; Sat, 27 Mar 2010 16:07:03 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1NvcHZ-0007Ie-9a for emacs-devel@gnu.org; Sat, 27 Mar 2010 16:07:00 -0400 Original-Received: from smtp-out2.starman.ee ([85.253.0.4]:50981 helo=mx2.starman.ee) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1NvcHY-0007IB-Lv for emacs-devel@gnu.org; Sat, 27 Mar 2010 16:06:57 -0400 X-Virus-Scanned: by Amavisd-New at mx2.starman.ee Original-Received: from mail.starman.ee (82.131.30.101.cable.starman.ee [82.131.30.101]) by mx2.starman.ee (Postfix) with ESMTP id 41B173F40C0 for ; Sat, 27 Mar 2010 22:06:50 +0200 (EET) In-Reply-To: <87fx3rmrie.fsf@mail.jurta.org> (Juri Linkov's message of "Tue, 23 Mar 2010 09:27:33 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (x86_64-pc-linux-gnu) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:122771 Archived-At: > 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/