changeset 107556:796294575eaf

Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Tue, 23 Mar 2010 21:50:49 +0000
parents 5298129bb44d (current diff) 6edb016a3cfc (diff)
children f8082cab4d03
files
diffstat 7 files changed, 222 insertions(+), 34 deletions(-) [+]
line wrap: on
line diff
--- a/etc/TODO	Tue Mar 23 07:41:20 2010 +0000
+++ b/etc/TODO	Tue Mar 23 21:50:49 2010 +0000
@@ -105,9 +105,6 @@
 
 ** erase-buffer should perhaps disregard read-only properties of text.
 
-** Make occur correctly handle matches that span more than one line,
-   as well as overlapping matches.
-
 ** Fix the kill/yank treatment of invisible text.  At the moment,
   invisible text is placed in the kill-ring, so that the contents of
   the ring may not correspond to the text as displayed to the user.
--- a/lisp/ChangeLog	Tue Mar 23 07:41:20 2010 +0000
+++ b/lisp/ChangeLog	Tue Mar 23 21:50:49 2010 +0000
@@ -1,3 +1,28 @@
+2010-03-23  Sam Steingold  <sds@gnu.org>
+
+	Fix bug#5620: recalculate all markers on compilation buffer
+	modifications, not on file modifications.
+	* progmodes/compile.el (buffer-modtime): New buffer-local variable:
+	the buffer modification time, for buffers not associated with files.
+	(compilation-mode): Create it.
+	(compilation-filter): Update it.
+	(compilation-next-error-function): Use it instead of
+	`visited-file-modtime' for timestamp.
+
+2010-03-23  Juri Linkov  <juri@jurta.org>
+
+	Implement Occur multi-line matches.
+	http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01044.html
+
+	* replace.el (occur): Doc fix.
+	(occur-engine): Set `begpt' to the beginning of the first line.
+	Set `endpt' to the end of the last match line.  At first, count
+	line numbers between `origpt' and `begpt'.  Split out code from
+	`out-line' variable to new let-bindings `match-prefix' and
+	`match-str'.  In `out-line' add non-numeric prefix to all
+	non-first lines of multi-line matches.  Finally, count lines
+	between `begpt' and `endpt' and add to `lines'.
+
 2010-03-23  Juri Linkov  <juri@jurta.org>
 
 	* replace.el (occur-accumulate-lines, occur-engine):
@@ -5,6 +30,9 @@
 	(occur-engine-line): New function created from duplicate code
 	in `occur-accumulate-lines' and `occur-engine'.
 
+	* replace.el (occur-engine-line): Add optional arg `keep-props'.
+	(occur-accumulate-lines, occur-engine): Add arg `keep-props'.
+
 2010-03-23  Juri Linkov  <juri@jurta.org>
 
 	* finder.el: Remove TODO tasks.
--- a/lisp/midnight.el	Tue Mar 23 07:41:20 2010 +0000
+++ b/lisp/midnight.el	Tue Mar 23 21:50:49 2010 +0000
@@ -3,8 +3,8 @@
 ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005,
 ;;   2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
-;; Author: Sam Steingold <sds@usa.net>
-;; Maintainer: Sam Steingold <sds@usa.net>
+;; Author: Sam Steingold <sds@gnu.org>
+;; Maintainer: Sam Steingold <sds@gnu.org>
 ;; Created: 1998-05-18
 ;; Keywords: utilities
 
@@ -205,7 +205,7 @@
 
 (defun midnight-next ()
   "Return the number of seconds till the next midnight."
-  (multiple-value-bind (sec min hrs) 
+  (multiple-value-bind (sec min hrs)
       (values-list (decode-time))
     (- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec)))
 
--- a/lisp/progmodes/compile.el	Tue Mar 23 07:41:20 2010 +0000
+++ b/lisp/progmodes/compile.el	Tue Mar 23 21:50:49 2010 +0000
@@ -733,6 +733,9 @@
   "If non-nil, automatically jump to the next error encountered.")
 (make-variable-buffer-local 'compilation-auto-jump-to-next)
 
+(defvar buffer-modtime nil
+  "The buffer modification time, for buffers not associated with files.")
+(make-variable-buffer-local 'buffer-modtime)
 
 (defvar compilation-skip-to-next-location t
   "*If non-nil, skip multiple error messages for the same source location.")
@@ -1566,6 +1569,7 @@
 	mode-name (or name-of-mode "Compilation"))
   (set (make-local-variable 'page-delimiter)
        compilation-page-delimiter)
+  (set (make-local-variable 'buffer-modtime) nil)
   (compilation-setup)
   (setq buffer-read-only t)
   (run-mode-hooks 'compilation-mode-hook))
@@ -1781,6 +1785,7 @@
               (unless comint-inhibit-carriage-motion
                 (comint-carriage-motion (process-mark proc) (point)))
               (set-marker (process-mark proc) (point))
+              (set (make-local-variable buffer-modtime) (current-time))
               (run-hooks 'compilation-filter-hook))
 	  (goto-char pos)
           (narrow-to-region min max)
@@ -1954,9 +1959,7 @@
                  ;; There may be no timestamp info if the loc is a `fake-loc',
                  ;; but we just checked that the file has been visited before!
                  (equal (nth 4 loc)
-                        (setq timestamp
-                              (with-current-buffer (marker-buffer (nth 3 loc))
-                                (visited-file-modtime)))))
+                        (setq timestamp buffer-modtime)))
       (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
 						  (cadr (car (nth 2 loc))))
 	(save-restriction
--- a/lisp/replace.el	Tue Mar 23 07:41:20 2010 +0000
+++ b/lisp/replace.el	Tue Mar 23 21:50:49 2010 +0000
@@ -1016,7 +1016,7 @@
 	(setq count (+ count (if forwardp -1 1)))
 	(setq beg (line-beginning-position)
 	      end (line-end-position))
-	(push (occur-engine-line beg end) result)
+	(push (occur-engine-line beg end keep-props) result)
 	(forward-line (if forwardp 1 -1)))
       (nreverse result))))
 
@@ -1045,7 +1045,7 @@
 
 (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,14 +1210,17 @@
 		  (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))
+		    (setq curstring (occur-engine-line begpt endpt keep-props))
 		    ;; Highlight the matches
 		    (let ((len (length curstring))
 			  (start 0))
@@ -1234,24 +1237,33 @@
 			 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 @@
 		    (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))))))
@@ -1314,7 +1330,7 @@
       ;; Return the number of matches
       globalcount)))
 
-(defun occur-engine-line (beg end)
+(defun occur-engine-line (beg end &optional keep-props)
   (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
 	   (text-property-not-all beg end 'fontified t))
       (if (fboundp 'jit-lock-fontify-now)
--- a/test/ChangeLog	Tue Mar 23 07:41:20 2010 +0000
+++ b/test/ChangeLog	Tue Mar 23 21:50:49 2010 +0000
@@ -1,3 +1,7 @@
+2010-03-23  Juri Linkov  <juri@jurta.org>
+
+	* occur-testsuite.el: New file.
+
 2010-03-10  Chong Yidong  <cyd@stupidchicken.com>
 
 	* Branch for 23.2.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/occur-testsuite.el	Tue Mar 23 21:50:49 2010 +0000
@@ -0,0 +1,140 @@
+;;; occur-testsuite.el --- Test suite for occur.
+
+;; Copyright (C) 2010  Free Software Foundation, Inc.
+
+;; Author: Juri Linkov <juri@jurta.org>
+;; Keywords: matching, internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Type M-x test-occur RET to test the functionality of `occur'.
+
+;;; Code:
+
+(defconst occur-tests
+  '(
+    ;; * Test one-line matches (at bob, eob, bol, eol).
+    ("x" 0 "\
+xa
+b
+cx
+xd
+xex
+fx
+" "\
+5 matches for \"x\" in buffer:  *temp*
+      1:xa
+      3:cx
+      4:xd
+      5:xex
+      6:fx
+")
+    ;; * Test multi-line matches, this is the first test from
+    ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
+    ;; where numbers are replaced with letters.
+    ("a\na" 0 "\
+a
+a
+a
+a
+a
+" "\
+2 matches for \"a^Ja\" in buffer:  *temp*
+      1:a
+       :a
+      3:a
+       :a
+")
+    ;; * Test multi-line matches, this is the second test from
+    ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
+    ;; where numbers are replaced with letters.
+    ("a\nb" 0 "\
+a
+b
+c
+a
+b
+" "\
+2 matches for \"a^Jb\" in buffer:  *temp*
+      1:a
+       :b
+      4:a
+       :b
+")
+    ;; * Test line numbers for multi-line matches with empty last match line.
+    ("a\n" 0 "\
+a
+
+c
+a
+
+" "\
+2 matches for \"a^J\" in buffer:  *temp*
+      1:a
+       :
+      4:a
+       :
+")
+    ;; * Test multi-line matches with 3 match lines.
+    ("x\n.x\n" 0 "\
+ax
+bx
+c
+d
+ex
+fx
+" "\
+2 matches for \"x^J.x^J\" in buffer:  *temp*
+      1:ax
+       :bx
+       :c
+      5:ex
+       :fx
+       :
+")
+    )
+  "List of tests for `occur'.
+Each element has the format:
+\(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).")
+
+(defun test-occur ()
+  (interactive)
+  (let ((count 1)
+        failed
+        (occur-hook nil))
+    (dolist (test occur-tests)
+      (let ((regexp (nth 0 test))
+            (nlines (nth 1 test))
+            (input-buffer-string (nth 2 test))
+            (output-buffer-string (nth 3 test)))
+        (save-excursion
+          (with-temp-buffer
+            (insert input-buffer-string)
+            (occur regexp nlines)
+            (unless (equal output-buffer-string
+                           (with-current-buffer "*Occur*"
+                             (buffer-string)))
+              (setq failed (cons count failed))))))
+      (setq count (1+ count)))
+    (if failed
+        (message "FAILED TESTS: %S" (reverse failed))
+      (message "SUCCESS"))))
+
+(provide 'occur-testsuite)
+
+;;; occur-testsuite.el ends here