Function: occur-context-lines

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

Signature

(occur-context-lines OUT-LINE NLINES KEEP-PROPS BEGPT ENDPT CURR-LINE PREV-LINE PREV-AFTER-LINES &optional PREFIX-FACE ORIG-LINE MULTI-OCCUR-P)

Source Code

;; Defined in /usr/src/emacs/lisp/replace.el.gz
;; Generate context display for occur.
;; OUT-LINE is the line where the match is.
;; NLINES and KEEP-PROPS are args to occur-engine.
;; CURR-LINE is line count of the current match,
;; PREV-LINE is line count of the previous match,
;; PREV-AFTER-LINES is a list of after-context lines of the previous match.
;; Generate a list of lines, add prefixes to all but OUT-LINE,
;; then concatenate them all together.
(defun occur-context-lines (out-line nlines keep-props begpt endpt
				     curr-line prev-line prev-after-lines
				     &optional prefix-face
				     orig-line multi-occur-p)
  ;; Find after- and before-context lines of the current match.
  (let ((before-lines
	 (nreverse (cdr (occur-accumulate-lines
			 (- (1+ (abs nlines))) keep-props begpt))))
	(after-lines
	 (cdr (occur-accumulate-lines
	       (1+ nlines) keep-props endpt)))
	separator)

    (when (and list-matching-lines-jump-to-current-line
	       (not multi-occur-p))
      (when (and (>= orig-line (- curr-line nlines))
		 (< orig-line curr-line))
	(let ((curstring (nth (- (length before-lines) (- curr-line orig-line)) before-lines)))
	  (add-face-text-property
	   0 (length curstring)
	   list-matching-lines-current-line-face nil curstring)
	  (add-text-properties 0 (length curstring)
			       '(current-line t) curstring)))
      (when (and (<= orig-line (+ curr-line nlines))
		 (> orig-line curr-line))
	(let ((curstring (nth (- orig-line curr-line 1) after-lines)))
	  (add-face-text-property
	   0 (length curstring)
	   list-matching-lines-current-line-face nil curstring)
	  (add-text-properties 0 (length curstring)
			       '(current-line t) curstring))))

    ;; Combine after-lines of the previous match
    ;; with before-lines of the current match.

    (when prev-after-lines
      ;; Don't overlap prev after-lines with current before-lines.
      (if (>= (+ prev-line (length prev-after-lines))
	      (- curr-line (length before-lines)))
	  (setq prev-after-lines
                (take (- curr-line prev-line (length before-lines) 1)
                      prev-after-lines))
	;; Separate non-overlapping context lines with a dashed line.
	(setq separator "-------\n")))

    (when prev-line
      ;; Don't overlap current before-lines with previous match line.
      (if (<= (- curr-line (length before-lines))
	      prev-line)
	  (setq before-lines
		(nthcdr (- (length before-lines)
			   (- curr-line prev-line 1))
			before-lines))
	;; Separate non-overlapping before-context lines.
	(unless (> nlines 0)
	  (setq separator "-------\n"))))

    (list
     ;; Return a list where the first element is the output line.
     (apply #'concat
	    (append
	     (if prev-after-lines
		 (occur-engine-add-prefix prev-after-lines prefix-face))
	     (if separator
		 (list (if prefix-face
			   (propertize separator 'font-lock-face prefix-face)
			 separator)))
	     (occur-engine-add-prefix before-lines prefix-face)
	     (list out-line)))
     ;; And the second element is the list of context after-lines.
     (if (> nlines 0) after-lines))))