Support list-matching-lines-jump-to-current-line for context lines.
* lisp/replace.el (occur--orig-line-str): Remove. (occur): Remove occur--orig-line-str. (occur-engine): Use add-face-text-property to add the face list-matching-lines-current-line-face to the current line. Use previous-single-property-change to find occur--final-pos. (occur-context-lines): New args orig-line and multi-occur-p. Find the current line in context lines and add face to it. (Bug#30281)
This commit is contained in:
Juri Linkov
parent
a0c7157a16
commit
8e42b1bd3c
1 changed files with 85 additions and 47 deletions
132
lisp/replace.el
132
lisp/replace.el
|
|
@ -1389,7 +1389,6 @@ invoke `occur'."
|
|||
(defvar occur--region-end nil)
|
||||
(defvar occur--matches-threshold nil)
|
||||
(defvar occur--orig-line nil)
|
||||
(defvar occur--orig-line-str nil)
|
||||
(defvar occur--final-pos nil)
|
||||
|
||||
(defun occur (regexp &optional nlines region)
|
||||
|
|
@ -1446,11 +1445,7 @@ is not modified."
|
|||
(and in-region-p
|
||||
(line-number-at-pos (min start end))))
|
||||
(occur--orig-line
|
||||
(line-number-at-pos (point)))
|
||||
(occur--orig-line-str
|
||||
(buffer-substring-no-properties
|
||||
(line-beginning-position)
|
||||
(line-end-position))))
|
||||
(line-number-at-pos (point))))
|
||||
(save-excursion ; If no matches `occur-1' doesn't restore the point.
|
||||
(and in-region-p (narrow-to-region start end))
|
||||
(occur-1 regexp nlines (list (current-buffer)))
|
||||
|
|
@ -1550,7 +1545,7 @@ See also `multi-occur'."
|
|||
(let ((inhibit-read-only t)
|
||||
;; Don't generate undo entries for creation of the initial contents.
|
||||
(buffer-undo-list t)
|
||||
(occur--final-pos nil))
|
||||
(occur--final-pos nil))
|
||||
(erase-buffer)
|
||||
(let ((count
|
||||
(if (stringp nlines)
|
||||
|
|
@ -1618,8 +1613,8 @@ See also `multi-occur'."
|
|||
(global-matches 0) ;; total count of matches
|
||||
(coding nil)
|
||||
(case-fold-search case-fold)
|
||||
(in-region-p (and occur--region-start occur--region-end))
|
||||
(multi-occur-p (cdr buffers)))
|
||||
(in-region-p (and occur--region-start occur--region-end))
|
||||
(multi-occur-p (cdr buffers)))
|
||||
;; Map over all the buffers
|
||||
(dolist (buf buffers)
|
||||
(when (buffer-live-p buf)
|
||||
|
|
@ -1627,16 +1622,14 @@ See also `multi-occur'."
|
|||
(matches 0) ;; count of matches
|
||||
(curr-line ;; line count
|
||||
(or occur--matches-threshold 1))
|
||||
(orig-line occur--orig-line)
|
||||
(orig-line-str occur--orig-line-str)
|
||||
(orig-line-shown-p)
|
||||
(orig-line occur--orig-line)
|
||||
(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)
|
||||
(finalpt nil)
|
||||
(marker nil)
|
||||
(curstring "")
|
||||
(ret nil)
|
||||
|
|
@ -1677,6 +1670,16 @@ See also `multi-occur'."
|
|||
;; 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))
|
||||
(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))
|
||||
(setq matches (1+ matches))
|
||||
|
|
@ -1737,26 +1740,33 @@ See also `multi-occur'."
|
|||
;; 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))
|
||||
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))))
|
||||
(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 (and list-matching-lines-jump-to-current-line
|
||||
(not multi-occur-p)
|
||||
(not orig-line-shown-p)
|
||||
(>= curr-line orig-line))
|
||||
(insert
|
||||
(concat
|
||||
(propertize
|
||||
(format "%7d:%s" orig-line orig-line-str)
|
||||
'face list-matching-lines-current-line-face
|
||||
'mouse-face 'mode-line-highlight
|
||||
'help-echo "Current line") "\n"))
|
||||
(setq orig-line-shown-p t finalpt (point)))
|
||||
(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
|
||||
|
|
@ -1771,23 +1781,28 @@ See also `multi-occur'."
|
|||
(forward-line 1))
|
||||
(goto-char (point-max)))
|
||||
(setq prev-line (1- curr-line)))
|
||||
;; Insert original line if haven't done yet.
|
||||
(when (and list-matching-lines-jump-to-current-line
|
||||
(not multi-occur-p)
|
||||
(not orig-line-shown-p))
|
||||
(with-current-buffer out-buf
|
||||
(insert
|
||||
(concat
|
||||
(propertize
|
||||
(format "%7d:%s" orig-line orig-line-str)
|
||||
'face list-matching-lines-current-line-face
|
||||
'mouse-face 'mode-line-highlight
|
||||
'help-echo "Current line") "\n"))))
|
||||
;; 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)))))))
|
||||
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))
|
||||
|
|
@ -1818,10 +1833,13 @@ See also `multi-occur'."
|
|||
(add-text-properties beg end `(occur-title ,buf))
|
||||
(when title-face
|
||||
(add-face-text-property beg end title-face))
|
||||
(goto-char (if finalpt
|
||||
(setq occur--final-pos
|
||||
(cl-incf finalpt (- end beg)))
|
||||
(point-min))))))))))
|
||||
(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))
|
||||
|
|
@ -1895,7 +1913,8 @@ See also `multi-occur'."
|
|||
;; 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)
|
||||
&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
|
||||
|
|
@ -1905,13 +1924,32 @@ See also `multi-occur'."
|
|||
(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)))
|
||||
(- curr-line (length before-lines)))
|
||||
(setq prev-after-lines
|
||||
(butlast prev-after-lines
|
||||
(- (length prev-after-lines)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue