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: Tue, 25 Apr 2017 14:22:10 +0900 Message-ID: <87pog112pp.fsf@calancha-pc> References: <87si1a2tod.fsf@secretsauce.net> <8760x7vyui.fsf@mail.linkov.net> <87vapwipy4.fsf@calancha-pc> <87shkyems1.fsf@localhost> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1493097806 4300 195.159.176.226 (25 Apr 2017 05:23:26 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 25 Apr 2017 05:23:26 +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 Tue Apr 25 07:23:18 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 1d2swU-0000l0-GZ for geb-bug-gnu-emacs@m.gmane.org; Tue, 25 Apr 2017 07:23:14 +0200 Original-Received: from localhost ([::1]:47128 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d2swW-0000KN-S5 for geb-bug-gnu-emacs@m.gmane.org; Tue, 25 Apr 2017 01:23:16 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:57848) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d2swN-0000KG-Tr for bug-gnu-emacs@gnu.org; Tue, 25 Apr 2017 01:23:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d2swI-0008H5-Rn for bug-gnu-emacs@gnu.org; Tue, 25 Apr 2017 01:23:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:40534) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d2swI-0008Gw-NC for bug-gnu-emacs@gnu.org; Tue, 25 Apr 2017 01:23:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d2swI-0007lT-IB for bug-gnu-emacs@gnu.org; Tue, 25 Apr 2017 01:23:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 25 Apr 2017 05:23:02 +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.149309774629784 (code B ref 22541); Tue, 25 Apr 2017 05:23:02 +0000 Original-Received: (at 22541) by debbugs.gnu.org; 25 Apr 2017 05:22:26 +0000 Original-Received: from localhost ([127.0.0.1]:38733 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d2svi-0007kJ-03 for submit@debbugs.gnu.org; Tue, 25 Apr 2017 01:22:26 -0400 Original-Received: from mail-pg0-f52.google.com ([74.125.83.52]:33725) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d2svf-0007k3-NG for 22541@debbugs.gnu.org; Tue, 25 Apr 2017 01:22:24 -0400 Original-Received: by mail-pg0-f52.google.com with SMTP id 63so22821751pgh.0 for <22541@debbugs.gnu.org>; Mon, 24 Apr 2017 22:22:23 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:in-reply-to:references:user-agent:date :message-id:mime-version; bh=SI7xKN1V/mud17lXGX1iZ3qzKmY9h0URP63F43SK9Os=; b=BhmG2Ob9bQN97OUhuTvVSWBGo0GVDWzodNi48iduJO7T4pxtQc836qP9C0vusMPwtW H0JcRxDDYPmVFRFNEfXMkb4JAxVV7cAh8HE1koKVueV9Pvl+soWVUn5b4pV3IhVY/HSj GR3HEWJyL4/m0w7cLisHTBmB69R1TOuHFY8FZzVixusuqvrLll7pAhF/uuTcetSJiKYM JaPZ60qNq+qT2hNFY0AwyhVGQIfxzUviCcEz/A5juneIeOFotUUbJjXfqtDZX97qzB55 apoPAU+sGcbS2V7/LrqmMn5NA1jCvTJx7dqpx9N6aQ/yzWdWWs1GyW6cCSywkEqEksJu ziTQ== 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:in-reply-to:references :user-agent:date:message-id:mime-version; bh=SI7xKN1V/mud17lXGX1iZ3qzKmY9h0URP63F43SK9Os=; b=DuOlTZ7SniGQxtI2LfGankpXoAr2MboEuCn4T0xcte4/VbjpXB04cNtXFcO35buvn8 QiSAXrwaBzI0uxcGkcHUBLKpqxoAeQOYu1IdCl/KH+WtWp1lmh26AeBgN2IcKiY86yl5 cEn0AVxosFtyCc4xT2353CKx8EraW2saYDvdH5gVRTw8IEDvTdCtG/XsVGrPCcCOCuRK 5m+2N+xeCxRmSY+zxKo/ZLVvaB9mAvlwksPphK14H+Ul5wWJ1wFynzTTo5BujHwtHLXi R8KgTCZz7QgKvtJE2RREkrZHcI6/WnQZooeMxqSuSC+rRTGtJ7rHjBhiUTqP2y4u3uJ0 n4JQ== X-Gm-Message-State: AN3rC/5MWFDQGWjDfl3gtIayr3cPI2wKrbJsD0RuSvgKtPB2h5NNAGCf Qo1BDzUwiPjcLw== X-Received: by 10.99.157.138 with SMTP id i132mr27105663pgd.87.1493097736831; Mon, 24 Apr 2017 22:22:16 -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 202sm33693380pgh.21.2017.04.24.22.22.13 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 24 Apr 2017 22:22:15 -0700 (PDT) In-Reply-To: <87shkyems1.fsf@localhost> (Juri Linkov's message of "Mon, 24 Apr 2017 02:18: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:131948 Archived-At: Juri Linkov writes: >> I think is a good moment to comeback to this issue once we have already >> released Emacs 25.2. >> I have updated your patch so that hi-lock-face-buffer checks search-upper-case >> in interactive calls. It works OK. >> Since there isn't recent activity in the implementation of the pcre-style >> embedded modifiers, we might use your patch in the meantime. > > Thank you for taking care of this issue. If in your tests it works > as expected, then I suppose this is the way to go. I updated the patch to make work `hi-lock-unface-buffer'. I added tests as well. Note that in interactive calls the case fold is determined with the variables `search-upper-case' and `case-fold-search'. This way it behaves as `isearch-forward-regexp'. Before this bug case fold was determined _just_ with `case-fold-search'. Do you prefer avoid `search-upper-case' in this case? --8<-----------------------------cut here---------------start------------->8--- >From 7cad27c0fcc39add8679d0893010c4fdb3ed507a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 25 Apr 2017 14:17:23 +0900 Subject: [PATCH] highlight-regexp: Honor case-fold-search 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, hi-lock-set-pattern): Add optional arg CASE-FOLD. All callers updated. (hi-lock--regexps-at-point, hi-lock-unface-buffer): Handle when pattern is a cons (REGEXP . FUNCTION). * lisp/isearch.el (isearch-highlight-regexp): Call hi-lock-face-buffer with 3 arguments. Co-authored-by: Tino Calancha --- lisp/hi-lock.el | 99 ++++++++++++++++++++++++++++++++++++++------------------- lisp/isearch.el | 7 +++- 2 files changed, 73 insertions(+), 33 deletions(-) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index ebd18621ef..c9e0428f01 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -432,8 +432,9 @@ 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. +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. @@ -441,13 +442,18 @@ 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))) + (let* ((reg + (hi-lock-regexp-okay + (read-regexp "Regexp to highlight" 'regexp-history-last))) + (face (hi-lock-read-face-name)) + (fold + (if search-upper-case + (isearch-no-upper-case-p reg t) + case-fold-search))) + (list reg face fold))) (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)) ;;;###autoload (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -530,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)) (defvar-local hi-lock--unused-faces nil "List of faces that is not used and is available for highlighting new text. @@ -561,13 +574,16 @@ 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 (if (consp (car pattern)) + (caar 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 @@ -581,16 +597,24 @@ 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)))) + (mapcar (lambda (x) + (if (consp (car x)) (caar x) (car x))) + 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)))) + nil nil nil nil defaults)))))) + (let ((keys + (mapcar (lambda (x) + (if (consp (car x)) + (cons (caar x) (cdr x)) + x)) + hi-lock-interactive-patterns))) + (dolist (keyword (if (eq regexp t) keys + (list (assoc regexp keys)))) (when keyword (let ((face (hi-lock-keyword->face keyword))) ;; Make `face' the next one to use by default. @@ -606,7 +630,7 @@ hi-lock-unface-buffer (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword))) - (font-lock-flush)))) + (font-lock-flush))))) ;;;###autoload (defun hi-lock-write-interactive-patterns () @@ -689,15 +713,25 @@ hi-lock-read-face-name (add-to-list 'hi-lock-face-defaults face t)) (intern face))) -(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 it." ;; 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)))) ;; Refuse to highlight a text that is already highlighted. (unless (assoc regexp hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns) - (if (and font-lock-mode (font-lock-specified-p major-mode)) + (if (and font-lock-mode + (font-lock-specified-p major-mode) + (not (consp pattern))) (progn (font-lock-add-keywords nil (list pattern) t) (font-lock-flush)) @@ -711,12 +745,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-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)))))))))) (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))) -- 2.11.0 >From f0f68d2a2049b549a6690f411dd746cb4333f99b Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Tue, 25 Apr 2017 14:18:00 +0900 Subject: [PATCH] * test/lisp/hi-lock-tests.el: Add test. --- test/lisp/hi-lock-tests.el | 90 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 90 insertions(+) create mode 100644 test/lisp/hi-lock-tests.el diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el new file mode 100644 index 0000000000..836fbe9a89 --- /dev/null +++ b/test/lisp/hi-lock-tests.el @@ -0,0 +1,90 @@ +;;; hi-lock-tests.el --- Tests for hi-lock.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Tino Calancha +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'ert) +(require 'hi-lock) +(eval-when-compile (require 'cl-lib)) + +(defun hi-lock--count (face) + (let ((count 0)) + (save-excursion + (goto-char (point-min)) + (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 (= 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 (= 1 (hi-lock--highlight-and-count regexp face nil))) + (should (= 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)))) + +(provide 'hi-lock-tests) +;;; hi-lock-tests.el ends here -- 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-25 Repository revision: 622c24a2b75a564b9861fc3ca7a7878741e8568d