master 15ac51e0fd: Merge branch 'feature/completions-customs'

[Juri Linkov]

branch: master
commit 15ac51e0fd385130a0764481290d04a71aad5e88
Merge: 966ec5dae6 eba9c473a8
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    Merge branch 'feature/completions-customs'
---
 doc/emacs/mini.texi   | 37 +++++++++++++++++++--
 doc/lispref/text.texi | 11 +++++++
 etc/NEWS              | 32 ++++++++++++++++++
 lisp/minibuffer.el    | 84 +++++++++++++++++++++++++++++++++++------------
 lisp/simple.el        | 90 +++++++++++++++++++++++++++++++++++++++------------
 5 files changed, 212 insertions(+), 42 deletions(-)

diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index 13d9269c68..24517262fa 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -624,11 +624,18 @@ completion alternatives in the completion list.
 @vindex completion-auto-help
   If @code{completion-auto-help} is set to @code{nil}, the completion
 commands never display the completion list buffer; you must type
-@kbd{?}  to display the list.  If the value is @code{lazy}, Emacs only
+@kbd{?} to display the list.  If the value is @code{lazy}, Emacs only
 shows the completion list buffer on the second attempt to complete.
 In other words, if there is nothing to complete, the first @key{TAB}
 echoes @samp{Next char not unique}; the second @key{TAB} shows the
-completion list buffer.
+completion list buffer.  With the previous values and the default
+@code{t} the completions are hidden when some unique completion is
+executed.  If @code{completion-auto-help} is set to @code{always}, the
+completion commands are always shown after a completion attempt, or
+updated if they are already visible.  If the value is @code{visible},
+then completions are not hidden, but updated if they are already
+visible while the current behavior stays the same as default if they
+are not.
 
 @vindex completion-cycle-threshold
   If @code{completion-cycle-threshold} is non-@code{nil}, completion
@@ -651,6 +658,32 @@ changed by changing the @code{completions-format} user 
option.  If
 @code{vertical}, sort the completions vertically in columns instead,
 and if @code{one-column}, just use a single column.
 
+@vindex completions-max-height
+  When @code{completions-max-height} is non-@code{nil}, it limits the
+size of the completions window.  It is specified in lines and include
+mode, header line and a bottom divider, if any.  For a more complex
+control of the Completion window display properties, you can use
+@code{display-buffer-alist} (@pxref{Buffer Display Action
+Alists,,Action Alists for Buffer Display, elisp, The Emacs Lisp
+Reference Manual}).
+
+@vindex completions-header-format
+The variable @code{completions-header-format} is a formatted string to
+control the informative line shown before the completions list of
+candidates.  It may contain a @code{%s} to show the total number of
+completions.  When it is @code{nil}, the message is totally suppressed.
+Text properties may be added to change the appearance, some useful
+ones are @code{face} or @code{cursor-intangible} (@pxref{Special
+Properties,,Properties with Special Meanings, elisp, The Emacs Lisp
+Reference Manual}).
+
+@vindex completions-highlight-face
+When @code{completions-highlight-face} is a face name, then the
+current completion candidate will be highlighted with that face.  The
+default value is @code{completions-highlight}.  When the value is
+@code{nil}, no highlighting is performed.  This feature sets the text
+property @code{cursor-face}.
+
 @node Minibuffer History
 @section Minibuffer History
 @cindex minibuffer history
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 7897adeb05..edb75b453c 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3551,6 +3551,17 @@ that alter the text size (e.g., @code{:height}, 
@code{:weight}, and
 @code{:slant}).  Those attributes are always the same as for the
 unhighlighted text.
 
+@item cursor-face
+@kindex cursor-face @r{(text property)}
+This property is similar to @code{mouse-face}, but the face is used if
+the cursor (instead of mouse) is on or near the character.  Near has
+the same meaning that in @code{mouse-face} and the highlighting only
+takes effect if the mode @code{cursor-face-highlight-mode} is enabled;
+otherwise no highlighting is performed.  When the variable
+@code{cursor-face-highlight-nonselected-window} is non-@code{nil}, the
+text is highlighted even if the window is not selected that is similar
+to @code{highlight-nonselected-windows} for the region.
+
 @item fontified
 @kindex fontified @r{(text property)}
 This property says whether the text is ready for display.  If
diff --git a/etc/NEWS b/etc/NEWS
index 1ae231afdb..ebf1346dae 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -577,6 +577,31 @@ This option controls the sorting of the completion 
candidates in
 the "*Completions*" buffer.  Available styles are no sorting,
 alphabetical (the default), or a custom sort function.
 
++++
+*** New values for the 'completion-auto-help' option.
+There are two new values to control the way "*Completions*" behave after
+a <tab> if completion is not unique.  'always' updates or shows
+the "*Completions*" buffer after any attempt to complete.  'visual' is
+like 'always', but only update the completions if they are already
+visible.  The default value 't' always hides the completion buffer after
+some completion is made.
+
++++
+*** New user option 'completions-max-height'.
+This option limits the height of the "*Completions*" buffer.
+
++++
+*** New option 'completions-header-format'
+This is a string to control the message to show before completions.
+It may contain a "%s" to show the total number of completions. If nil no
+completions are shown.
+
++++
+*** New option 'completions-highlight-face'.
+When this variable is a face name, it highlights the current candidate
+in the "*Completions*" buffer with that face.  When the value is nil,
+no highlighting is performed at all.
+
 ** Isearch and Replace
 
 +++
@@ -1301,6 +1326,13 @@ property.
 ** New 'min-width' 'display' property.
 This allows setting a minimum display width for a region of text.
 
++++
+** New 'cursor-face' text property.
+This uses 'cursor-face' instead of the default face when cursor is on or
+near the character and 'cursor-face-highlight-mode' is enabled.  The
+variable 'cursor-face-highlight-nonselected-window' is similar to
+'highlight-nonselected-windows', but for this property.
+
 +++
 ** New event type 'touch-end'.
 This event is sent whenever the user's finger moves off the mouse
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 36b8d80841..00d4560865 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -897,8 +897,17 @@ If the current buffer is not a minibuffer, erase its 
entire contents."
 If the value is t the *Completions* buffer is displayed whenever completion
 is requested but cannot be done.
 If the value is `lazy', the *Completions* buffer is only displayed after
-the second failed attempt to complete."
-  :type '(choice (const nil) (const t) (const lazy)))
+the second failed attempt to complete.
+If the value is 'always', the completion commands are always shown
+after a completion attempt, or updated if they are already visible.
+If the value is 'visible', then completions are not hidden, but updated
+if they are already visible while the current behavior stays the same
+as default if they are not."
+  :type '(choice (const :tag "Disabled" nil)
+                 (const :tag "Enabled legacy" t)
+                 (const :tag "After a second attempt" lazy)
+                 (const :tag "Visible update" visible)
+                 (const :tag "Always update" always)))
 
 (defvar completion-styles-alist
   '((emacs21
@@ -1343,16 +1352,18 @@ when the buffer's text is already an exact match."
               (completion--cache-all-sorted-completions beg end comps)
               (minibuffer-force-complete beg end))
              (completed
-              ;; We could also decide to refresh the completions,
-              ;; if they're displayed (and assuming there are
-              ;; completions left).
-              (minibuffer-hide-completions)
-              (if exact
-                  ;; If completion did not put point at end of field,
-                  ;; it's a sign that completion is not finished.
-                  (completion--done completion
-                                    (if (< comp-pos (length completion))
-                                        'exact 'unknown))))
+              (cond
+               ((pcase completion-auto-help
+                  ('visible (get-buffer-window "*Completions*" 0))
+                  ('always t))
+                (minibuffer-completion-help beg end))
+               (t (minibuffer-hide-completions)
+                  (when exact
+                    ;; If completion did not put point at end of field,
+                    ;; it's a sign that completion is not finished.
+                    (completion--done completion
+                                      (if (< comp-pos (length completion))
+                                          'exact 'unknown))))))
              ;; Show the completion table, if requested.
              ((not exact)
              (if (pcase completion-auto-help
@@ -1842,6 +1853,17 @@ Return nil if there is no valid completion, else t."
 This face is only used if the strings used for completions
 doesn't already specify a face.")
 
+(defface completions-highlight
+  '((t :inherit highlight))
+  "Default face for highlighting the current completion candidate."
+  :version "29.1")
+
+(defcustom completions-highlight-face 'completions-highlight
+  "A face name to highlight the current completion candidate.
+If the value is nil, no highlighting is performed."
+  :type '(choice (const nil) face)
+  :version "29.1")
+
 (defcustom completions-format 'horizontal
   "Define the appearance and sorting of completions.
 If the value is `vertical', display completions sorted vertically
@@ -1861,6 +1883,17 @@ completions."
   :type 'boolean
   :version "28.1")
 
+(defcustom completions-header-format
+  (propertize "%s possible completions:\n"
+              'face 'shadow
+              :help "Please select a completion")
+  "Format of completions header.
+It may contain one %s to show the total count of completions.
+When nil, no header is shown."
+  :type '(choice (const :tag "No header" nil)
+                 (string :tag "Header format string"))
+  :version "29.1")
+
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
 The candidate strings are inserted into the buffer depending on the
@@ -2012,7 +2045,7 @@ Runs of equal candidate strings are eliminated.  
GROUP-FUN is a
               (funcall group-fun str 'transform)
             str))
          (point))
-       `(mouse-face highlight completion--string ,str))
+       `(mouse-face highlight cursor-face ,completions-highlight-face 
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
@@ -2123,10 +2156,9 @@ candidates."
 
     (with-current-buffer standard-output
       (goto-char (point-max))
-      (if (null completions)
-          (insert "There are no possible completions of what you have typed.")
-        (insert "Possible completions are:\n")
-        (completion--insert-strings completions group-fun))))
+      (when completions-header-format
+        (insert (format completions-header-format (length completions))))
+      (completion--insert-strings completions group-fun)))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2198,6 +2230,19 @@ variables.")
                (equal pre-msg (and exit-fun (current-message))))
       (completion--message message))))
 
+(defcustom completions-max-height nil
+  "Maximum height for *Completions* buffer window."
+  :type '(choice (const nil) natnum)
+  :version "29.1")
+
+(defun completions--fit-window-to-buffer (&optional win &rest _)
+  "Resize *Completions* buffer window."
+  (if temp-buffer-resize-mode
+      (let ((temp-buffer-max-height (or completions-max-height
+                                        temp-buffer-max-height)))
+        (resize-temp-buffer-window win))
+    (fit-window-to-buffer win completions-max-height)))
+
 (defun minibuffer-completion-help (&optional start end)
   "Display a list of possible completions of the current minibuffer contents."
   (interactive)
@@ -2261,9 +2306,7 @@ variables.")
              ,(if (eq (selected-window) (minibuffer-window))
                   'display-buffer-at-bottom
                 'display-buffer-below-selected))
-            ,(if temp-buffer-resize-mode
-                 '(window-height . resize-temp-buffer-window)
-               '(window-height . fit-window-to-buffer))
+            (window-height . completions--fit-window-to-buffer)
             ,(when temp-buffer-resize-mode
                '(preserve-size . (nil . t)))
             (body-function
@@ -2354,6 +2397,7 @@ variables.")
   "Get rid of an out-of-date *Completions* buffer."
   ;; FIXME: We could/should use minibuffer-scroll-window here, but it
   ;; can also point to the minibuffer-parent-window, so it's a bit tricky.
+  (interactive)
   (let ((win (get-buffer-window "*Completions*" 0)))
     (if win (with-selected-window win (bury-buffer)))))
 
diff --git a/lisp/simple.el b/lisp/simple.el
index 43a0d1efc1..59c86cf778 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6483,27 +6483,38 @@ An example is a rectangular region handled as a list of
 separate contiguous regions for each line."
   (cdr (region-bounds)))
 
+(defun redisplay--unhighlight-overlay-function (rol)
+  "If ROL is an overlay, call `delete-overlay'."
+  (when (overlayp rol) (delete-overlay rol)))
+
 (defvar redisplay-unhighlight-region-function
-  (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
+  #'redisplay--unhighlight-overlay-function
+  "Function to remove the region-highlight overlay.")
+
+(defun redisplay--highlight-overlay-function (start end window rol &optional 
face)
+  "Update the overlay ROL in WINDOW with FACE in range START-END."
+  (unless face (setq face 'region))
+  (if (not (overlayp rol))
+      (let ((nrol (make-overlay start end)))
+        (funcall redisplay-unhighlight-region-function rol)
+        (overlay-put nrol 'window window)
+        (overlay-put nrol 'face face)
+        ;; Normal priority so that a large region doesn't hide all the
+        ;; overlays within it, but high secondary priority so that if it
+        ;; ends/starts in the middle of a small overlay, that small overlay
+        ;; won't hide the region's boundaries.
+        (overlay-put nrol 'priority '(nil . 100))
+        nrol)
+    (unless (eq (overlay-get rol 'face) face)
+      (overlay-put rol 'face face))
+    (unless (and (eq (overlay-buffer rol) (current-buffer))
+                 (eq (overlay-start rol) start)
+                 (eq (overlay-end rol) end))
+      (move-overlay rol start end (current-buffer)))
+    rol))
 
 (defvar redisplay-highlight-region-function
-  (lambda (start end window rol)
-    (if (not (overlayp rol))
-        (let ((nrol (make-overlay start end)))
-          (funcall redisplay-unhighlight-region-function rol)
-          (overlay-put nrol 'window window)
-          (overlay-put nrol 'face 'region)
-          ;; Normal priority so that a large region doesn't hide all the
-          ;; overlays within it, but high secondary priority so that if it
-          ;; ends/starts in the middle of a small overlay, that small overlay
-          ;; won't hide the region's boundaries.
-          (overlay-put nrol 'priority '(nil . 100))
-          nrol)
-      (unless (and (eq (overlay-buffer rol) (current-buffer))
-                   (eq (overlay-start rol) start)
-                   (eq (overlay-end rol) end))
-        (move-overlay rol start end (current-buffer)))
-      rol))
+  #'redisplay--highlight-overlay-function
   "Function to move the region-highlight overlay.
 This function is called with four parameters, START, END, WINDOW
 and OVERLAY.  If OVERLAY is nil, a new overlay is created.  In
@@ -6528,8 +6539,33 @@ The overlay is returned by the function.")
               (funcall redisplay-highlight-region-function
                        start end window rol)))
         (unless (equal new rol)
-          (set-window-parameter window 'internal-region-overlay
-                                new))))))
+          (set-window-parameter window 'internal-region-overlay new))))))
+
+(defcustom cursor-face-highlight-nonselected-window nil
+  "Non-nil means highlight text with `cursor-face' even in nonselected windows.
+This variable is similar to `highlight-nonselected-windows'."
+  :local t
+  :type 'boolean
+  :version "29.1")
+
+(defun redisplay--update-cursor-face-highlight (window)
+  "Highlights the overlay used to highlight text with cursor-face."
+  (let ((rol (window-parameter window 'internal-cursor-face-overlay)))
+    (if-let* (((or cursor-face-highlight-nonselected-window
+                   (eq window (selected-window))
+                   (and (window-minibuffer-p)
+                        (eq window (minibuffer-selected-window)))))
+              (pt (window-point window))
+              (cursor-face (get-text-property pt 'cursor-face)))
+        (let* ((start (previous-single-property-change
+                       (1+ pt) 'cursor-face nil (point-min)))
+               (end (next-single-property-change
+                     pt 'cursor-face nil (point-max)))
+               (new (redisplay--highlight-overlay-function
+                     start end window rol cursor-face)))
+          (unless (equal new rol)
+            (set-window-parameter window 'internal-cursor-face-overlay new)))
+      (redisplay--unhighlight-overlay-function rol))))
 
 (defvar pre-redisplay-functions (list #'redisplay--update-region-highlight)
   "Hook run just before redisplay.
@@ -6537,6 +6573,15 @@ It is called in each window that is to be redisplayed.  
It takes one argument,
 which is the window that will be redisplayed.  When run, the `current-buffer'
 is set to the buffer displayed in that window.")
 
+(define-minor-mode cursor-face-highlight-mode
+  "When enabled, respect the cursor-face property."
+  :global nil
+  (if cursor-face-highlight-mode
+      (add-hook 'pre-redisplay-functions
+                #'redisplay--update-cursor-face-highlight nil t)
+    (remove-hook 'pre-redisplay-functions
+                 #'redisplay--update-cursor-face-highlight t)))
+
 (defun redisplay--pre-redisplay-functions (windows)
   (with-demoted-errors "redisplay--pre-redisplay-functions: %S"
     (if (null windows)
@@ -9355,6 +9400,11 @@ Called from `temp-buffer-show-hook'."
       (if base-dir (setq default-directory base-dir))
       (when completion-tab-width
         (setq tab-width completion-tab-width))
+      ;; Maybe enable cursor completions-highlight.
+      (when completions-highlight-face
+        ;; Keep highlighting even if not selected.
+        (setq-local cursor-face-highlight-nonselected-window t)
+        (cursor-face-highlight-mode 1))
       ;; Maybe insert help string.
       (when completion-show-help
        (goto-char (point-min))