* 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.

2 files changed, 74 insertions, 15 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 141881a17a4..187a36a5f5d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2010-12-04  Tak Ota  <Takaaki.Ota@am.sony.com>
+
+        * 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  <monnier@iro.umontreal.ca>
 
         * progmodes/which-func.el (which-func-ff-hook): Log the error message.
diff --git a/lisp/replace.el b/lisp/replace.el
index baea2820433..28f3a845c2a 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -532,6 +532,9 @@ which will run faster and will not set the mark or print anything."
 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 @@ which means to discard all text properties."
   :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 @@ It serves as a menu to find any of the occurrences in this buffer.
 \\<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 @@ See also `multi-occur'."
     (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"