Re: collect-string

[Tak Ota]

Mon, 8 Nov 2010 10:36:08 -0800: Stefan Monnier <address@hidden> wrote:

> > Now I am convinced.  How about the change below?
> 
> Could you send it as a context patch?


How about this?

-Tak


*** replace.el.orig     Tue Nov  9 11:41:08 2010
--- replace.el  Tue Nov  9 18:09:30 2010
***************
*** 527,532 ****
--- 527,535 ----
  Maximum length of the history list is determined by the value
  of `history-length', which see.")
  
+ (defvar last-collect-number 0
+   "The last parenthesized expression number.")
+ 
  (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
***************
*** 1031,1037 ****
    (list (read-regexp "List lines matching regexp"
                     (car regexp-history))
        (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*.
--- 1034,1044 ----
    (list (read-regexp "List lines matching regexp"
                     (car regexp-history))
        (when current-prefix-arg
!         (prefix-numeric-value current-prefix-arg))
!       (and current-prefix-arg
!            (listp current-prefix-arg)
!            (setq last-collect-number
!                  (read-number "Collect" last-collect-number)))))
  
  (defun occur-rename-buffer (&optional unique-p interactive-p)
    "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
***************
*** 1050,1056 ****
                             "*")
                     (or unique-p (not interactive-p)))))
  
! (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.
  
--- 1057,1063 ----
                             "*")
                     (or unique-p (not interactive-p)))))
  
! (defun occur (regexp &optional nlines collect)
    "Show all lines in the current buffer containing a match for REGEXP.
  This function can not handle matches that span more than one line.
  
***************
*** 1064,1074 ****
  \\<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."
    (interactive (occur-read-primary-args))
!   (occur-1 regexp nlines (list (current-buffer))))
  
! (defun multi-occur (bufs regexp &optional nlines)
    "Show all lines in buffers BUFS containing a match for REGEXP.
  This function acts on multiple buffers; otherwise, it is exactly like
  `occur'.  When you invoke this command interactively, you must specify
--- 1071,1087 ----
  \\<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.
! 
! When prefix argument is provided without a number (`C-u' alone as
! prefix) the matching strings are collected into the `*Occur*'
! buffer.  When COLLECT is zero the entire matched strings are
! collected otherwise COLLECTth pair of parenthesized match in the
! REGEXP is collected."
    (interactive (occur-read-primary-args))
!   (occur-1 regexp nlines (list (current-buffer)) nil collect))
  
! (defun multi-occur (bufs regexp &optional nlines collect)
    "Show all lines in buffers BUFS containing a match for REGEXP.
  This function acts on multiple buffers; otherwise, it is exactly like
  `occur'.  When you invoke this command interactively, you must specify
***************
*** 1090,1098 ****
        (setq ido-ignore-item-temp-list bufs))
        (nreverse (mapcar #'get-buffer bufs)))
      (occur-read-primary-args)))
!   (occur-1 regexp nlines bufs))
  
! (defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs)
    "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
  Normally BUFREGEXP matches against each buffer's visited file name,
  but if you specify a prefix argument, it matches against the buffer name.
--- 1103,1111 ----
        (setq ido-ignore-item-temp-list bufs))
        (nreverse (mapcar #'get-buffer bufs)))
      (occur-read-primary-args)))
!   (occur-1 regexp nlines bufs nil collect))
  
! (defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs 
collect)
    "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
  Normally BUFREGEXP matches against each buffer's visited file name,
  but if you specify a prefix argument, it matches against the buffer name.
***************
*** 1124,1132 ****
                                          (string-match bufregexp
                                                        (buffer-file-name 
buf))))
                               buf))
!                          (buffer-list))))))
  
! (defun occur-1 (regexp nlines bufs &optional buf-name)
    (unless (and regexp (not (equal regexp "")))
      (error "Occur doesn't work with the empty regexp"))
    (unless buf-name
--- 1137,1146 ----
                                          (string-match bufregexp
                                                        (buffer-file-name 
buf))))
                               buf))
!                          (buffer-list)))
!            nil collect)))
  
! (defun occur-1 (regexp nlines bufs &optional buf-name collect)
    (unless (and regexp (not (equal regexp "")))
      (error "Occur doesn't work with the empty regexp"))
    (unless buf-name
***************
*** 1145,1181 ****
      ;; If we just renamed that buffer, we will make a new one here.
      (setq occur-buf (get-buffer-create buf-name))
  
!     (with-current-buffer occur-buf
!       (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* ((bufcount (length active-bufs))
!                (diff (- (length bufs) bufcount)))
!           (message "Searched %d buffer%s%s; %s match%s for `%s'"
!                    bufcount (if (= bufcount 1) "" "s")
!                    (if (zerop diff) "" (format " (%d killed)" diff))
!                    (if (zerop count) "no" (format "%d" count))
!                    (if (= count 1) "" "es")
!                    regexp))
!         (setq occur-revert-arguments (list regexp nlines bufs))
!           (if (= count 0)
!               (kill-buffer occur-buf)
!             (display-buffer occur-buf)
!             (setq next-error-last-buffer occur-buf)
!             (setq buffer-read-only t)
!             (set-buffer-modified-p nil)
!             (run-hooks 'occur-hook)))))))
  
  (defun occur-engine-add-prefix (lines)
    (mapcar
--- 1159,1214 ----
      ;; If we just renamed that buffer, we will make a new one here.
      (setq occur-buf (get-buffer-create buf-name))
  
!     (if collect
!       (with-current-buffer occur-buf
!         (fundamental-mode)
!         (let ((inhibit-read-only t)
!               (buffer-undo-list t))
!           (erase-buffer)
!           (while active-bufs
!             (with-current-buffer (car active-bufs)
!               (save-excursion
!                 (goto-char (point-min))
!                 (while (re-search-forward regexp nil t)
!                   (let ((str (match-string collect)))
!                     (if str
!                         (with-current-buffer occur-buf
!                           (insert str)
!                           (or (zerop (current-column))
!                               (insert "\n"))))))))
!             (setq active-bufs (cdr active-bufs))))
!         (display-buffer occur-buf))
!       (with-current-buffer occur-buf
!       (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* ((bufcount (length active-bufs))
!                  (diff (- (length bufs) bufcount)))
!             (message "Searched %d buffer%s%s; %s match%s for `%s'"
!                      bufcount (if (= bufcount 1) "" "s")
!                      (if (zerop diff) "" (format " (%d killed)" diff))
!                      (if (zerop count) "no" (format "%d" count))
!                      (if (= count 1) "" "es")
!                      regexp))
!           (setq occur-revert-arguments (list regexp nlines bufs))
!           (if (= count 0)
!               (kill-buffer occur-buf)
!             (display-buffer occur-buf)
!             (setq next-error-last-buffer occur-buf)
!             (setq buffer-read-only t)
!             (set-buffer-modified-p nil)
!             (run-hooks 'occur-hook))))))))
  
  (defun occur-engine-add-prefix (lines)
    (mapcar