From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: =?UTF-8?Q?Jo=C3=A3o_?= =?UTF-8?Q?T=C3=A1vora?= Newsgroups: gmane.emacs.bugs Subject: bug#47711: bug#48841: bug#47711: bug#48841: bug#47711: [PATCH VERSION 2] Add new `completion-filter-completions` API and deferred highlighting Date: Fri, 27 Oct 2023 00:27:12 +0100 Message-ID: <87v8atarsf.fsf@gmail.com> References: <3d3f894f-a6fa-53ae-5d50-c3aa9bffc73e@daniel-mendler.de> <56ab18b1-4348-9b2c-85bb-af9b76cd429a@daniel-mendler.de> <328f87eb-6474-1442-e1ca-9ae8deb2a84a@yandex.ru> <83fsvcbio7.fsf@gnu.org> <9f432d18-e70f-54c1-0173-1899fb66d176@gutov.dev> <877cnafv39.fsf@gmail.com> <8734xy73n7.fsf@gmail.com> <87zg05awbw.fsf@gmail.com> <2703531c-333f-c4a1-837b-c151ef3fd57d@gutov.dev> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="4207"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Daniel Mendler , Eli Zaretskii , Stefan Monnier , 47711@debbugs.gnu.org To: Dmitry Gutov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Oct 27 01:24:54 2023 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 1qw9if-0000oa-Dz for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 27 Oct 2023 01:24:53 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qw9iL-0003wr-Nx; Thu, 26 Oct 2023 19:24:33 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qw9iK-0003wZ-4w for bug-gnu-emacs@gnu.org; Thu, 26 Oct 2023 19:24:32 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qw9iJ-0000gi-0U for bug-gnu-emacs@gnu.org; Thu, 26 Oct 2023 19:24:31 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qw9in-0001gU-NO for bug-gnu-emacs@gnu.org; Thu, 26 Oct 2023 19:25:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: =?UTF-8?Q?Jo=C3=A3o_?= =?UTF-8?Q?T=C3=A1vora?= Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 26 Oct 2023 23:25:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 47711 X-GNU-PR-Package: emacs Original-Received: via spool by 47711-submit@debbugs.gnu.org id=B47711.16983626936457 (code B ref 47711); Thu, 26 Oct 2023 23:25:01 +0000 Original-Received: (at 47711) by debbugs.gnu.org; 26 Oct 2023 23:24:53 +0000 Original-Received: from localhost ([127.0.0.1]:34677 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qw9ie-0001g4-JO for submit@debbugs.gnu.org; Thu, 26 Oct 2023 19:24:53 -0400 Original-Received: from mail-wm1-x329.google.com ([2a00:1450:4864:20::329]:46562) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qw9ic-0001fn-53 for 47711@debbugs.gnu.org; Thu, 26 Oct 2023 19:24:51 -0400 Original-Received: by mail-wm1-x329.google.com with SMTP id 5b1f17b1804b1-4083f613272so11839015e9.1 for <47711@debbugs.gnu.org>; Thu, 26 Oct 2023 16:24:18 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1698362653; x=1698967453; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=W9JykNBaCOlM1IYXFyC5XGsPv0K710Mzdx6V3p/pKII=; b=Coes1XQ/rPsW5ywW9iD2P0dODPK8F/F63ZnHR3g1/VRnpNL56B0yWNSQ7Di5VNawAw ToxzqxogeaDdfaDMOzBo7CtrsqZ6kGT9DFqKTtZI1NsAu1PZ0ZVJ4DCkoRTme6aIpzCa 7QB9pQa+jhyy0DcuBeBHyW5EAKuTqXSan85r7aJXFXbDsKfv9BPJyeQ7i3KqVIv9eWt8 mIrs4afhDK2wcvaFl2QQvyNUMAS6yd3JX6SwSkIQ30sVOczvYyZN72LTdyo0atof/O1c onO8n8mZTYm1+5PwTYrGLwOaA/6VgrWIa+ebS2jiCmNz7RT10qmE/qxeYs2IY6B/vuNi gAyg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1698362653; x=1698967453; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=W9JykNBaCOlM1IYXFyC5XGsPv0K710Mzdx6V3p/pKII=; b=KMKeTZCtcj7rA7Bl7uUQa3WBq91pRrtRRgCLXM6+tvIMeAvlnOz7daz5LwMThMkdwX 4DT3Z2mFO1nSALoLqrF6CaOV5Yptg0M27Vozl7bqtkOBMr/pTllGFnJC/zHSt3ujcUWC WmzhSWx/w3kDiwM6Xl2DOJxRPe6r5+NWpepfSfyqBAik2AwqxdID2etgteD1HaYugw3x kzRo5uQDhVY3RVk88xg0tK07atX6vdl+UjYyEq7Y2ZqN8PrlvTIYMcrgbVEHKa1MQ/Gz yIqyT3IsVd87azYTi39V2B0KJ5tIaXvgzX7ZmGqARKe4yHPoxJ7aWjppS/Y5VpdYfPEV 7leA== X-Gm-Message-State: AOJu0Ywh39M5Te7mw1v+6NLxDfuaYGrNLQ18I5qiW+MiIyhFshOxrdeb wqVkliIwCJyEAITiubjB3uDOQMC59dt5BA== X-Google-Smtp-Source: AGHT+IHu3wjaeiBn7vxw4biETViomqDHYqCqLFzVpPM02kwPtNBNO+U08gndHWBcDINz55lwsuSDIQ== X-Received: by 2002:a05:600c:4fcb:b0:405:367d:4656 with SMTP id o11-20020a05600c4fcb00b00405367d4656mr951267wmq.29.1698362652435; Thu, 26 Oct 2023 16:24:12 -0700 (PDT) Original-Received: from krug (87-196-80-249.net.novis.pt. [87.196.80.249]) by smtp.gmail.com with ESMTPSA id m11-20020a05600c4f4b00b0040651505684sm196527wmq.29.2023.10.26.16.24.11 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 26 Oct 2023 16:24:11 -0700 (PDT) In-Reply-To: <2703531c-333f-c4a1-837b-c151ef3fd57d@gutov.dev> (Dmitry Gutov's message of "Fri, 27 Oct 2023 02:10:48 +0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:273323 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Dmitry Gutov writes: > My understanding is it's due to the judicious call (copy-sequence > orig) that you added before 'put-text-property' is called. While it > seems like a good idea to preserve the original value, when almost all > of obarray matches the current input (which is the current scenario), > a lot of strings will be copied. You're right, I reproduced the regression. I thought I had taken out the copy-sequence, but forgot it there. In an earlier stage I suspected that I needed the copy, but I don't think I do. Please try this new patch that removes it. I've also pushed it to the feature/completion-lazy-hilit branch. Jo=C3=A3o --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=lazy-hilit-2023-v3.diff diff --git a/lisp/icomplete.el b/lisp/icomplete.el index e6fdd1f1836..3e888c8b06a 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -722,7 +722,8 @@ icomplete-exhibit ;; Check if still in the right buffer (bug#61308) (or (window-minibuffer-p) completion-in-region--data) (icomplete-simple-completing-p)) ;Shouldn't be necessary. - (let ((saved-point (point))) + (let ((saved-point (point)) + (completion-lazy-hilit t)) (save-excursion (goto-char (icomplete--field-end)) ;; Insert the match-status information: @@ -754,12 +755,13 @@ icomplete-exhibit (overlay-end rfn-eshadow-overlay))) (let* ((field-string (icomplete--field-string)) (text (while-no-input + (benchmark-progn (icomplete-completions field-string (icomplete--completion-table) (icomplete--completion-predicate) (if (window-minibuffer-p) - (eq minibuffer--require-match t))))) + (eq minibuffer--require-match t)))))) (buffer-undo-list t) deactivate-mark) ;; Do nothing if while-no-input was aborted. @@ -901,7 +903,7 @@ icomplete--render-vertical 'icomplete-selected-match 'append comp) collect (concat prefix (make-string (- max-prefix-len (length prefix)) ? ) - comp + (completion-lazy-hilit comp) (make-string (- max-comp-len (length comp)) ? ) suffix) into lines-aux @@ -1067,7 +1069,8 @@ icomplete-completions (if (< prospects-len prospects-max) (push comp prospects) (setq limit t))) - (setq prospects (nreverse prospects)) + (setq prospects + (nreverse (mapcar #'completion-lazy-hilit prospects))) ;; Decorate first of the prospects. (when prospects (let ((first (copy-sequence (pop prospects)))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 2120e31775e..ecde00dd28d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1234,6 +1234,7 @@ completion-all-completions POINT is the position of point within STRING. The return value is a list of completions and may contain the base-size in the last `cdr'." + (setq completion-lazy-hilit-fn nil) ;; FIXME: We need to additionally return the info needed for the ;; second part of completion-base-position. (completion--nth-completion 2 string table pred point metadata)) @@ -3720,21 +3721,32 @@ completion-pcm--all-completions ;; Use all-completions to do an initial cull. This is a big win, ;; since all-completions is written in C! - (let* (;; Convert search pattern to a standard regular expression. - (regex (completion-pcm--pattern->regex pattern)) - (case-fold-search completion-ignore-case) - (completion-regexp-list (cons regex completion-regexp-list)) - (compl (all-completions - (concat prefix - (if (stringp (car pattern)) (car pattern) "")) - table pred))) - (if (not (functionp table)) - ;; The internal functions already obeyed completion-regexp-list. - compl - (let ((poss ())) - (dolist (c compl) - (when (string-match-p regex c) (push c poss))) - (nreverse poss)))))) + (let* ((case-fold-search completion-ignore-case) + (completion-regexp-list (cons + ;; Convert search pattern to a + ;; standard regular expression. + (completion-pcm--pattern->regex pattern) + completion-regexp-list)) + (completions (all-completions + (concat prefix + (if (stringp (car pattern)) (car pattern) "")) + table pred))) + (cond ((or (not (functionp table)) + (cl-loop for e in pattern never (stringp e))) + ;; The internal functions already obeyed completion-regexp-list. + completions) + (t + ;; The pattern has something interesting to match, in + ;; which case we take the opportunity to add an early + ;; completion-score cookie to each completion. + (cl-loop with re = (completion-pcm--pattern->regex pattern 'group) + for comp in completions + for score = (completion--flex-score comp re t) + when score + do (put-text-property 0 1 'completion-score + score + comp) + and collect comp)))))) (defvar flex-score-match-tightness 3 "Controls how the `flex' completion style scores its matches. @@ -3749,108 +3761,195 @@ flex-score-match-tightness than the latter (which has two \"holes\" and three one-letter-long matches).") +(defvar-local completion-lazy-hilit nil + "If non-nil, request completion lazy highlighting. + +Completion-presenting frontends may opt to bind this variable to +non-nil value in the context of completion-producing calls (such +as `completion-all-sorted-completions'). This hints the +intervening completion styles that they do not need to +fontify (i.e. propertize with the `face' property) completion +strings with highlights of the matching parts. + +When doing so, it is the frontend -- not the style -- who becomes +responsible this fontification. The frontend binds this variable +to non-nil, and calls the function with the same name +`completion-lazy-hilit' on each completion string that is to be +displayed to the user. + +Note that only some completion styles take advantage of this +variable for optimization purposes. Other styles will ignore the +hint and greedily fontify as usual. It is still safe for a +frontend to call `completion-lazy-hilit' in these situations. + +To author a completion style that takes advantage see +`completion-lazy-hilit-fn' and look in the source of +`completion-pcm--hilit-commonality'.") + +(defvar completion-lazy-hilit-fn nil + "Used by completions styles to honouring `completion-lazy-hilit'. +When a given style wants to enable support for +`completion-lazy-hilit' (which see), that style should set this +variable to a function of one argument, a fresh string to be +displayed to the user. The function is responsible for +destructively highlighting the string.") + +(defun completion-lazy-hilit (str) + "Return a copy of completion STR that is `face'-propertized. +See documentation for variable `completion-lazy-hilit' for more +details." + (if (and completion-lazy-hilit completion-lazy-hilit-fn) + (funcall completion-lazy-hilit-fn (copy-sequence str)) + str)) + +(defun completion--hilit-from-re (string regexp) + "Fontify STRING with `completions-common-part' using REGEXP." + (let* ((md (and regexp (string-match regexp string) (cddr (match-data t)))) + (me (and md (match-end 0))) + (from 0)) + (while md + (add-face-text-property from (pop md) 'completions-common-part nil string) + (setq from (pop md))) + (unless (or (not me) (= from me)) + (add-face-text-property from me 'completions-common-part nil string)) + string)) + +(defun completion--flex-score-1 (md-groups match-end len) + "Compute matching score of completion. +The score lies in the range between 0 and 1, where 1 corresponds to +the full match. +MD-GROUPS is the \"group\" part of the match data. +MATCH-END is the end of the match. +LEN is the length of the completion string." + (let* ((from 0) + ;; To understand how this works, consider these simple + ;; ascii diagrams showing how the pattern "foo" + ;; flex-matches "fabrobazo", "fbarbazoo" and + ;; "barfoobaz": + + ;; f abr o baz o + ;; + --- + --- + + + ;; f barbaz oo + ;; + ------ ++ + + ;; bar foo baz + ;; +++ + + ;; "+" indicates parts where the pattern matched. A + ;; "hole" in the middle of the string is indicated by + ;; "-". Note that there are no "holes" near the edges + ;; of the string. The completion score is a number + ;; bound by (0..1] (i.e., larger than (but not equal + ;; to) zero, and smaller or equal to one): the higher + ;; the better and only a perfect match (pattern equals + ;; string) will have score 1. The formula takes the + ;; form of a quotient. For the numerator, we use the + ;; number of +, i.e. the length of the pattern. For + ;; the denominator, it first computes + ;; + ;; hole_i_contrib = 1 + (Li-1)^(1/tightness) + ;; + ;; , for each hole "i" of length "Li", where tightness + ;; is given by `flex-score-match-tightness'. The + ;; final value for the denominator is then given by: + ;; + ;; (SUM_across_i(hole_i_contrib) + 1) * len + ;; + ;; , where "len" is the string's length. + (score-numerator 0) + (score-denominator 0) + (last-b 0)) + (while (and md-groups (car md-groups)) + (let ((a from) + (b (pop md-groups))) + (setq + score-numerator (+ score-numerator (- b a))) + (unless (or (= a last-b) + (zerop last-b) + (= a len)) + (setq + score-denominator (+ score-denominator + 1 + (expt (- a last-b 1) + (/ 1.0 + flex-score-match-tightness))))) + (setq + last-b b)) + (setq from (pop md-groups))) + ;; If `pattern' doesn't have an explicit trailing any, the + ;; regex `re' won't produce match data representing the + ;; region after the match. We need to account to account + ;; for that extra bit of match (bug#42149). + (unless (= from match-end) + (let ((a from) + (b match-end)) + (setq + score-numerator (+ score-numerator (- b a))) + (unless (or (= a last-b) + (zerop last-b) + (= a len)) + (setq + score-denominator (+ score-denominator + 1 + (expt (- a last-b 1) + (/ 1.0 + flex-score-match-tightness))))) + (setq + last-b b))) + (/ score-numerator (* len (1+ score-denominator)) 1.0))) + +(defvar completion--flex-score-last-md nil + "Helper variable for `completion--flex-score'.") + +(defun completion--flex-score (str re &optional dont-error) + "Compute flex score of completion STR based on RE. +If DONT-ERROR, just return nil if RE doesn't match STR." + (cond ((string-match re str) + (let* ((match-end (match-end 0)) + (md (cddr + (setq + completion--flex-score-last-md + (match-data t completion--flex-score-last-md))))) + (completion--flex-score-1 md match-end (length str)))) + ((not dont-error) + (error "Internal error: %s does not match %s" re str)))) + (defun completion-pcm--hilit-commonality (pattern completions) "Show where and how well PATTERN matches COMPLETIONS. PATTERN, a list of symbols and strings as seen `completion-pcm--merge-completions', is assumed to match every -string in COMPLETIONS. Return a deep copy of COMPLETIONS where -each string is propertized with `completion-score', a number -between 0 and 1, and with faces `completions-common-part', -`completions-first-difference' in the relevant segments." +string in COMPLETIONS. + +If `completion-lazy-hilit' is nil, return a deep copy of +COMPLETIONS where each string is propertized with +`completion-score', a number between 0 and 1, and with faces +`completions-common-part', `completions-first-difference' in the +relevant segments. + +Else, if `completion-lazy-hilit' is t, return COMPLETIONS where +each string now has a `completion-score' property and no +highlighting." (cond ((and completions (cl-loop for e in pattern thereis (stringp e))) (let* ((re (completion-pcm--pattern->regex pattern 'group)) - (point-idx (completion-pcm--pattern-point-idx pattern)) - (case-fold-search completion-ignore-case) - last-md) - (mapcar - (lambda (str) - ;; Don't modify the string itself. - (setq str (copy-sequence str)) - (unless (string-match re str) - (error "Internal error: %s does not match %s" re str)) - (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0))) - (match-end (match-end 0)) - (md (cddr (setq last-md (match-data t last-md)))) - (from 0) - (end (length str)) - ;; To understand how this works, consider these simple - ;; ascii diagrams showing how the pattern "foo" - ;; flex-matches "fabrobazo", "fbarbazoo" and - ;; "barfoobaz": - - ;; f abr o baz o - ;; + --- + --- + - - ;; f barbaz oo - ;; + ------ ++ - - ;; bar foo baz - ;; +++ - - ;; "+" indicates parts where the pattern matched. A - ;; "hole" in the middle of the string is indicated by - ;; "-". Note that there are no "holes" near the edges - ;; of the string. The completion score is a number - ;; bound by (0..1] (i.e., larger than (but not equal - ;; to) zero, and smaller or equal to one): the higher - ;; the better and only a perfect match (pattern equals - ;; string) will have score 1. The formula takes the - ;; form of a quotient. For the numerator, we use the - ;; number of +, i.e. the length of the pattern. For - ;; the denominator, it first computes - ;; - ;; hole_i_contrib = 1 + (Li-1)^(1/tightness) - ;; - ;; , for each hole "i" of length "Li", where tightness - ;; is given by `flex-score-match-tightness'. The - ;; final value for the denominator is then given by: - ;; - ;; (SUM_across_i(hole_i_contrib) + 1) * len - ;; - ;; , where "len" is the string's length. - (score-numerator 0) - (score-denominator 0) - (last-b 0) - (update-score-and-face - (lambda (a b) - "Update score and face given match range (A B)." - (add-face-text-property a b - 'completions-common-part - nil str) - (setq - score-numerator (+ score-numerator (- b a))) - (unless (or (= a last-b) - (zerop last-b) - (= a (length str))) - (setq - score-denominator (+ score-denominator - 1 - (expt (- a last-b 1) - (/ 1.0 - flex-score-match-tightness))))) - (setq - last-b b)))) - (while md - (funcall update-score-and-face from (pop md)) - (setq from (pop md))) - ;; If `pattern' doesn't have an explicit trailing any, the - ;; regex `re' won't produce match data representing the - ;; region after the match. We need to account to account - ;; for that extra bit of match (bug#42149). - (unless (= from match-end) - (funcall update-score-and-face from match-end)) - (if (> (length str) pos) - (add-face-text-property - pos (1+ pos) - 'completions-first-difference - nil str)) - (unless (zerop (length str)) - (put-text-property - 0 1 'completion-score - (/ score-numerator (* end (1+ score-denominator)) 1.0) str))) - str) - completions))) + (score-maybe (lambda (str) + (unless (get-text-property 0 'completion-score str) + (put-text-property 0 1 'completion-score + (completion--flex-score str re) + str))))) + (cond (completion-lazy-hilit + (setq completion-lazy-hilit-fn + (lambda (str) (completion--hilit-from-re str re))) + (mapc score-maybe completions)) + (t + (mapcar + (lambda (str) + (setq str (copy-sequence str)) + (funcall score-maybe str) + (completion--hilit-from-re str re) + str) + completions))))) (t completions))) (defun completion-pcm--find-all-completions (string table pred point --=-=-=--