[Emacs-diffs] master 8e42b1b: Support list-matching-lines-jump-to-current-line for context lines.

[Juri Linkov]

branch: master
commit 8e42b1bd3c8ba1757c150149f0d21eabd9245dcc
Author: Juri Linkov <address@hidden>
Commit: Juri Linkov <address@hidden>

    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)
---
 lisp/replace.el | 132 ++++++++++++++++++++++++++++++++++++--------------------
 1 file changed, 85 insertions(+), 47 deletions(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index 0db7411..0efd082 100644
--- a/lisp/replace.el
+++ b/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)