summaryrefslogtreecommitdiff
path: root/lisp/replace.el
diff options
context:
space:
mode:
authorTino Calancha <tino.calancha@gmail.com>2017-02-02 19:13:27 +0900
committerTino Calancha <tino.calancha@gmail.com>2017-02-02 19:13:27 +0900
commite280b94dcd6ed42439718ddf9dd704169f6bb536 (patch)
tree2d1fc5428a6748c22bc1aed0ddde5309ec06cdc5 /lisp/replace.el
parent8e871aef10455eefc34790a9ec011c6fec5e93fe (diff)
downloademacs-e280b94dcd6ed42439718ddf9dd704169f6bb536.tar.gz
Show current line highlighted in *Occur* buffer
* lisp/replace.el (list-matching-lines-current-line-face) (list-matching-lines-jump-to-current-line): New user options. (occur--orig-line, occur--orig-line-str): New variables. (occur, occur-engine): Use them. (occur--final-pos): New variable. (occur-1): Use it. (occur-engine): Idem. Show the current line with 'list-matching-lines-current-line-face'. Set point on the first matching line after the current one. * etc/NEWS: Add entry for the new option.
Diffstat (limited to 'lisp/replace.el')
-rw-r--r--lisp/replace.el72
1 files changed, 67 insertions, 5 deletions
diff --git a/lisp/replace.el b/lisp/replace.el
index 0a8e4804858..a825040a979 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1304,6 +1304,19 @@ If the value is nil, don't highlight the buffer names specially."
:type 'face
:group 'matching)
+(defcustom list-matching-lines-current-line-face 'lazy-highlight
+ "Face used by \\[list-matching-lines] to highlight the current line."
+ :type 'face
+ :group 'matching
+ :version "26.1")
+
+(defcustom list-matching-lines-jump-to-current-line nil
+ "If non-nil, \\[list-matching-lines] shows the current line highlighted.
+Set the point right after such line when there are matches after it."
+:type 'boolean
+:group 'matching
+:version "26.1")
+
(defcustom list-matching-lines-prefix-face 'shadow
"Face used by \\[list-matching-lines] to show the prefix column.
If the face doesn't differ from the default face,
@@ -1364,6 +1377,9 @@ invoke `occur'."
(defvar occur--region-start nil)
(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)
"Show all lines in the current buffer containing a match for REGEXP.
@@ -1382,6 +1398,9 @@ REGION must be a list of (START . END) positions as returned by
The lines are shown in a buffer named `*Occur*'.
It serves as a menu to find any of the occurrences in this buffer.
\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
+If `list-matching-lines-jump-to-current-line' is non-nil, then show
+the current line highlighted with `list-matching-lines-current-line-face'
+and set point at the first match after such line.
If REGEXP contains upper case characters (excluding those preceded by `\\')
and `search-upper-case' is non-nil, the matching is case-sensitive.
@@ -1409,7 +1428,13 @@ is not modified."
(occur--region-end end)
(occur--matches-threshold
(and in-region-p
- (line-number-at-pos (min start end)))))
+ (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))))
(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)))
@@ -1508,7 +1533,8 @@ See also `multi-occur'."
(occur-mode))
(let ((inhibit-read-only t)
;; Don't generate undo entries for creation of the initial contents.
- (buffer-undo-list t))
+ (buffer-undo-list t)
+ (occur--final-pos nil))
(erase-buffer)
(let ((count
(if (stringp nlines)
@@ -1560,6 +1586,10 @@ See also `multi-occur'."
(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)
@@ -1572,7 +1602,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)))
+ (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)
@@ -1580,12 +1611,16 @@ 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)
(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)
@@ -1686,6 +1721,18 @@ See also `multi-occur'."
(nth 0 ret))))
;; 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)))
(insert data)))
(goto-char endpt))
(if endpt
@@ -1699,6 +1746,18 @@ 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
@@ -1732,8 +1791,11 @@ See also `multi-occur'."
(setq end (point))
(add-text-properties beg end `(occur-title ,buf))
(when title-face
- (add-face-text-property beg end title-face)))
- (goto-char (point-min)))))))
+ (add-face-text-property beg end title-face))
+ (goto-char (if finalpt
+ (setq occur--final-pos
+ (cl-incf finalpt (- end beg)))
+ (point-min)))))))))
;; Display total match count and regexp for multi-buffer.
(when (and (not (zerop global-lines)) (> (length buffers) 1))
(goto-char (point-min))