Re: collect-string

[Tak Ota]

Thanks Stefan.

Thu, 2 Dec 2010 06:16:16 -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?
> 
> IIUC the new arg `collect' overrides `lines' in the sense that when
> collect is non-nil lines is simply unused.  So I suggest to just use
> a single argument instead (`lines') and simply give additional semantics
> to values that weren't supported until now.
> E.g. if (numberp lines) then do as before, but if (consp lines) then
> only keep the actual match, where (car lines) could specify which
> submatch to keep.

Very good point.  It made the change much cleaner.

> 
> >     (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)))))
> 
> I recommend you first check (with regexp-opt-depth) whether there is
> a submatch, and if not, don't `read-number'.  It's likely to be a very
> common case.

Another excellent suggestion.

> 
> > !     (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))))))))
> 
> The "if collect" test should probably not be placed so far out: the
> `collect' case should output the same message, run the same hooks, etc
> as the non-collect case.

How about this?  See below.

-Tak

*** ../../../d/pub/emacs/emacs-23.2.90/lisp/replace.el  Thu Dec  2 16:33:19 2010
--- replace.el  Thu Dec  2 17:00:42 2010
***************
*** 527,532 ****
--- 527,536 ----
  Maximum length of the history list is determined by the value
  of `history-length', which see.")
  
+ (defvar occur-collect-submatch-history '("1")
+   "The history of list of parenthesized expression numbers as a
+   string in 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
***************
*** 1028,1037 ****
        (nreverse result))))
  
  (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))))
  
  (defun occur-rename-buffer (&optional unique-p interactive-p)
    "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
--- 1032,1058 ----
        (nreverse result))))
  
  (defun occur-read-primary-args ()
!   (let ((regexp)
!       (do-collect (consp current-prefix-arg)))
!     (list (setq regexp
!               (read-regexp (if do-collect
!                                "Collect strings matching regexp"
!                              "List lines matching regexp")
!                            (car regexp-history)))
!         (if do-collect
!             (if (zerop (regexp-opt-depth regexp))
!                 ;; no subexpression so collect entire the match
!                 '(0)
!               ;; construct a list of subexpression integers
!               (mapcar 'string-to-number
!                       (split-string
!                        (let ((default (car occur-collect-submatch-history)))
!                          (read-from-minibuffer
!                           (format "Subexpressions to collect (default %s): " 
default)
!                           "" nil nil 'occur-collect-submatch-history default)
!                          (car occur-collect-submatch-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*.
***************
*** 1064,1070 ****
  \\<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))))
  
--- 1085,1101 ----
  \\<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 NLINES is a list of integers 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.  The parenthesized match strings in REGEXP indicated by
! the integers in NLINES are collected.  For example, providing
! \"defun \\(\\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."
    (interactive (occur-read-primary-args))
    (occur-1 regexp nlines (list (current-buffer))))
  
***************
*** 1146,1165 ****
      (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'"
--- 1177,1226 ----
      (setq occur-buf (get-buffer-create buf-name))
  
      (with-current-buffer occur-buf
!       (if (consp nlines)
!         (fundamental-mode) ;; 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
!              (if (consp nlines)
!                    ;; nlines is a list of subexpression integers 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 mached subexpressions in a line
!                            (let ((first-subexp t))
!                              (mapc
!                               (lambda (subexp)
!                                 (let ((str (match-string subexp)))
!                                   (if str
!                                       (with-current-buffer occur-buf
!                                         (if first-subexp
!                                             (setq first-subexp nil)
!                                           (insert " ")) ;; delimiter
!                                         (insert str)))))
!                               nlines)
!                              (setq count (1+ count)))
!                            (with-current-buffer occur-buf
!                              (or (zerop (current-column))
!                                  (insert "\n"))))))
!                        (setq bufs (cdr bufs)))
!                      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'"