From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#40337: 28.0.50; Enable case-fold-search in hi-lock Date: Thu, 02 Apr 2020 19:02:33 -0400 Message-ID: References: <87a73xtsqw.fsf@mail.linkov.net> <87pncpa8il.fsf@mail.linkov.net> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="38102"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: 40337@debbugs.gnu.org To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Apr 03 01:04:40 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jK8t5-0009mo-Iu for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 03 Apr 2020 01:04:39 +0200 Original-Received: from localhost ([::1]:48180 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jK8t4-0005Ho-Iw for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 02 Apr 2020 19:04:38 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:39414) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jK8rY-0004YJ-78 for bug-gnu-emacs@gnu.org; Thu, 02 Apr 2020 19:03:05 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jK8rW-0002hm-K9 for bug-gnu-emacs@gnu.org; Thu, 02 Apr 2020 19:03:04 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:57598) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jK8rW-0002hY-Dd for bug-gnu-emacs@gnu.org; Thu, 02 Apr 2020 19:03:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jK8rW-0000im-9R for bug-gnu-emacs@gnu.org; Thu, 02 Apr 2020 19:03:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 02 Apr 2020 23:03:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40337 X-GNU-PR-Package: emacs Original-Received: via spool by 40337-submit@debbugs.gnu.org id=B40337.15858685662681 (code B ref 40337); Thu, 02 Apr 2020 23:03:02 +0000 Original-Received: (at 40337) by debbugs.gnu.org; 2 Apr 2020 23:02:46 +0000 Original-Received: from localhost ([127.0.0.1]:40911 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jK8rG-0000h7-1H for submit@debbugs.gnu.org; Thu, 02 Apr 2020 19:02:46 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:7630) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jK8rD-0000gP-9O for 40337@debbugs.gnu.org; Thu, 02 Apr 2020 19:02:43 -0400 Original-Received: from pmg3.iro.umontreal.ca (localhost [127.0.0.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 8EB8B44FBD6; Thu, 2 Apr 2020 19:02:37 -0400 (EDT) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 5468844FBD2; Thu, 2 Apr 2020 19:02:35 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1585868555; bh=U6gKWI7UdR3UQk65hyF+M9JDvh3cX61unTGcTK9cMBw=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=b2SRM4oIObwum1Wg8/t/Y13r3FCqFauDYrZID9VAZhfcjRcDCxtUvDEigG6XCezzt kmeKi7jxVEYmVsan091BZKRK61h/3JFqiKp8EH5adi30by6599WP7vTW1ZScwhp9RV Bb9JlQ8Ifcbu0+YUKB4CLhQtxROYphCbUpFFvLtFzzsJcJOZ4wQ6gOVtBNcQS49kmu SwHkDRkvgb2qxDO2bSc9/68yZpiguuzdMq/dT8zTDOoBmBby+nUBQws0+GrPWSOvUy s5oN/psrbNGuc9nWAZlkq/5w6BGWyMJDYNcM6R49b0l/+O2f75T6az5YsQ/E8xB+ly nrNiZWPOz1tSg== Original-Received: from alfajor (unknown [104.247.241.114]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id B0E4C12055F; Thu, 2 Apr 2020 19:02:34 -0400 (EDT) In-Reply-To: <87pncpa8il.fsf@mail.linkov.net> (Juri Linkov's message of "Fri, 03 Apr 2020 00:31:38 +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: 209.51.188.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-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:177966 Archived-At: > I tried this, and it works well. Then instead of adding defcustom I copied > all related details from occur to highlight-regexp/highlight-symbol-at-point > and from isearch-occur to isearch-highlight-regexp to make occur/hi-lock > identical in regard how they handle case-folding (docstrings were copied too). Great, the patch looks good. > There is one remaining case that is unclear - whether to use > case-fold-search in hi-lock-process-phrase. Its comment says: > > ;; FIXME fragile; better to just bind case-fold-search? (Bug#7161) > > But according to docstring of highlight-phrase: > > When called interactively, replace whitespace in user-provided > regexp with arbitrary whitespace, and make initial lower-case > letters case-insensitive, before highlighting with `hi-lock-set-pattern'. > > I'm not sure if "make initial lower-case letters case-insensitive" > the same as this code > > (if (and case-fold-search search-upper-case) > (isearch-no-upper-case-p regexp t) > case-fold-search) > > shared between occur and hi-lock in this patch: I think it's a good interpretation of that docstring. If needed we could additionally tweak the docstring to clarify the behavior. Stefan > 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 ()