changeset 111824:88e55e239ecc

* lisp/replace.el: Add "collect" feature to occur. (occur-collect-regexp-history): New var. (occur-read-primary-args): Return a replace string for nlines, if needed. (occur): Extend the meaning of nlines.

--- a/lisp/ChangeLog	Fri Dec 03 19:49:49 2010 -0500
+++ b/lisp/ChangeLog	Fri Dec 03 20:58:06 2010 -0500
@@ -1,3 +1,10 @@
[phone]  Tak Ota  <[e-mail]>
+
+	* replace.el: Add "collect" feature to occur.
+	(occur-collect-regexp-history): New var.
+	(occur-read-primary-args): Return a replace string for nlines, if needed.
+	(occur): Extend the meaning of nlines.
+
 2010-12-04  Stefan Monnier  <[e-mail]>
 
 	* progmodes/which-func.el (which-func-ff-hook): Log the error message.

--- a/lisp/replace.el	Fri Dec 03 19:49:49 2010 -0500
+++ b/lisp/replace.el	Fri Dec 03 20:58:06 2010 -0500
@@ -532,6 +532,9 @@
 Maximum length of the history list is determined by the value
 of `history-length', which see.")
 
+(defvar occur-collect-regexp-history '("\\1")
+  "History of regexp for occur's collect operation")
+
 (defun read-regexp (prompt &optional default-value)
   "Read regexp as a string using the regexp history and some useful defaults.
 Prompt for a regular expression with PROMPT (without a colon and
@@ -1007,10 +1010,25 @@
   :version "22.1")
 
 (defun occur-read-primary-args ()
-  (list (read-regexp "List lines matching regexp"
-		     (car regexp-history))
-	(when current-prefix-arg
-	  (prefix-numeric-value current-prefix-arg))))
+  (let* ((perform-collect (consp current-prefix-arg))
+         (regexp (read-regexp (if perform-collect
+                                  "Collect strings matching regexp"
+                                "List lines matching regexp")
+                              (car regexp-history))))
+    (list regexp
+	  (if perform-collect
+	      ;; Perform collect operation
+	      (if (zerop (regexp-opt-depth regexp))
+		  ;; No subexpression so collect the entire match.
+		  "\\&"
+		;; Get the regexp for collection pattern.
+		(let ((default (car occur-collect-regexp-history)))
+		  (read-string
+		   (format "Regexp to collect (default %s): " default)
+		   nil 'occur-collect-regexp-history default)))
+	    ;; Otherwise normal occur takes numerical prefix argument.
+	    (when current-prefix-arg
+	      (prefix-numeric-value current-prefix-arg))))))
 
 (defun occur-rename-buffer (&optional unique-p interactive-p)
   "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
@@ -1043,7 +1061,18 @@
 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
 
 If REGEXP contains upper case characters (excluding those preceded by `\\')
-and `search-upper-case' is non-nil, the matching is case-sensitive."
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
+When NLINES is a string or when the function is called
+interactively with prefix argument without a number (`C-u' alone
+as prefix) the matching strings are collected into the `*Occur*'
+buffer by using NLINES as a replacement regexp.  NLINES may
+contain \\& and \\N which convention follows `replace-match'.
+For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and
+\"\\1\" for NLINES collects all the function names in a lisp
+program.  When there is no parenthesized subexpressions in REGEXP
+the entire match is collected.  In any case the searched buffers
+are not modified."
   (interactive (occur-read-primary-args))
   (occur-1 regexp nlines (list (current-buffer))))
 
@@ -1125,20 +1154,43 @@
     (setq occur-buf (get-buffer-create buf-name))
 
     (with-current-buffer occur-buf
-      (occur-mode)
+      (if (stringp nlines)
+	  (fundamental-mode) ;; This is for collect opeartion.
+	(occur-mode))
       (let ((inhibit-read-only t)
 	    ;; Don't generate undo entries for creation of the initial contents.
 	    (buffer-undo-list t))
 	(erase-buffer)
-	(let ((count (occur-engine
-		      regexp active-bufs occur-buf
-		      (or nlines list-matching-lines-default-context-lines)
-		      (if (and case-fold-search search-upper-case)
-			  (isearch-no-upper-case-p regexp t)
-			case-fold-search)
-		      list-matching-lines-buffer-name-face
-		      nil list-matching-lines-face
-		      (not (eq occur-excluded-properties t)))))
+	(let ((count
+	       (if (stringp nlines)
+                   ;; Treat nlines as a regexp to collect.
+		   (let ((bufs active-bufs)
+			 (count 0))
+		     (while bufs
+		       (with-current-buffer (car bufs)
+			 (save-excursion
+			   (goto-char (point-min))
+			   (while (re-search-forward regexp nil t)
+                             ;; Insert the replacement regexp.
+			     (let ((str (match-substitute-replacement nlines)))
+			       (if str
+				   (with-current-buffer occur-buf
+				     (insert str)
+				     (setq count (1+ count))
+				     (or (zerop (current-column))
+					 (insert "\n"))))))))
+                       (setq bufs (cdr bufs)))
+                     count)
+		 ;; Perform normal occur.
+		 (occur-engine
+		  regexp active-bufs occur-buf
+		  (or nlines list-matching-lines-default-context-lines)
+		  (if (and case-fold-search search-upper-case)
+		      (isearch-no-upper-case-p regexp t)
+		    case-fold-search)
+		  list-matching-lines-buffer-name-face
+		  nil list-matching-lines-face
+		  (not (eq occur-excluded-properties t))))))
 	  (let* ((bufcount (length active-bufs))
 		 (diff (- (length bufs) bufcount)))
 	    (message "Searched %d buffer%s%s; %s match%s%s"