unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Daniel Mendler <mail@daniel-mendler.de>
To: Juri Linkov <juri@linkov.net>
Cc: Gregory Heytings <gregory@heytings.org>,
	"emacs-devel@gnu.org" <emacs-devel@gnu.org>,
	Stefan Monnier <monnier@iro.umontreal.ca>,
	Dmitry Gutov <dgutov@yandex.ru>
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	[thread overview]
Message-ID: <24f3b5e7-3e5e-d00f-3fc4-9d093ca1dc10@daniel-mendler.de> (raw)
In-Reply-To: <69fd42ed-a1a0-adcb-ac8b-caad80cb0967@daniel-mendler.de>

[-- Attachment #1: Type: text/plain, Size: 621 bytes --]

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

[-- Attachment #2: 0002-completion-insert-strings-Split-function-Full-group-.patch --]
[-- Type: text/x-diff, Size: 13454 bytes --]

From 48c8a45ced265812a8aa6bbaf23bc17b5c3b3da4 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
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


  reply	other threads:[~2021-04-30  9:00 UTC|newest]

Thread overview: 81+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-04-25 13:32 [PATCH] `completing-read`: Add `group-function` support to completion metadata Daniel Mendler
2021-04-25 19:35 ` Dmitry Gutov
2021-04-25 19:47   ` Daniel Mendler
2021-04-25 21:50     ` Dmitry Gutov
2021-04-25 22:10       ` Daniel Mendler
2021-04-25 22:40         ` Dmitry Gutov
2021-04-25 22:58           ` Daniel Mendler
2021-04-26  4:51             ` Protesilaos Stavrou
2021-04-27 16:53               ` Juri Linkov
2021-04-28  6:18                 ` Protesilaos Stavrou
2021-04-25 23:33           ` Stefan Monnier
2021-04-26 10:01             ` Daniel Mendler
2021-04-26 13:50               ` Stefan Monnier
2021-04-27  1:46             ` Dmitry Gutov
2021-04-27  1:59               ` tumashu
2021-04-27  2:45                 ` Daniel Mendler
2021-04-27 15:47                 ` Dmitry Gutov
2021-04-27  3:41               ` Stefan Monnier
2021-04-28  0:08                 ` Dmitry Gutov
2021-04-28  3:21                   ` Stefan Monnier
2021-04-25 19:38 ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH) Daniel Mendler
2021-04-25 20:45   ` Juri Linkov
2021-04-25 21:26     ` Daniel Mendler
2021-04-29 16:20   ` Juri Linkov
2021-04-29 16:52     ` Daniel Mendler
2021-04-29 17:07     ` Stefan Monnier
2021-04-29 17:13       ` Daniel Mendler
2021-04-29 22:54         ` Juri Linkov
2021-04-29 23:55           ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2) Daniel Mendler
2021-04-30  9:00             ` Daniel Mendler [this message]
2021-04-30 17:01               ` Juri Linkov
2021-04-30 18:11                 ` Daniel Mendler
2021-04-30 18:30                   ` Daniel Mendler
2021-05-01 19:57                     ` Juri Linkov
2021-05-02  0:43                       ` Daniel Mendler
2021-05-02  7:07                         ` Eli Zaretskii
2021-05-02 11:01                           ` Daniel Mendler
2021-04-30 16:51             ` Juri Linkov
2021-04-30 18:13               ` Daniel Mendler
2021-05-01 19:54                 ` Juri Linkov
2021-05-02  0:32                   ` Daniel Mendler
2021-05-02 21:38                     ` Juri Linkov
2021-05-07 17:03                       ` Juri Linkov
2021-05-07 17:55                         ` Daniel Mendler
2021-05-08  6:24                           ` Daniel Mendler
2021-05-08  8:45                             ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4) Daniel Mendler
2021-05-08  9:10                               ` Daniel Mendler
2021-05-09 17:59                                 ` Juri Linkov
2021-05-09 18:50                                   ` Daniel Mendler
2021-05-09 18:56                                     ` Stefan Monnier
2021-05-09 19:11                                       ` Daniel Mendler
2021-05-10 20:47                                     ` Juri Linkov
2021-05-11  7:51                                       ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 5) Daniel Mendler
2021-05-11 17:59                                         ` Juri Linkov
2021-05-08 13:15                         ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2) Stefan Monnier
2021-05-09 18:05                           ` Juri Linkov
2021-05-09 18:37                             ` Eli Zaretskii
2021-05-11 18:06                               ` Juri Linkov
2021-05-11 18:44                                 ` Eli Zaretskii
2021-05-11 18:58                                   ` Daniel Mendler
2021-05-11 19:22                                     ` Eli Zaretskii
2021-05-11 19:46                                       ` Daniel Mendler
2021-05-11 19:59                                         ` Eli Zaretskii
2021-05-11 20:30                                           ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 6) Daniel Mendler
2021-05-13 10:32                                             ` Eli Zaretskii
2021-05-13 11:45                                               ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 7) Daniel Mendler
2021-05-20  9:39                                                 ` Daniel Mendler
2021-05-20 17:53                                                   ` Juri Linkov
2021-05-20 18:51                                                     ` Daniel Mendler
2021-04-29 17:09     ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH) Dmitry Gutov
2021-04-29 17:16       ` Daniel Mendler
2021-04-29 17:55         ` Dmitry Gutov
2021-04-29 18:31           ` [External] : " Drew Adams
2021-04-29 20:25             ` Dmitry Gutov
2021-04-29 22:15               ` Drew Adams
2021-04-29 22:28                 ` Dmitry Gutov
2021-04-29 23:31                   ` Drew Adams
2021-04-29 19:21           ` Daniel Mendler
2021-05-02 14:29   ` [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 3) Daniel Mendler
2021-05-02 21:49     ` Juri Linkov
2021-05-03 14:40       ` Daniel Mendler

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=24f3b5e7-3e5e-d00f-3fc4-9d093ca1dc10@daniel-mendler.de \
    --to=mail@daniel-mendler.de \
    --cc=dgutov@yandex.ru \
    --cc=emacs-devel@gnu.org \
    --cc=gregory@heytings.org \
    --cc=juri@linkov.net \
    --cc=monnier@iro.umontreal.ca \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).