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: Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2) Date: Fri, 30 Apr 2021 11:00:20 +0200 Message-ID: <24f3b5e7-3e5e-d00f-3fc4-9d093ca1dc10@daniel-mendler.de> References: <0bbdeece-90d5-160c-07ec-2ad8edbf9872@daniel-mendler.de> <87czudm7bv.fsf@mail.linkov.net> <976056e8-3d46-db27-32c2-ddf3ca32d5a7@daniel-mendler.de> <878s5090e9.fsf@mail.linkov.net> <69fd42ed-a1a0-adcb-ac8b-caad80cb0967@daniel-mendler.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------9BDA553A50AE2051D88DAE4D" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="25307"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Gregory Heytings , "emacs-devel@gnu.org" , Stefan Monnier , Dmitry Gutov To: Juri Linkov Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Fri Apr 30 11:03:27 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 1lcP3W-0006TR-SJ for ged-emacs-devel@m.gmane-mx.org; Fri, 30 Apr 2021 11:03:27 +0200 Original-Received: from localhost ([::1]:57292 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lcP3V-0005uf-Sn for ged-emacs-devel@m.gmane-mx.org; Fri, 30 Apr 2021 05:03:25 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:43954) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lcP0h-0004M8-2r for emacs-devel@gnu.org; Fri, 30 Apr 2021 05:00:31 -0400 Original-Received: from server.qxqx.de ([2a01:4f8:121:346::180]:55649 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 1lcP0d-0005sb-IU for emacs-devel@gnu.org; Fri, 30 Apr 2021 05:00:30 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=qxqx.de; s=mail1392553390; h=Content-Type:In-Reply-To:MIME-Version:Date:Message-ID: References:Cc:To:From:Subject:Sender:Reply-To:Content-Transfer-Encoding: Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender: Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=Z2Mq2n+mJ7tYvAoIXqYGVm6NmtEQxHZ7SeE/hUy/Z6Q=; b=eAjcDsVLG65JJCfXOH9dAfVCic lqwycn+e9/MfE7lDFvjCUJcmWcWiwFl6QbwydH01WrzgIz5qLrTbinp7rJ5UwR+bnwCqqd+fjUwUm Ikkg/dkiHjrRgH5jGxAufeUi8R2vPq5vnQjfLNsLSrKtztNcBLFQbqhjSVk1lMf04d58=; In-Reply-To: <69fd42ed-a1a0-adcb-ac8b-caad80cb0967@daniel-mendler.de> 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:268658 Archived-At: This is a multi-part message in MIME format. --------------9BDA553A50AE2051D88DAE4D Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 7bit On 4/30/21 1:55 AM, Daniel Mendler wrote: > Yes, this should be added. The current patch contains a TODO above the > `completion--insert-strings` function. I intend to rework the > `completion--insert-strings` function, splitting it into three > functions, one for each format. This should make this code easier to > maintain. Then I will also add support for group titles. I will > implement a second patch, which implements these changes. I attached the patch which splits `completion--insert-strings` into a function per completions format and adds group title support for the vertical and horizontal format. Daniel --------------9BDA553A50AE2051D88DAE4D Content-Type: text/x-diff; charset=UTF-8; name="0002-completion-insert-strings-Split-function-Full-group-.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0002-completion-insert-strings-Split-function-Full-group-.pa"; filename*1="tch" >From 48c8a45ced265812a8aa6bbaf23bc17b5c3b3da4 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 30 Apr 2021 08:40:59 +0200 Subject: [PATCH] (completion--insert-strings): Split function; Full group title support Split `completion--insert-strings` into a function per completions format in order to increase readability and extensibility. This change eases the addition of more formats. Add support for group titles to the vertical and horizontal format. * minibuffer.el (completion--insert): Add new function. (completion--insert-vertical, completion--insert-horizontal, completion--insert-one-column): Extract new function from `completion--insert-strings`. Use `completion--insert`. (completion--insert-strings): Use new insertion functions. --- lisp/minibuffer.el | 269 ++++++++++++++++++++++++++------------------- 1 file changed, 154 insertions(+), 115 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index c1f6a7d64e..986657e7ad 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1789,21 +1789,16 @@ completions-detailed :type 'boolean :version "28.1") -;; TODO: Split up this function in one function per `completions-format'. -;; TODO: Add group title support for horizontal and vertical format. (defun completion--insert-strings (strings &optional group-fun) "Insert a list of STRINGS into the current buffer. Uses columns to keep the listing readable but compact. It also eliminates runs of equal strings. GROUP-FUN is a `group-function' used for grouping the completion." (when (consp strings) - ;; FIXME: Currently grouping is enabled only for the 'one-column format. - (unless (eq completions-format 'one-column) - (setq group-fun nil)) (let* ((length (apply #'max (mapcar (lambda (s) (if (consp s) - (apply #'+ (mapcar #'string-width s)) + (apply #'+ (mapcar #'string-width s)) (string-width s))) strings))) (window (get-buffer-window (current-buffer) 0)) @@ -1814,126 +1809,170 @@ completion--insert-strings ;; Don't allocate more columns than we can fill. ;; Windows can't show less than 3 lines anyway. (max 1 (/ (length strings) 2)))) - (colwidth (/ wwidth columns)) - (column 0) - (last-title nil) - (rows (/ (length strings) columns)) - (row 0) - (first t) - (laststring nil)) + (colwidth (/ wwidth columns))) (unless (or tab-stop-list (null completion-tab-width) (zerop (mod colwidth completion-tab-width))) ;; Align to tab positions for the case ;; when the caller uses tabs inside prefix. (setq colwidth (- colwidth (mod colwidth completion-tab-width)))) - ;; The insertion should be "sensible" no matter what choices were made - ;; for the parameters above. - (dolist (str strings) - ;; Add group titles. + (funcall (intern (format "completion--insert-%s" completions-format)) + strings group-fun length wwidth colwidth columns)))) + +(defun completion--insert-horizontal (strings group-fun + length wwidth + colwidth _columns) + (let ((column 0) + (first t) + (last-title nil) + (last-string nil)) + (dolist (str strings) + (unless (equal last-string str) ; Remove (consecutive) duplicates. + (setq last-string str) (when group-fun (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) (unless (equal title last-title) + (setq last-title title) (when title - (insert (format completions-group-format title) "\n")) - (setq last-title title)))) - (unless (equal laststring str) ; Remove (consecutive) duplicates. - (setq laststring str) + (insert (if first "" "\n") (format completions-group-format title) "\n") + (setq column 0 + first t))))) + (unless first ;; FIXME: `string-width' doesn't pay attention to ;; `display' properties. - (let ((length (if (consp str) - (apply #'+ (mapcar #'string-width str)) - (string-width str)))) - (cond - ((eq completions-format 'one-column) - ;; Nothing special - ) - ((eq completions-format 'vertical) - ;; Vertical format - (when (> row rows) - (forward-line (- -1 rows)) - (setq row 0 column (+ column colwidth))) - (when (> column 0) - (end-of-line) - (while (> (current-column) column) - (if (eobp) - (insert "\n") - (forward-line 1) - (end-of-line))) - (insert " \t") - (set-text-properties (1- (point)) (point) - `(display (space :align-to ,column))))) - (t - ;; Horizontal format - (unless first - (if (< wwidth (+ (max colwidth length) column)) - ;; No space for `str' at point, move to next line. - (progn (insert "\n") (setq column 0)) - (insert " \t") - ;; Leave the space unpropertized so that in the case we're - ;; already past the goal column, there is still - ;; a space displayed. - (set-text-properties (1- (point)) (point) - ;; We can set tab-width using - ;; completion-tab-width, but - ;; the caller can prefer using - ;; \t to align prefixes. - `(display (space :align-to ,column))) - nil)))) - (setq first nil) - (if (not (consp str)) - (add-text-properties - (point) - (progn - (insert - (if group-fun - (funcall group-fun str 'transform) - str)) - (point)) - `(mouse-face highlight completion--string ,str)) - ;; If `str' is a list that has 2 elements, - ;; then the second element is a suffix annotation. - ;; If `str' has 3 elements, then the second element - ;; is a prefix, and the third element is a suffix. - (let* ((prefix (when (nth 2 str) (nth 1 str))) - (suffix (or (nth 2 str) (nth 1 str)))) - (when prefix - (let ((beg (point)) - (end (progn (insert prefix) (point)))) - (put-text-property beg end 'mouse-face nil))) - (add-text-properties - (point) - (progn - (insert - (if group-fun - (funcall group-fun (car str) 'transform) - (car str))) - (point)) - `(mouse-face highlight completion--string ,(car str))) - (let ((beg (point)) - (end (progn (insert suffix) (point)))) - (put-text-property beg end 'mouse-face nil) - ;; Put the predefined face only when suffix - ;; is added via annotation-function without prefix, - ;; and when the caller doesn't use own face. - (unless (or prefix (text-property-not-all - 0 (length suffix) 'face nil suffix)) - (font-lock-prepend-text-property - beg end 'face 'completions-annotations))))) - (cond - ((eq completions-format 'one-column) - (insert "\n")) - ((eq completions-format 'vertical) - ;; Vertical format - (if (> column 0) - (forward-line) - (insert "\n")) - (setq row (1+ row))) - (t - ;; Horizontal format - ;; Next column to align to. - (setq column (+ column - ;; Round up to a whole number of columns. - (* colwidth (ceiling length colwidth)))))))))))) + (if (< wwidth (+ column (max colwidth + (if (consp str) + (apply #'+ (mapcar #'string-width str)) + (string-width str))))) + ;; No space for `str' at point, move to next line. + (progn (insert "\n") (setq column 0)) + (insert " \t") + ;; Leave the space unpropertized so that in the case we're + ;; already past the goal column, there is still + ;; a space displayed. + (set-text-properties (1- (point)) (point) + ;; We can set tab-width using + ;; completion-tab-width, but + ;; the caller can prefer using + ;; \t to align prefixes. + `(display (space :align-to ,column))) + nil)) + (setq first nil) + (completion--insert str group-fun) + ;; Next column to align to. + (setq column (+ column + ;; Round up to a whole number of columns. + (* colwidth (ceiling length colwidth)))))))) + +(defun completion--insert-vertical (strings group-fun + _length _wwidth + colwidth columns) + (let ((column 0) + (rows (/ (length strings) columns)) + (row 0) + (last-title nil) + (last-string nil) + (start-point (point)) + (next 0) (pos 0)) + (dolist (str strings) + (unless (equal last-string str) ; Remove (consecutive) duplicates. + (setq last-string str) + (when (> row rows) + (goto-char start-point) + (setq row 0 column (+ column colwidth))) + (when group-fun + (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) + (unless (equal title last-title) + (setq last-title title) + (when title + ;; Align before title insertion + (when (> column 0) + (end-of-line) + (while (> (current-column) column) + (if (eobp) + (insert "\n") + (forward-line 1) + (end-of-line))) + (insert " \t") + (set-text-properties (1- (point)) (point) + `(display (space :align-to ,column)))) + (let* ((fmt completions-group-format) + (len (length fmt))) + ;; Adjust display space for columns + (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right)) + (setq fmt (substring fmt)) + (put-text-property (- len 1) len + 'display + `(space :align-to ,(+ colwidth column -1)) + fmt)) + (insert (format fmt title))) + ;; Align after title insertion + (if (> column 0) + (forward-line) + (insert "\n")))))) + ;; Align before candidate insertion + (when (> column 0) + (end-of-line) + (while (> (current-column) column) + (if (eobp) + (insert "\n") + (forward-line 1) + (end-of-line))) + (insert " \t") + (set-text-properties (1- (point)) (point) + `(display (space :align-to ,column)))) + (completion--insert str group-fun) + ;; Align after candidate insertion + (if (> column 0) + (forward-line) + (insert "\n")) + (setq row (1+ row)))))) + +(defun completion--insert-one-column (strings group-fun &rest _) + (let ((last-title nil) (last-string nil)) + (dolist (str strings) + (unless (equal last-string str) ; Remove (consecutive) duplicates. + (setq last-string str) + (when group-fun + (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) + (unless (equal title last-title) + (setq last-title title) + (when title + (insert (format completions-group-format title) "\n"))))) + (completion--insert str group-fun) + (insert "\n"))))) + +(defun completion--insert (str group-fun) + (if (not (consp str)) + (add-text-properties + (point) + (progn + (insert + (if group-fun + (funcall group-fun str 'transform) + str)) + (point)) + `(mouse-face highlight completion--string ,str)) + ;; If `str' is a list that has 2 elements, + ;; then the second element is a suffix annotation. + ;; If `str' has 3 elements, then the second element + ;; is a prefix, and the third element is a suffix. + (let* ((prefix (when (nth 2 str) (nth 1 str))) + (suffix (or (nth 2 str) (nth 1 str)))) + (when prefix + (let ((beg (point)) + (end (progn (insert prefix) (point)))) + (put-text-property beg end 'mouse-face nil))) + (completion--insert (car str) group-fun) + (let ((beg (point)) + (end (progn (insert suffix) (point)))) + (put-text-property beg end 'mouse-face nil) + ;; Put the predefined face only when suffix + ;; is added via annotation-function without prefix, + ;; and when the caller doesn't use own face. + (unless (or prefix (text-property-not-all + 0 (length suffix) 'face nil suffix)) + (font-lock-prepend-text-property + beg end 'face 'completions-annotations)))))) (defvar completion-setup-hook nil "Normal hook run at the end of setting up a completion list buffer. -- 2.20.1 --------------9BDA553A50AE2051D88DAE4D--