From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Thu, 27 Apr 2017 23:22:05 +0900 Message-ID: <87bmrilylu.fsf@calancha-pc> References: <87si1a2tod.fsf@secretsauce.net> <8760x7vyui.fsf@mail.linkov.net> <87vapwipy4.fsf@calancha-pc> <87shkyems1.fsf@localhost> <87pog112pp.fsf@calancha-pc> <87mvb4yzux.fsf@localhost> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: blaine.gmane.org 1493302996 26566 195.159.176.226 (27 Apr 2017 14:23:16 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Thu, 27 Apr 2017 14:23:16 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: 22541@debbugs.gnu.org, Dima Kogan , tino.calancha@gmail.com To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Apr 27 16:23:10 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d3kK4-0006lW-I8 for geb-bug-gnu-emacs@m.gmane.org; Thu, 27 Apr 2017 16:23:08 +0200 Original-Received: from localhost ([::1]:60969 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d3kKA-00045Z-5F for geb-bug-gnu-emacs@m.gmane.org; Thu, 27 Apr 2017 10:23:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:34662) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d3kK1-00042m-AF for bug-gnu-emacs@gnu.org; Thu, 27 Apr 2017 10:23:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d3kJy-0003Il-1S for bug-gnu-emacs@gnu.org; Thu, 27 Apr 2017 10:23:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:44757) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d3kJx-0003Ih-Rb for bug-gnu-emacs@gnu.org; Thu, 27 Apr 2017 10:23:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d3kJx-0000HH-MD for bug-gnu-emacs@gnu.org; Thu, 27 Apr 2017 10:23:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 27 Apr 2017 14:23:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 22541 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 22541-submit@debbugs.gnu.org id=B22541.1493302942996 (code B ref 22541); Thu, 27 Apr 2017 14:23:01 +0000 Original-Received: (at 22541) by debbugs.gnu.org; 27 Apr 2017 14:22:22 +0000 Original-Received: from localhost ([127.0.0.1]:42956 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d3kJJ-0000Fz-7i for submit@debbugs.gnu.org; Thu, 27 Apr 2017 10:22:21 -0400 Original-Received: from mail-pf0-f178.google.com ([209.85.192.178]:33705) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d3kJG-0000Fi-Sx for 22541@debbugs.gnu.org; Thu, 27 Apr 2017 10:22:19 -0400 Original-Received: by mail-pf0-f178.google.com with SMTP id a188so28420953pfa.0 for <22541@debbugs.gnu.org>; Thu, 27 Apr 2017 07:22:18 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-transfer-encoding; bh=OGChUWXguxGzdR41X5H0EHyMtuAKb5AEQg/ugJIeI/I=; b=WiNhByH65458QOj7HLg2iAvKZeZRHZugnVW2UMxJoDCKus9pHDTwlh8fWkaqqtkqI0 usWLEHiURYsefvjZmeVwUZtw1Kk0EJcEdCP6GoW1/Hwbfc7Lpl7aYZUGE2y16TEbL54I Qxm09u3oFr+Bt4RwFscDuldFsThjPvTursY9a1DvPkpbJhZoE66gvud+HyKc/r+ssG/s ILkgJx6ZPkt1d61jIChnZF1BdY9TfA7PkMG8G7LxlxVVGcMp044d0Ct3VjGcKtqnJcLT xLHRN52UWdFHtgJno9MX/7IgsNxdNBGbPH2PsafhlglI7V37YTUyM6OrWlqgRLws2xVA Ingg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version:content-transfer-encoding; bh=OGChUWXguxGzdR41X5H0EHyMtuAKb5AEQg/ugJIeI/I=; b=PgxjILkWraQQSKYFz1RIcQpuPRsP4XFGAXVxwUZcNmM5G8JzR+qDPVjKIG8V2hYaqb NbiDIazg4AVO7OG7OB24FG6WkrNSqYlgwGIN6BoPLLJUJ3vRsNo+YkdLbnid4s3VNoEr k9Yo5AdQmlcIkQqzh/sFvBr2+q+AGDVAA3rcvqOL1KFNAs4f6xKp1MQ++jmopgljgdiv 7h+Hf0sLrWUKRnlsViFA50lpSihdAcLhQcG5CTMtWvDltUPewTRfJYJKr5g/dshBacoe Xzw/zNby4NMTKBSDfnUj4GM17KYvG9hQ3wGz8s09GhgZq/5b1N6NSU8jProzzqwvNqn6 voqQ== X-Gm-Message-State: AN3rC/5y2RVXvOAhPEO1uFtjuRPQzLEThBeCg+XomyQdfhQkGCuHe8mA x3GY+Mw69KL0EQ== X-Received: by 10.98.193.65 with SMTP id i62mr6085212pfg.149.1493302932306; Thu, 27 Apr 2017 07:22:12 -0700 (PDT) Original-Received: from calancha-pc (222.139.137.133.dy.bbexcite.jp. [133.137.139.222]) by smtp.gmail.com with ESMTPSA id g5sm7128981pgn.38.2017.04.27.07.22.08 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Thu, 27 Apr 2017 07:22:10 -0700 (PDT) In-Reply-To: <87mvb4yzux.fsf@localhost> (Juri Linkov's message of "Tue, 25 Apr 2017 23:52:06 +0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:132052 Archived-At: Juri Linkov writes: Thanks for the feedback! >> -(defun hi-lock-set-pattern (regexp face) >> - "Highlight REGEXP with face FACE." >> +(defun hi-lock-set-pattern (regexp face &optional case-fold) >> + "Highlight REGEXP with face FACE. >> +If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to i= t." >> ;; Hashcons the regexp, so it can be passed to remove-overlays later. >> (setq regexp (hi-lock--hashcons regexp)) >> - (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend)))) >> + (let ((pattern (list (if (eq case-fold 'undefined) >> + regexp >> + (cons regexp >> + (byte-compile >> + `(lambda (limit) >> + (let ((case-fold-search ,case-fold)) >> + (re-search-forward ,regexp limit t)))))) >> + (list 0 (list 'quote face) 'prepend)))) > > Do you need to remember also the value of =E2=80=98case-fold-search=E2=80= =99 > (together with =E2=80=98regexp=E2=80=99)? AFAICT i don't need it. >> @@ -1950,7 +1950,12 @@ isearch-highlight-regexp >> (regexp-quote s)))) >> isearch-string "")) >> (t (regexp-quote isearch-string))))) >> - (hi-lock-face-buffer regexp (hi-lock-read-face-name))) >> + (hi-lock-face-buffer regexp (hi-lock-read-face-name) >> + (if (and (eq isearch-case-fold-search t) >> + search-upper-case) >> + (isearch-no-upper-case-p >> + isearch-string isearch-regexp) >> + isearch-case-fold-search))) >> (and isearch-recursive-edit (exit-recursive-edit))) > > If this works reliably, then we could remove that ugly hack > from =E2=80=98isearch-highlight-regexp=E2=80=99, I mean the one with the = comment > =E2=80=9CTurn isearch-string into a case-insensitive regexp=E2=80=9D. That's right. We don't need such trick here anymore. But this hack turned ut to be useful in hi-lock.el. The new patch, in addition to fix this bug report, it also helps with the 5. in bug#22520, that is: emacs -Q M-s hr t RET RET ; Highlight with regexp "[Tt]" M-s hu t RET ; Unhighlight the buffer. --8<-----------------------------cut here---------------start------------->= 8--- >From 5183897b88b93060ce391f166cdeebf605785362 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Thu, 27 Apr 2017 23:02:41 +0900 Subject: [PATCH] highlight-regexp: Honor case-fold-search * lisp/hi-lock.el (hi-lock-face-buffer, hi-lock-set-pattern): Add optional arg CASE-FOLD. All callers updated. * lisp/isearch.el (isearch-highlight-regexp): Call hi-lock-face-buffer with 3 arguments. --- lisp/hi-lock.el | 30 +++++++++++++++++++----------- lisp/isearch.el | 7 ++++++- 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 5139e01fa8..55ad3ccb58 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -432,7 +432,7 @@ hi-lock-line-face-buffer ;;;###autoload (defalias 'highlight-regexp 'hi-lock-face-buffer) ;;;###autoload -(defun hi-lock-face-buffer (regexp &optional face) +(defun hi-lock-face-buffer (regexp &optional face case-fold) "Set face of each match of REGEXP to FACE. Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. @@ -444,10 +444,11 @@ hi-lock-face-buffer (list (hi-lock-regexp-okay (read-regexp "Regexp to highlight" 'regexp-history-last)) - (hi-lock-read-face-name))) + (hi-lock-read-face-name) + case-fold-search)) (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 case-fold)) =20 ;;;###autoload (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -689,11 +690,17 @@ hi-lock-read-face-name (add-to-list 'hi-lock-face-defaults face t)) (intern face))) =20 -(defun hi-lock-set-pattern (regexp face) +(defun hi-lock-set-pattern (regexp face &optional case-fold) "Highlight REGEXP with face FACE." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) - (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend)))) + (let ((pattern (list (if (eq case-fold 'undefined) + regexp + (byte-compile + `(lambda (limit) + (let ((case-fold-search ,case-fold)) + (re-search-forward ,regexp limit t))))) + (list 0 (list 'quote face) 'prepend)))) ;; Refuse to highlight a text that is already highlighted. (if (assoc regexp hi-lock-interactive-patterns) (add-to-list 'hi-lock--unused-faces (face-name face)) @@ -712,12 +719,13 @@ 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) - (let ((overlay (make-overlay (match-beginning 0) (match-end = 0)))) - (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) + (let ((overlay (make-overlay (match-beginning 0) (match-en= d 0)))) + (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)))))))))) =20 (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." diff --git a/lisp/isearch.el b/lisp/isearch.el index c34739d638..250d37b45e 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1950,7 +1950,12 @@ isearch-highlight-regexp (regexp-quote s)))) isearch-string "")) (t (regexp-quote isearch-string))))) - (hi-lock-face-buffer regexp (hi-lock-read-face-name))) + (hi-lock-face-buffer regexp (hi-lock-read-face-name) + (if (and (eq isearch-case-fold-search t) + search-upper-case) + (isearch-no-upper-case-p + isearch-string isearch-regexp) + isearch-case-fold-search))) (and isearch-recursive-edit (exit-recursive-edit))) =20 --=20 2.11.0 >From 32ec762b9459cf2a1b50217fa061c70541c0a241 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Thu, 27 Apr 2017 23:05:01 +0900 Subject: [PATCH] Fix hi-lock-unface-buffer from last commit Perform the matches of REGEXP as `isearch-forward' i.e., in interactive calls determine the case fold with `search-upper-case' and `case-fold-search' (Bug#22541). * lisp/hi-lock.el (hi-lock-face-buffer): Update docstring. Determine the case fold with `search-upper-case' and `case-fold-search'. (hi-lock--regexps-at-point, hi-lock-unface-buffer): Handle when pattern is a cons (REGEXP . FUNCTION). (hi-lock-read-face-name): Update docstring. (hi-lock--case-insensitive-regexp, hi-lock--case-insensitive-regexp-p): New defuns. (hi-lock-set-pattern, hi-lock-unface-buffer): Use them. * lisp/isearch.el (isearch-highlight-regexp): Delete hack for case-insensitive search; this is now handled in hi-lock-face-buffer. * test/lisp/hi-lock-tests.el (hi-lock-face-buffer-test, hi-lock-bug22520): Add tests. --- lisp/hi-lock.el | 153 +++++++++++++++++++++++++++++++++--------= ---- lisp/isearch.el | 10 +-- test/lisp/hi-lock-tests.el | 91 ++++++++++++++++++++++++++- 3 files changed, 204 insertions(+), 50 deletions(-) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 55ad3ccb58..5862974844 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -434,6 +434,7 @@ 'highlight-regexp ;;;###autoload (defun hi-lock-face-buffer (regexp &optional face case-fold) "Set face of each match of REGEXP to FACE. +If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it. Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. =20 @@ -441,11 +442,15 @@ hi-lock-face-buffer use overlays for highlighting. If overlays are used, the highlighting will not update as you type." (interactive - (list - (hi-lock-regexp-okay - (read-regexp "Regexp to highlight" 'regexp-history-last)) - (hi-lock-read-face-name) - case-fold-search)) + (let* ((regexp + (hi-lock-regexp-okay + (read-regexp "Regexp to highlight" 'regexp-history-last))) + (face (hi-lock-read-face-name)) + (case-fold + (if search-upper-case + (isearch-no-upper-case-p regexp t) + case-fold-search))) + (list regexp face case-fold))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face case-fold)) @@ -531,10 +536,17 @@ hi-lock--regexps-at-point ;; highlighted text at point. Use this later in ;; during completing-read. (dolist (hi-lock-pattern hi-lock-interactive-patterns) - (let ((regexp (car hi-lock-pattern))) - (if (string-match regexp hi-text) - (push regexp regexps))))))) - regexps)) + (let ((regexp-or-fn (car hi-lock-pattern))) + (cond ((stringp regexp-or-fn) + (when (string-match regexp-or-fn hi-text) + (push regexp-or-fn regexps))) + (t + (with-temp-buffer + (insert hi-text) + (goto-char 1) + (when (funcall regexp-or-fn nil) + (push regexp-or-fn regexps))))))) + ))) regexps)) =20 (defvar-local hi-lock--unused-faces nil "List of faces that is not used and is available for highlighting new te= xt. @@ -562,13 +574,15 @@ hi-lock-unface-buffer (cons `keymap (cons "Select Pattern to Unhighlight" - (mapcar (lambda (pattern) - (list (car pattern) - (format - "%s (%s)" (car pattern) - (hi-lock-keyword->face pattern)) - (cons nil nil) - (car pattern))) + (mapcar (lambda (pattern) + (let ((regexp (or (car-safe (car pattern)) + (car pattern)))) + (list regexp + (format + "%s (%s)" regexp + (hi-lock-keyword->face pattern)) + (cons nil nil) + regexp))) hi-lock-interactive-patterns)))) ;; If the user clicks outside the menu, meaning that they ;; change their mind, x-popup-menu returns nil, and @@ -582,16 +596,30 @@ hi-lock-unface-buffer (error "No highlighting to remove")) ;; Infer the regexp to un-highlight based on cursor position. (let* ((defaults (or (hi-lock--regexps-at-point) - (mapcar #'car hi-lock-interactive-patterns)))) - (list - (completing-read (if (null defaults) - "Regexp to unhighlight: " - (format "Regexp to unhighlight (default %s): " - (car defaults))) - hi-lock-interactive-patterns - nil t nil nil defaults)))))) - (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns - (list (assoc regexp hi-lock-interactive-patterns)))) + (mapcar (lambda (x) + (or (car-safe (car x)) + (car x))) + hi-lock-interactive-patterns))) + (regexp (completing-read (if (null defaults) + "Regexp to unhighlight: " + (format "Regexp to unhighlight (def= ault %s): " + (car defaults))) + hi-lock-interactive-patterns + nil nil nil nil defaults))) + (when (and (or (not search-upper-case) + (isearch-no-upper-case-p regexp t)) + case-fold-search + (not (hi-lock--case-insensitive-regexp-p regexp)= )) + (setq regexp (hi-lock--case-insensitive-regexp regexp))) + (list regexp))))) + (let* ((patterns hi-lock-interactive-patterns) + (keys (or (assoc regexp patterns) + (assoc + (assoc regexp (mapcar #'car patterns)) + patterns)))) + (dolist (keyword (if (eq regexp t) + patterns + (list keys))) (when keyword (let ((face (hi-lock-keyword->face keyword))) ;; Make `face' the next one to use by default. @@ -606,8 +634,10 @@ hi-lock-unface-buffer (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays - nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword))) - (font-lock-flush)))) + nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons + (or (car-safe (car keyword)) + (car keyword)))) + (font-lock-flush))))) =20 ;;;###autoload (defun hi-lock-write-interactive-patterns () @@ -690,23 +720,67 @@ hi-lock-read-face-name (add-to-list 'hi-lock-face-defaults face t)) (intern face))) =20 +(defun hi-lock--case-insensitive-regexp-p (regexp) + (let (case-fold-search) + (and (string-match-p regexp (downcase regexp)) + (string-match-p regexp (upcase regexp))))) + +(defun hi-lock--case-insensitive-regexp (regexp) + "Turn regexp into a case-insensitive regexp." + (let ((count 0) + (upper-re "[[:upper:]]") + (slash-upper-re "\\(\\\\\\)\\([[:upper:]]\\)") + case-fold-search) + (cond ((or (hi-lock--case-insensitive-regexp-p regexp) + (and (string-match upper-re regexp) + (not (string-match slash-upper-re regexp)))) + regexp) + (t + (let ((string regexp)) + (while (string-match slash-upper-re string) + (setq string (replace-match "" t t string 1))) + (setq regexp string) + (mapconcat + (lambda (c) + (let ((s (string c))) + (cond ((or (eq c ?\\) + (and (=3D count 1) (string=3D s (upcase s)))) + (setq count (1+ count)) s) + (t + (setq count 0) + (if (string-match "[[:alpha:]]" s) + (format "[%s%s]" (upcase s) (downcase s)) + (regexp-quote s)))))) + regexp "")))))) + (defun hi-lock-set-pattern (regexp face &optional case-fold) - "Highlight REGEXP with face FACE." + "Highlight REGEXP with face FACE. +If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) - (let ((pattern (list (if (eq case-fold 'undefined) + (let* ((pattern (list (if (eq case-fold 'undefined) regexp - (byte-compile - `(lambda (limit) - (let ((case-fold-search ,case-fold)) - (re-search-forward ,regexp limit t))))) - (list 0 (list 'quote face) 'prepend)))) + (cons regexp + (byte-compile + `(lambda (limit) + (let ((case-fold-search ,case-fold)) + (re-search-forward ,regexp limit t)))= ))) + (list 0 (list 'quote face) 'prepend))) + (regexp-fold + (cond ((not (consp (car pattern))) + (car pattern)) + (t + (if (not case-fold) + (caar pattern) + (hi-lock--case-insensitive-regexp (caar pattern))))))) ;; Refuse to highlight a text that is already highlighted. - (if (assoc regexp hi-lock-interactive-patterns) + (if (or (assoc regexp hi-lock-interactive-patterns) + (assoc regexp-fold hi-lock-interactive-patterns) + (assoc regexp-fold (mapcar #'car hi-lock-interactive-patterns)= )) (add-to-list 'hi-lock--unused-faces (face-name face)) - (push pattern hi-lock-interactive-patterns) (if (and font-lock-mode (font-lock-specified-p major-mode)) - (progn + (progn + (setq pattern (list regexp-fold (list 0 (list 'quote face) 'pr= epend))) (font-lock-add-keywords nil (list pattern) t) (font-lock-flush)) (let* ((range-min (- (point) (/ hi-lock-highlight-range 2))) @@ -725,7 +799,8 @@ hi-lock-set-pattern (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)))))))))) + (goto-char (match-end 0))))))) + (push pattern hi-lock-interactive-patterns)))) =20 (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." diff --git a/lisp/isearch.el b/lisp/isearch.el index 250d37b45e..2496e092a6 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1940,15 +1940,7 @@ isearch-highlight-regexp (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 "")) + isearch-string) (t (regexp-quote isearch-string))))) (hi-lock-face-buffer regexp (hi-lock-read-face-name) (if (and (eq isearch-case-fold-search t) diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el index 2cb662cfac..1d97e1f054 100644 --- a/test/lisp/hi-lock-tests.el +++ b/test/lisp/hi-lock-tests.el @@ -22,6 +22,7 @@ =20 (require 'ert) (require 'hi-lock) +(eval-when-compile (require 'cl-lib)) =20 (ert-deftest hi-lock-bug26666 () "Test for http://debbugs.gnu.org/26666 ." @@ -29,12 +30,98 @@ (with-temp-buffer (insert "a A b B\n") (cl-letf (((symbol-function 'completing-read) - (lambda (prompt coll x y z hist defaults) - (car defaults)))) + (lambda (prompt coll x y z hist defaults) + (car defaults)))) (dotimes (_ 2) (let ((face (hi-lock-read-face-name))) (hi-lock-set-pattern "a" face)))) (should (equal hi-lock--unused-faces (cdr faces)))))) =20 +(defun hi-lock--count (face) + (let ((count 0)) + (save-excursion + (goto-char (point-min)) + (cond ((and font-lock-mode (font-lock-specified-p major-mode)) + (when (and (consp (get-text-property (point) 'face)) + (memq 'hi-yellow (get-text-property (point) 'face)= )) + (cl-incf count)) + (while (next-property-change (point)) + (goto-char (next-property-change (point))) + (when (and (consp (get-text-property (point) 'face)) + (memq 'hi-yellow (get-text-property (point) 'fac= e))) + (cl-incf count)))) + (t + (dolist (ov (car (overlay-lists))) + (let ((props (memq 'face (overlay-properties ov)))) + (when (eq (cadr props) face) + (cl-incf count))))))) + count)) + +(defun hi-lock--highlight-and-count (regexp face case-fold) + "Highlight REGEXP with FACE with case fold CASE-FOLD. +Return number of matches." + (hi-lock-unface-buffer t) + (should (eq 0 (hi-lock--count face))) + (hi-lock-face-buffer regexp face case-fold) + (hi-lock--count face)) + +(defun hi-lock--interactive-test-1 (regexp face res ucase cfold) + (hi-lock-unface-buffer t) + (should (eq 0 (hi-lock--count face))) + (cl-letf (((symbol-function 'read-regexp) + (lambda (x y) (ignore x y) regexp)) + ((symbol-function 'hi-lock-read-face-name) + (lambda () face))) + (setq search-upper-case ucase + case-fold-search cfold) + (call-interactively 'hi-lock-face-buffer) + (should (=3D res (hi-lock--count face))))) + +;; Interactive test should not depend on the major mode. +(defun hi-lock--interactive-test (regexp face res ucase cfold) + (lisp-interaction-mode) + (hi-lock--interactive-test-1 regexp face res ucase cfold) + (fundamental-mode) + (hi-lock--interactive-test-1 regexp face res ucase cfold)) + +;; In batch calls to `hi-lock-face-buffer', case is given by +;; its third argument. In interactive calls, case depends +;; on `search-upper-case' and `case-fold-search'. +(ert-deftest hi-lock-face-buffer-test () + "Test for http://debbugs.gnu.org/22541 ." + (let ((face 'hi-yellow) + (regexp "a") + case-fold-search search-upper-case) + (with-temp-buffer + (insert "a A\n") + (should (=3D 1 (hi-lock--highlight-and-count regexp face nil))) + (should (=3D 2 (hi-lock--highlight-and-count regexp face t))) + ;; Case depends on the regexp. + (hi-lock--interactive-test regexp face 2 t nil) + (hi-lock--interactive-test "A" face 1 t nil) + (hi-lock--interactive-test "\\A" face 2 t nil) + ;; Case depends on `case-fold-search'. + (hi-lock--interactive-test "a" face 1 nil nil) + (hi-lock--interactive-test "A" face 1 nil nil) + (hi-lock--interactive-test "\\A" face 1 nil nil) + ;; + (hi-lock--interactive-test "a" face 2 nil t) + (hi-lock--interactive-test "A" face 2 nil t) + (hi-lock--interactive-test "\\A" face 2 nil t)))) + +(ert-deftest hi-lock-bug22520 () + "Test for http://debbugs.gnu.org/22520 ." + (with-temp-buffer + (erase-buffer) + (insert "foo and Foo") + (dolist (ucase '(nil t)) + (dolist (cfold '(nil t)) + (let ((res (cond ((null ucase) + (if cfold 2 1)) + (t 2)))) + (hi-lock--interactive-test "f" 'hi-yellow res ucase cfold) + (hi-lock-unface-buffer "f") + (should (=3D 0 (hi-lock--count 'hi-yellow)))))))) + (provide 'hi-lock-tests) ;;; hi-lock-tests.el ends here --=20 2.11.0 --8<-----------------------------cut here---------------end--------------->= 8--- In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11) of 2017-04-27 Repository revision: 79c5ea9911a9aba7db0ba0e367e06507cee2fc02