Function: occur-1

occur-1 is a byte-compiled function defined in replace.el.gz.

Signature

(occur-1 REGEXP NLINES BUFS &optional BUF-NAME)

Source Code

;; Defined in /usr/src/emacs/lisp/replace.el.gz
(defun occur-1 (regexp nlines bufs &optional buf-name)
  ;; BUFS is a list of buffer-or-overlay!
  (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 (boo)
			       (when (or (buffer-live-p boo)
                                         (and (overlayp boo)
                                              (overlay-buffer boo)))
                                 boo))
                           bufs)))
        (source-buffer-default-directory default-directory))
    ;; Handle the case where one of the buffers we're searching is the
    ;; output buffer.  Just rename it.
    (when (member buf-name
                  ;; FIXME: Use cl-exists.
                  (mapcar
                   (lambda (boo)
                     (buffer-name (if (overlayp boo) (overlay-buffer boo) boo)))
                   active-bufs))
      (with-current-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))

    (with-current-buffer occur-buf
      ;; Make the default-directory of the *Occur* buffer match that of
      ;; the buffer where the occurrences come from
      (setq default-directory source-buffer-default-directory)
      (setq overlay-arrow-position nil)
      (if (stringp nlines)
	  (fundamental-mode) ;; This is for collect operation.
	(occur-mode))
      (let ((inhibit-read-only t)
	    ;; Don't generate undo entries for creation of the initial contents.
	    (buffer-undo-list t)
	    (occur--final-pos nil))
	(erase-buffer)
	(let ((count
	       (if (stringp nlines)
                   ;; Treat nlines as a regexp to collect.
		   (let ((count 0))
		     (dolist (boo active-bufs)
		       (with-current-buffer
                           (if (overlayp boo) (overlay-buffer boo) boo)
			 (save-excursion
			   (goto-char
                            (if (overlayp boo) (overlay-start boo) (point-min)))
                           (let ((end (if (overlayp boo) (overlay-end boo))))
			     (while (re-search-forward regexp end 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"))))))))))
                     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
		  (if (face-differs-from-default-p list-matching-lines-prefix-face)
		      list-matching-lines-prefix-face)
		  list-matching-lines-face
		  (not (eq occur-excluded-properties t))))))
	  (let* ((bufcount (length active-bufs))
		 (diff (- (length bufs) bufcount)))
	    (message "Searched %d %s%s; %s %s%s"
		     bufcount
		     (ngettext "buffer" "buffers" bufcount)
		     (if (zerop diff) "" (format " (%d killed)" diff))
		     (if (zerop count) "no" (format "%d" count))
		     (ngettext "match" "matches" count)
		     ;; Don't display regexp if with remaining text
		     ;; it is longer than window-width.
		     (if (> (+ (length (or (get-text-property 0 'isearch-string regexp)
					   regexp))
			       42)
			    (window-width))
			 "" (occur-regexp-descr regexp))))
          (unless (eq bufs (nth 2 occur-revert-arguments))
            (occur--garbage-collect-revert-args))
	  (setq occur-revert-arguments (list regexp nlines bufs))
          (if (= count 0)
              (kill-buffer occur-buf)
            (display-buffer occur-buf)
            (when occur--final-pos
              (set-window-point
               (get-buffer-window occur-buf 'all-frames)
               occur--final-pos))
            (setq next-error-last-buffer occur-buf)
            (setq buffer-read-only t)
            (set-buffer-modified-p nil)
            (run-hooks 'occur-hook)))))))