diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index de258935e1..243be13405 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -434,6 +434,9 @@ hi-lock-line-face-buffer Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive. + Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the highlighting will not update as you type." @@ -447,7 +450,10 @@ hi-lock-line-face-buffer (hi-lock-set-pattern ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? ;; or a trailing $ in REGEXP will be interpreted correctly. - (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face)) + (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face nil + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) ;;;###autoload @@ -460,6 +466,9 @@ hi-lock-face-buffer corresponding SUBEXP (interactively, the prefix argument) of REGEXP. If SUBEXP is omitted or nil, the entire REGEXP is highlighted. +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive. + Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the highlighting will not update as you type." @@ -471,7 +480,11 @@ hi-lock-face-buffer current-prefix-arg)) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) - (hi-lock-set-pattern regexp face subexp)) + (hi-lock-set-pattern + regexp face subexp + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) ;;;###autoload (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -507,6 +520,9 @@ hi-lock-face-symbol-at-point unless you use a prefix argument. Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point. +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive. + This uses Font lock mode if it is enabled; otherwise it uses overlays, in which case the highlighting will not update as you type." (interactive) @@ -516,7 +532,11 @@ hi-lock-face-symbol-at-point (face (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) - (hi-lock-set-pattern regexp face))) + (hi-lock-set-pattern + regexp face nil + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search)))) (defun hi-lock-keyword->face (keyword) (cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...). @@ -713,14 +733,17 @@ hi-lock-read-face-name (add-to-list 'hi-lock-face-defaults face t)) (intern face))) -(defun hi-lock-set-pattern (regexp face &optional subexp) +(defun hi-lock-set-pattern (regexp face &optional subexp case-fold) "Highlight SUBEXP of REGEXP with face FACE. If omitted or nil, SUBEXP defaults to zero, i.e. the entire -REGEXP is highlighted." +REGEXP is highlighted. Non-nil CASE-FOLD ignores case." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) (setq subexp (or subexp 0)) - (let ((pattern (list regexp (list subexp (list 'quote face) 'prepend))) + (let ((pattern (list (lambda (limit) + (let ((case-fold-search case-fold)) + (re-search-forward regexp limit t))) + (list subexp (list 'quote face) 'prepend))) (no-matches t)) ;; Refuse to highlight a text that is already highlighted. (if (assoc regexp hi-lock-interactive-patterns) @@ -740,14 +763,15 @@ hi-lock-set-pattern (+ range-max (max 0 (- (point-min) range-min)))))) (save-excursion (goto-char search-start) - (while (re-search-forward regexp search-end t) - (when no-matches (setq no-matches nil)) - (let ((overlay (make-overlay (match-beginning subexp) - (match-end subexp)))) - (overlay-put overlay 'hi-lock-overlay t) - (overlay-put overlay 'hi-lock-overlay-regexp regexp) - (overlay-put overlay 'face face)) - (goto-char (match-end 0))) + (let ((case-fold-search case-fold)) + (while (re-search-forward regexp search-end t) + (when no-matches (setq no-matches nil)) + (let ((overlay (make-overlay (match-beginning subexp) + (match-end subexp)))) + (overlay-put overlay 'hi-lock-overlay t) + (overlay-put overlay 'hi-lock-overlay-regexp regexp) + (overlay-put overlay 'face face)) + (goto-char (match-end 0)))) (when no-matches (add-to-list 'hi-lock--unused-faces (face-name face)) (setq hi-lock-interactive-patterns diff --git a/lisp/isearch.el b/lisp/isearch.el index 7625ec12b5..1f06c3ba5a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2382,22 +2382,12 @@ isearch--highlight-regexp-or-lines (funcall isearch-regexp-function isearch-string)) (isearch-regexp-function (word-search-regexp isearch-string)) (isearch-regexp isearch-string) - ((if (and (eq isearch-case-fold-search t) - search-upper-case) - (isearch-no-upper-case-p - isearch-string isearch-regexp) - isearch-case-fold-search) - ;; Turn isearch-string into a case-insensitive - ;; regexp. - (mapconcat - (lambda (c) - (let ((s (string c))) - (if (string-match "[[:alpha:]]" s) - (format "[%s%s]" (upcase s) (downcase s)) - (regexp-quote s)))) - isearch-string "")) (t (regexp-quote isearch-string))))) - (funcall hi-lock-func regexp (hi-lock-read-face-name))) + (let ((case-fold-search isearch-case-fold-search) + ;; Set `search-upper-case' to nil to not call + ;; `isearch-no-upper-case-p' in `hi-lock'. + (search-upper-case nil)) + (funcall hi-lock-func regexp (hi-lock-read-face-name)))) (and isearch-recursive-edit (exit-recursive-edit))) (defun isearch-highlight-regexp ()