Re: collect-string (was: simple useful functions)

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

Thu, 4 Nov 2010 06:58:20 -0700: Stefan Monnier <monnier@iro.umontreal.ca> wrote:

> >> How about rename the command as collect-occur instead of
> >> collect-string and document it as next?
> > Wrong namespace.  IMO, the name should *start* with occur (but Stefan
> > and Yidong are final authorities on that).
> 
> Agreed, namespace cleanliness is one of my favorite forms of
> anal retentiveness.
> 
> The way I see it, the suggested collect-string is a variant of occur
> where the result buffer contains none of the regexp matches's context.
> So it would make sense to integrate it very tightly with `occur',
> i.e. make M-x occur do the job of collect-strings for some particular
> value of its argument NLINES.  Currently, NLINES is assumed to be
> a number and all values of that number have a useful meaning, so we'd
> have to add this new feature via a non-number value of NLINES.
> 
> E.g. C-u M-x occur could do the collect-string thingy (which is still an
> incompatible change since some people may like to use C-u M-x occur to get
> 4 lines of context, but you can make omelets without breaking eggs).
> 
> 
>         Stefan
> 

Now I am convinced.  How about the change below?  In conventional
occur zero or negative value for nlines is meaningless correct?  We
can use that for collection purpose.  i.e. C-u 0 M-x occur does the
collection of the matching pattern.  C-u -1 M-x occur performs the
collection of the recorded pattern 1.

-Tak

(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
    (setq buf-name "*Occur*"))
  (let (occur-buf
	(active-bufs (delq nil (mapcar #'(lambda (buf)
					   (when (buffer-live-p buf) buf))
				       bufs))))
    ;; Handle the case where one of the buffers we're searching is the
    ;; output buffer.  Just rename it.
    (when (member buf-name (mapcar 'buffer-name active-bufs))
      (with-current-buffer (get-buffer buf-name)
	(rename-uniquely)))

    ;; Now find or create the output buffer.
    ;; If we just renamed that buffer, we will make a new one here.
    (setq occur-buf (get-buffer-create buf-name))

    (if (or (null (integerp nlines))
	    (> nlines 0))
	;; nlines is not zero or negative so perform nomal occur
	(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)))))
      ;; nlines is zero or negative integer perform collect-string
      (with-current-buffer occur-buf
	(setq nlines (- nlines))
	(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 nlines)))
		    (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)))))