From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Daniel Mendler Newsgroups: gmane.emacs.devel Subject: [PATCH] `completion-all-sorted-completions`: Add support for completion boundaries Date: Sat, 24 Apr 2021 22:14:27 +0200 Message-ID: <9beb1aa3-d934-c3ae-7c26-26256e34ae43@daniel-mendler.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------A309EA22CE68028ACE5AE64C" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="38488"; mail-complaints-to="usenet@ciao.gmane.io" To: "emacs-devel@gnu.org" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sat Apr 24 22:16:21 2021 Return-path: Envelope-to: ged-emacs-devel@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 1laOhR-0009sb-90 for ged-emacs-devel@m.gmane-mx.org; Sat, 24 Apr 2021 22:16:21 +0200 Original-Received: from localhost ([::1]:35228 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1laOhQ-000504-An for ged-emacs-devel@m.gmane-mx.org; Sat, 24 Apr 2021 16:16:20 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:36016) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1laOfm-0004SY-My for emacs-devel@gnu.org; Sat, 24 Apr 2021 16:14:38 -0400 Original-Received: from server.qxqx.de ([2a01:4f8:121:346::180]:44919 helo=mail.qxqx.de) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1laOfg-0005yc-D8 for emacs-devel@gnu.org; Sat, 24 Apr 2021 16:14:38 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=qxqx.de; s=mail1392553390; h=Content-Type:MIME-Version:Date:Message-ID:Subject:From:To :Sender:Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=Wd7ZmoOFb1N3tGsHA2FQTgYMZmV28eCQE9RFuBuTOds=; b=VDe3geEPW4JmSi1HIZpzEKh793 AZoT5nxd6w3iqSkrC8LFkBI46NO27K86IcroPC4De3lfJJpXTqRBb6jx5aHYMkLFtP0/Q2GbsOsUF hilkkycszhMlU8ty2EFl9RuNofZA+hfHYsUw04L5JVcf6gDZCq+sZJNTUfLDELgw+Apc=; Content-Language: en-US Received-SPF: pass client-ip=2a01:4f8:121:346::180; envelope-from=mail@daniel-mendler.de; helo=mail.qxqx.de X-Spam_score_int: -41 X-Spam_score: -4.2 X-Spam_bar: ---- X-Spam_report: (-4.2 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:268342 Archived-At: This is a multi-part message in MIME format. --------------A309EA22CE68028ACE5AE64C Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit I attached a patch which adds support for completion boundaries to the sorting by history position. Tests are included. Daniel --------------A309EA22CE68028ACE5AE64C Content-Type: text/x-diff; charset=UTF-8; name="0001-completion-all-sorted-completions-Add-completion-bou.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-completion-all-sorted-completions-Add-completion-bou.pa"; filename*1="tch" >From 73be13a758ef6a43c5b8ac52de2b2c0205e2f21c Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 20 Apr 2021 00:01:44 +0200 Subject: [PATCH] (completion-all-sorted-completions): Add completion boundary support lisp/minibuffer.el (completion-all-sorted-completions): The history is preprocessed by the function `minibuffer--sort-preprocess-history`. The default value is prepended to the history. The completion base prefix string is removed from the history elements. This allows sorting by history position for completion tables which use completion boundaries, in particular the file completion table. test/lisp/minibuffer-tests.el (completion-all-sorted-completions): Add tests for various combinations of with/without history/base/default. --- lisp/minibuffer.el | 36 +++++++++++++++++++-------- test/lisp/minibuffer-tests.el | 46 +++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 10 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 51e0519d48..24f7326a99 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1381,6 +1381,26 @@ minibuffer--sort-by-length-alpha (and (= (length c1) (length c2)) (string< c1 c2)))))) +(defun minibuffer--sort-preprocess-history (base) + "Preprocess history. +Remove completion BASE prefix string from history elements." + (let* ((def (if (stringp minibuffer-default) + minibuffer-default + (car-safe minibuffer-default))) + (hist (and (not (eq minibuffer-history-variable t)) + (symbol-value minibuffer-history-variable))) + (base-size (length base))) + ;; Drop base string from the history elements + (when (/= base-size 0) + (setq hist (delq nil (mapcar + (lambda (c) + (when (string-prefix-p base c) + (substring c base-size))) + hist)))) + ;; Default comes first + (setq hist (if def (cons def hist) hist)) + hist)) + (defun completion-all-sorted-completions (&optional start end) (or completion-all-sorted-completions (let* ((start (or start (minibuffer-prompt-end))) @@ -1410,21 +1430,17 @@ completion-all-sorted-completions (setq all (delete-dups all)) (setq last (last all)) - (cond - (sort-fun - (setq all (funcall sort-fun all))) - (t + (if sort-fun + (setq all (funcall sort-fun all)) ;; Sort first by length and alphabetically. (setq all (minibuffer--sort-by-length-alpha all)) - ;; Sort by history position, put the default, if it ;; exists, on top. - (when (and (minibufferp) (not (eq minibuffer-history-variable t))) - (let ((def (car-safe minibuffer-default)) - (hist (symbol-value minibuffer-history-variable))) + (when (minibufferp) (setq all (minibuffer--sort-by-position - (if def (cons def hist) hist) - all)))))) + (minibuffer--sort-preprocess-history + (substring string 0 base-size)) + all)))) ;; Cache the result. This is not just for speed, but also so that ;; repeated calls to minibuffer-force-complete can cycle through diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 027711c21e..03520c2b74 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -136,5 +136,51 @@ completion-pcm--optimize-pattern (should (equal (completion-pcm--optimize-pattern '(any "" any)) '(any)))) +(defun test-completion-all-sorted-completions (base def history-var history-list) + (with-temp-buffer + (insert base) + (cl-letf (((symbol-function #'minibufferp) (lambda (&rest _) t))) + (let ((completion-styles '(basic)) + (completion-category-defaults nil) + (completion-category-overrides nil) + (minibuffer-history-variable history-var) + (minibuffer-history history-list) + (minibuffer-default def) + (minibuffer-completion-table + (lambda (str pred action) + (pcase action + (`(boundaries . ,_) `(boundaries ,(length base) . 0)) + (_ (complete-with-action action + '(epsilon alpha gamma beta delta) + (substring str (length base)) pred)))))) + (completion-all-sorted-completions))))) + +(ert-deftest completion-all-sorted-completions () + ;; No base, disabled history, no default + (should (equal (test-completion-all-sorted-completions + "" nil t nil) + `("beta" "alpha" "delta" "gamma" "epsilon" . 0))) + ;; No base, disabled history, default string + (should (equal (test-completion-all-sorted-completions + "" "gamma" t nil) + `("gamma" "beta" "alpha" "delta" "epsilon" . 0))) + ;; No base, empty history, default string + (should (equal (test-completion-all-sorted-completions + "" "gamma" 'minibuffer-history nil) + `("gamma" "beta" "alpha" "delta" "epsilon" . 0))) + ;; No base, empty history, default list + (should (equal (test-completion-all-sorted-completions + "" '("gamma" "zeta") 'minibuffer-history nil) + `("gamma" "beta" "alpha" "delta" "epsilon" . 0))) + ;; No base, history, default string + (should (equal (test-completion-all-sorted-completions + "" "gamma" 'minibuffer-history '("other" "epsilon" "delta")) + `("gamma" "epsilon" "delta" "beta" "alpha" . 0))) + ;; Base, history, default string + (should (equal (test-completion-all-sorted-completions + "base/" "gamma" 'minibuffer-history + '("some/alpha" "base/epsilon" "base/delta")) + `("gamma" "epsilon" "delta" "beta" "alpha" . 5)))) + (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here -- 2.20.1 --------------A309EA22CE68028ACE5AE64C--