Re: collect-string

[Tak Ota <Takaaki.Ota@am.sony.com>]

Fri, 3 Dec 2010 14:56:51 -0800: Stefan Monnier <monnier@IRO.UMontreal.CA> wrote:

> >> > ! 		  '(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)))))
> >> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> >> 
> >> This should be `default', right?
> 
> > No, this is the new input value as read-from-minibuffer prepends this
> > value to the history.
> 
> Oh, right, there's more parens than I thought.  You should use
> `read-string' instead, which will take care of this ugliness.

OK, done.  Indeed its cleaner.

*** ../../../d/pub/emacs/emacs-23.2.90/lisp/replace.el	Thu Dec  2 16:33:19 2010
--- replace.el	Fri Dec  3 15:07:56 2010
***************
*** 527,532 ****
--- 527,535 ----
  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
***************
*** 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*.
--- 1031,1055 ----
        (nreverse result))))
  
  (defun occur-read-primary-args ()
!   (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*.
***************
*** 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))))
  
--- 1082,1099 ----
  \\<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 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))))
  
***************
*** 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'"
--- 1175,1217 ----
      (setq occur-buf (get-buffer-create buf-name))
  
      (with-current-buffer occur-buf
!       (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
! 	       (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 for `%s'"


> >> Hmm... I didn't think of NLINES turning into a list of submatch-numbers,
> >> but that makes me think that maybe we should go one step further and
> >> turn it into a string, like the ones used in replace-match.
> > This is truly brilliant.  Thank you very much.  I love this idea
> > bouncing process.  See below.
> 
> It's not always as successful, sadly.  But yes, it turned out very well
> this time.

As long as people behave rationally with patience and not carried too
much away by own belief it should work fine most of the time.  I'm
glad I haven't been involved in sad cases.

-Tak