From ddfa3cb434de08256f7934a4255133fac2995ee3 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 24 Mar 2013 23:47:52 +0200 Subject: [PATCH] * lisp/replace.el (list-matching-lines-prefix-face): New defcustom. (occur-1): Pass `list-matching-lines-prefix-face' to the function `occur-engine' if `face-differs-from-default-p' returns t. (occur-engine): Add `,' inside backquote construct to evaluate `prefix-face'. Propertize the prefix with the `prefix-face' face. Pass `prefix-face' to the functions `occur-context-lines' and `occur-engine-add-prefix'. (occur-engine-add-prefix, occur-context-lines): Add optional arg `prefix-face' and propertize the prefix with `prefix-face'. Fixes: debbugs:14017 --- lisp/ChangeLog | 13 +++++++++++++ lisp/replace.el | 44 ++++++++++++++++++++++++++++++++------------ 2 files changed, 45 insertions(+), 12 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 68a9575bcb..c27f5d25a0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2013-03-24 Juri Linkov + + * replace.el (list-matching-lines-prefix-face): New defcustom. + (occur-1): Pass `list-matching-lines-prefix-face' to the function + `occur-engine' if `face-differs-from-default-p' returns t. + (occur-engine): Add `,' inside backquote construct to evaluate + `prefix-face'. Propertize the prefix with the `prefix-face' face. + Pass `prefix-face' to the functions `occur-context-lines' and + `occur-engine-add-prefix'. + (occur-engine-add-prefix, occur-context-lines): Add optional arg + `prefix-face' and propertize the prefix with `prefix-face'. + (Bug#14017) + 2013-03-24 Leo Liu * nxml/rng-valid.el (rng-validate-while-idle) diff --git a/lisp/replace.el b/lisp/replace.el index 17eea19edd..1bebff448f 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1125,6 +1125,14 @@ If the value is nil, don't highlight the buffer names specially." :type 'face :group 'matching) +(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, +don't highlight the prefix with line numbers specially." + :type 'face + :group 'matching + :version "24.4") + (defcustom occur-excluded-properties '(read-only invisible intangible field mouse-face help-echo local-map keymap yank-handler follow-link) @@ -1334,7 +1342,9 @@ See also `multi-occur'." (isearch-no-upper-case-p regexp t) case-fold-search) list-matching-lines-buffer-name-face - nil list-matching-lines-face + (if (face-differs-from-default-p list-matching-lines-prefix-face) + list-matching-lines-prefix-face) + list-matching-lines-face (not (eq occur-excluded-properties t)))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) @@ -1423,7 +1433,7 @@ See also `multi-occur'." (apply #'propertize (format "%7d:" lines) (append (when prefix-face - `(font-lock-face prefix-face)) + `(font-lock-face ,prefix-face)) `(occur-prefix t mouse-face (highlight) ;; Allow insertion of text at ;; the end of the prefix (for @@ -1447,7 +1457,9 @@ See also `multi-occur'." ;; of multi-line matches. (replace-regexp-in-string "\n" - "\n :" + (if prefix-face + (propertize "\n :" 'font-lock-face prefix-face) + "\n :") match-str) ;; Add marker at eol, but no mouse props. (propertize "\n" 'occur-target marker))) @@ -1458,7 +1470,8 @@ See also `multi-occur'." ;; The complex multi-line display style. (setq ret (occur-context-lines out-line nlines keep-props begpt endpt - lines prev-lines prev-after-lines)) + lines prev-lines prev-after-lines + prefix-face)) ;; Set first elem of the returned list to `data', ;; and the second elem to `prev-after-lines'. (setq prev-after-lines (nth 1 ret)) @@ -1482,7 +1495,7 @@ See also `multi-occur'." (when prev-after-lines (with-current-buffer out-buf (insert (apply #'concat (occur-engine-add-prefix - prev-after-lines))))))) + prev-after-lines prefix-face))))))) (when (not (zerop matches)) ;; is the count zero? (setq globalcount (+ globalcount matches)) (with-current-buffer out-buf @@ -1537,10 +1550,13 @@ See also `multi-occur'." str) (buffer-substring-no-properties beg end))) -(defun occur-engine-add-prefix (lines) +(defun occur-engine-add-prefix (lines &optional prefix-face) (mapcar #'(lambda (line) - (concat " :" line "\n")) + (concat (if prefix-face + (propertize " :" 'font-lock-face prefix-face) + " :") + line "\n")) lines)) (defun occur-accumulate-lines (count &optional keep-props pt) @@ -1569,7 +1585,8 @@ See also `multi-occur'." ;; 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 - lines prev-lines prev-after-lines) + lines prev-lines prev-after-lines + &optional prefix-face) ;; Find after- and before-context lines of the current match. (let ((before-lines (nreverse (cdr (occur-accumulate-lines @@ -1609,10 +1626,13 @@ See also `multi-occur'." ;; Return a list where the first element is the output line. (apply #'concat (append - (and prev-after-lines - (occur-engine-add-prefix prev-after-lines)) - (and separator (list separator)) - (occur-engine-add-prefix before-lines) + (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)))) -- 2.39.2