Function: occur-engine
occur-engine is a byte-compiled function defined in replace.el.gz.
Signature
(occur-engine REGEXP BUFFERS OUT-BUF NLINES CASE-FOLD TITLE-FACE PREFIX-FACE MATCH-FACE KEEP-PROPS)
Source Code
;; Defined in /usr/src/emacs/lisp/replace.el.gz
(defun occur-engine (regexp buffers out-buf nlines case-fold
title-face prefix-face match-face keep-props)
;; BUFFERS is a list of buffer-or-overlay!
(with-current-buffer out-buf
(let ((global-lines 0) ;; total count of matching lines
(global-matches 0) ;; total count of matches
(coding nil)
(case-fold-search case-fold)
(multi-occur-p (cdr buffers)))
;; Map over all the buffers
(dolist (boo buffers)
(when (if (overlayp boo) (overlay-buffer boo) (buffer-live-p boo))
(with-current-buffer (if (overlayp boo) (overlay-buffer boo) boo)
(let ((inhibit-field-text-motion t)
(lines 0) ; count of matching lines
(matches 0) ; count of matches
(headerpt (with-current-buffer out-buf (point)))
(orig-line (if (not (overlayp boo))
(line-number-at-pos)
(line-number-at-pos
(overlay-get boo 'occur--orig-point)))))
(save-excursion
;; begin searching in the buffer
(goto-char (if (overlayp boo) (overlay-start boo) (point-min)))
(forward-line 0)
(let* ((limit (if (overlayp boo) (overlay-end boo) (point-max)))
(start-line (line-number-at-pos))
(curr-line start-line) ; line count
(orig-line-shown-p)
(prev-line nil) ; line number of prev match endpt
(prev-after-lines nil) ; context lines of prev match
(matchbeg 0)
(origpt nil)
(begpt nil)
(endpt nil)
markers ; list of (BEG-MARKER . END-MARKER)
(curstring "")
(ret nil)
;; The following binding is for when case-fold-search
;; has a local binding in the original buffer, in which
;; case we cannot bind it globally and let that have
;; effect in every buffer we search.
(case-fold-search case-fold))
(or coding
;; Set CODING only if the current buffer locally
;; binds buffer-file-coding-system.
(not (local-variable-p 'buffer-file-coding-system))
(setq coding buffer-file-coding-system))
(while (< (point) limit)
(setq origpt (point))
(when (setq endpt (re-search-forward regexp limit t))
(setq lines (1+ lines)) ;; increment matching lines count
(setq matchbeg (match-beginning 0))
;; Get beginning of first match line and end of the last.
(save-excursion
(goto-char matchbeg)
(setq begpt (line-beginning-position))
(goto-char endpt)
(setq endpt (line-end-position)))
;; Sum line numbers up to the first match line.
(setq curr-line (+ curr-line (count-lines origpt begpt)))
(setq markers nil)
(setq curstring (occur-engine-line begpt endpt keep-props))
;; Highlight the matches
(let ((len (length curstring))
(start 0))
;; Count empty lines that don't use next loop (Bug#22062).
(when (zerop len)
(setq matches (1+ matches)))
(when (and list-matching-lines-jump-to-current-line
(not multi-occur-p))
(or orig-line (setq orig-line 1))
(or nlines (setq nlines (line-number-at-pos (point-max))))
(when (= curr-line orig-line)
(add-face-text-property
0 len list-matching-lines-current-line-face nil curstring)
(add-text-properties 0 len '(current-line t) curstring))
(when (and (>= orig-line (- curr-line nlines))
(<= orig-line (+ curr-line nlines)))
;; Shown either here or will be shown by occur-context-lines
(setq orig-line-shown-p t)))
(while (and (< start len)
(string-match regexp curstring start))
(push (cons (set-marker (make-marker)
(+ begpt (match-beginning 0)))
(set-marker (make-marker)
(+ begpt (match-end 0))))
markers)
(setq matches (1+ matches))
(add-text-properties
(match-beginning 0) (match-end 0)
'(occur-match t) curstring)
(when match-face
;; Add `match-face' to faces copied from the buffer.
(add-face-text-property
(match-beginning 0) (match-end 0)
match-face nil curstring))
;; Avoid infloop (Bug#7593).
(let ((end (match-end 0)))
(setq start (if (= start end) (1+ start) end)))))
(setq markers (nreverse markers))
;; Generate the string to insert for this match
(let* ((match-prefix
;; Using 7 digits aligns tabs properly.
(apply #'propertize (format "%7d:" curr-line)
(append
(when prefix-face
`(font-lock-face ,prefix-face))
`(occur-prefix t
;; Allow insertion of text
;; at the end of the prefix
;; (for Occur Edit mode).
front-sticky t
rear-nonsticky t
read-only t
occur-target ,markers
follow-link t
help-echo "mouse-2: go to this occurrence"))))
(match-str
;; We don't put `mouse-face' on the newline,
;; because that loses. And don't put it
;; on context lines to reduce flicker.
(propertize curstring
'occur-target markers
'follow-link t
'help-echo
"mouse-2: go to this occurrence"))
(out-line
;; Add non-numeric prefix to all non-first lines
;; of multi-line matches.
(concat
(string-replace
"\n"
(if prefix-face
(propertize
"\n :" 'font-lock-face prefix-face
'occur-target markers)
(propertize
"\n :" 'occur-target markers))
;; Add mouse face in one section to
;; ensure the prefix and the string
;; get a contiguous highlight.
(propertize (concat match-prefix match-str)
'mouse-face 'highlight))
;; Add markers at eol, but no mouse props.
(propertize "\n" 'occur-target markers)))
(data
(if (= nlines 0)
;; The simple display style
out-line
;; The complex multi-line display style.
(setq ret (occur-context-lines
out-line nlines keep-props begpt
endpt curr-line prev-line
prev-after-lines prefix-face
orig-line multi-occur-p))
;; Set first elem of the returned list to `data',
;; and the second elem to `prev-after-lines'.
(setq prev-after-lines (nth 1 ret))
(nth 0 ret)))
(orig-line-str
(when (and list-matching-lines-jump-to-current-line
(null orig-line-shown-p)
(> curr-line orig-line))
(setq orig-line-shown-p t)
(save-excursion
(goto-char (point-min))
(forward-line (1- orig-line))
(occur-engine-line (line-beginning-position)
(line-end-position) keep-props)))))
;; Actually insert the match display data
(with-current-buffer out-buf
(when orig-line-str
(add-face-text-property
0 (length orig-line-str)
list-matching-lines-current-line-face nil orig-line-str)
(add-text-properties 0 (length orig-line-str)
'(current-line t) orig-line-str)
(insert (car (occur-engine-add-prefix
(list orig-line-str) prefix-face))))
(insert data)))
(goto-char endpt))
(if endpt
(progn
;; Sum line numbers between first and last match lines.
(setq curr-line (+ curr-line (count-lines begpt endpt)
;; Add 1 for empty last match line
;; since count-lines returns one
;; line less.
(if (and (bolp) (eolp)) 1 0)))
;; On to the next match...
(forward-line 1))
(goto-char (point-max)))
(setq prev-line (1- curr-line)))
;; Flush remaining context after-lines.
(when prev-after-lines
(with-current-buffer out-buf
(insert (apply #'concat (occur-engine-add-prefix
prev-after-lines prefix-face)))))
(when (and list-matching-lines-jump-to-current-line
(null orig-line-shown-p))
(setq orig-line-shown-p t)
(let ((orig-line-str
(save-excursion
(goto-char (point-min))
(forward-line (1- orig-line))
(occur-engine-line (line-beginning-position)
(line-end-position) keep-props))))
(add-face-text-property
0 (length orig-line-str)
list-matching-lines-current-line-face nil orig-line-str)
(add-text-properties 0 (length orig-line-str)
'(current-line t) orig-line-str)
(with-current-buffer out-buf
(insert (car (occur-engine-add-prefix
(list orig-line-str) prefix-face))))))))
(when (not (zerop lines)) ;; is the count zero?
(setq global-lines (+ global-lines lines)
global-matches (+ global-matches matches))
(with-current-buffer out-buf
(goto-char headerpt)
(let ((beg (point))
end)
(insert (propertize
(format "%d %s%s%s in buffer: %s%s\n"
matches
(ngettext "match" "matches" matches)
;; Don't display the same number of lines
;; and matches in case of 1 match per line.
(if (= lines matches)
"" (format " in %d %s"
lines
(ngettext "line" "lines" lines)))
;; Don't display regexp for multi-buffer.
(if (> (length buffers) 1)
"" (occur-regexp-descr regexp))
(buffer-name (if (overlayp boo) (overlay-buffer boo) boo))
(if (overlayp boo)
(format " within region: %d-%d"
(overlay-start boo)
(overlay-end boo))
""))
'read-only t))
(setq end (point))
(when title-face
(add-face-text-property beg end title-face))
(goto-char (if (and list-matching-lines-jump-to-current-line
(not multi-occur-p))
(setq occur--final-pos
(and (goto-char (point-max))
(or (previous-single-property-change (point) 'current-line)
(point-max))))
(point-min))))))))))
;; Display total match count and regexp for multi-buffer.
(when (and (not (zerop global-lines)) (> (length buffers) 1))
(goto-char (point-min))
(let ((beg (point))
end)
(insert (format "%d %s%s total%s:\n"
global-matches
(ngettext "match" "matches" global-matches)
;; Don't display the same number of lines
;; and matches in case of 1 match per line.
(if (= global-lines global-matches)
"" (format " in %d %s"
global-lines
(ngettext "line" "lines" global-lines)))
(occur-regexp-descr regexp)))
(setq end (point))
(when title-face
(add-face-text-property beg end title-face)))
(goto-char (point-min)))
(if coding
;; CODING is buffer-file-coding-system of the first buffer
;; that locally binds it. Let's use it also for the output
;; buffer.
(set-buffer-file-coding-system coding))
;; Return the number of matches
global-matches)))