unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Ergus via "Emacs development discussions." <emacs-devel@gnu.org>
To: Juri Linkov <juri@linkov.net>
Cc: "emacs-devel@gnu.org" <emacs-devel@gnu.org>
Subject: Re: vertical fido-mode (new branch)
Date: Mon, 24 Aug 2020 21:06:54 +0200	[thread overview]
Message-ID: <20200824190654.d5obxfwyehdgpr4u@Ergus> (raw)
In-Reply-To: <87y2m5jlh6.fsf@mail.linkov.net>

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

Hi:

Could you please try the attached patch (where the mode is enabled by default).

On Sun, Aug 23, 2020 at 09:45:17PM +0300, Juri Linkov wrote:
>
>Easier can be only one thing: to use arrows and navigation keys to navigate
>completions from the minibuffer.  So the main question is on what condition
>to activate these keys (instead of allowing them to search in history)?
>
I enabled the keys only when the *Completions* buffer is shown and the
highlight completions is active. And added a hook to remove the bindings
when minibuffer-hide-completions.

>Since making TAB more DWIM doesn't work, what about the following solution:
>activate completions navigation keys and display the completions buffer
>only when there is some input in the minibuffer, i.e. when the minibuffer's
>content is different from its default value.
>
Please try this closer to zsh experience implementation.

>Or similar to this https://api.jqueryui.com/autocomplete/#option-minLength
>activate completions only when input is longer than the minimum number
>of characters.
>

I will give a look.

If this patch is too much code for adding in simple and minibuffer, I
would try to make a separate file with a mode. WDYT?

Best,
Ergus

[-- Attachment #2: completion-highlight.patch --]
[-- Type: text/plain, Size: 14739 bytes --]

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 641a2e5315..cdc1e18708 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -753,6 +753,12 @@ minibuffer-message-clear-timeout
                  (integer :tag "Wait for the number of seconds" 2))
   :version "27.1")
 
+(defcustom minibuffer-tab-go-completion t
+  "If a second `TAB' jump to completion buffer."
+  :type 'boolean
+  :version "28.1"
+  :group 'completion)
+
 (defvar minibuffer-message-timer nil)
 (defvar minibuffer-message-overlay nil)
 
@@ -940,6 +946,8 @@ completion-styles
   :type completion--styles-type
   :version "23.1")
 
+
+
 (defvar completion-category-defaults
   '((buffer (styles . (basic substring)))
     (unicode-name (styles . (basic substring)))
@@ -1272,6 +1280,122 @@ minibuffer-complete
                           minibuffer-completion-table
                           minibuffer-completion-predicate)))
 
+(defmacro with-minibuffer-scroll-window (&rest body)
+  "Execute BODY in *Completions* buffer and return to `minibuffer'.
+The command is only executed if the `minibuffer-scroll-window' is
+alive and active."
+  `(and (window-live-p minibuffer-scroll-window)
+	(eq t (frame-visible-p (window-frame minibuffer-scroll-window)))
+	(with-selected-window minibuffer-scroll-window
+          (with-current-buffer (window-buffer minibuffer-scroll-window)
+            ,@body))))
+
+(defun minibuffer-next-completion (n)
+  "Execute `next-completion' in *Completions*.
+The argument N is passed directly to `next-completion', the
+command is executed in another window, but cursor stays in
+minibuffer."
+  (interactive "p")
+  (with-minibuffer-scroll-window (next-completion n)))
+
+(defun minibuffer-previous-completion (n)
+  "Execute `previous-completion' in *Completions*.
+The argument N is passed directly to `previous-completion', the
+command is executed in another window, but cursor stays in
+minibuffer."
+  (interactive "p")
+  (with-minibuffer-scroll-window (previous-completion n)))
+
+(defun minibuffer-next-line-completion (n)
+  "Execute `next-line-completion' in *Completions*.
+The argument N is passed directly to `next-line-completion', the
+command is executed in another window, but cursor stays in
+minibuffer."
+  (interactive "p")
+  (with-minibuffer-scroll-window (next-line-completion n)))
+
+(defun minibuffer-previous-line-completion (n)
+  "Execute `previous-line-completion' in *Completions*.
+The argument N is passed directly to `previous-line-completion',
+the command is executed in another window, but cursor stays in
+minibuffer."
+  (interactive "p")
+  (with-minibuffer-scroll-window (previous-line-completion n)))
+
+(defun minibuffer-completion-set-suffix (choice)
+  "Set CHOICE suffix to current completion.
+It uses `completion-base-position' to determine the cursor position"
+  (let* ((base-position (or completion-base-position
+                            (list (minibuffer-prompt-end)
+                                  (choose-completion-guess-base-position choice))))
+         (cursor-pos (cadr base-position))
+         (prefix-len (- cursor-pos
+                        (car base-position)))
+         (minibuffer-window (active-minibuffer-window))
+         (minibuffer-buffer (window-buffer minibuffer-window))
+         (completion-no-auto-exit t)
+         (suffix (if (< prefix-len (length choice))
+                     (substring choice prefix-len)
+                   ""))
+         (suffix-len (string-width suffix)))
+
+    (with-selected-window minibuffer-window
+      (with-current-buffer minibuffer-buffer
+
+        (choose-completion-string suffix minibuffer-buffer
+                                  (list cursor-pos (point-max)))
+        (add-face-text-property cursor-pos (+ cursor-pos suffix-len) 'shadow)
+        (goto-char cursor-pos)))))
+
+(defun minibuffer-completion-unset-suffix ()
+  "Remove suffix to current completion.
+It uses `completion-base-position' to determine the cursor position"
+  (minibuffer-completion-set-suffix ""))
+
+(defmacro completions-highlight-minibufer-bindings (set)
+  "Add extra/remove keybindings to `minibuffer-local-must-match-map'."
+  `(progn
+     (define-key minibuffer-local-must-match-map [right] ,(and set ''minibuffer-next-completion))
+     (define-key minibuffer-local-must-match-map [left] ,(and set ''minibuffer-previous-completion))
+     (define-key minibuffer-local-must-match-map [down] ,(and set ''minibuffer-next-line-completion))
+     (define-key minibuffer-local-must-match-map [up] ,(and set ''minibuffer-previous-line-completion))))
+
+(defun completions-highlight-unset-minibuffer-bindings ()
+  "Remove extra keybindings from `minibuffer-local-must-match-map'."
+  (completions-highlight-minibufer-bindings nil))
+
+(defmacro completions-highlight-completion-bindings (set)
+  "Add extra keybindings to `completion-list-mode-map'."
+  `(progn
+     (define-key completion-list-mode-map "\C-g" ,(and set ''quit-window))
+     (define-key completion-list-mode-map [up] ,(and set ''previous-line-completion))
+     (define-key completion-list-mode-map "\C-p" ,(and set ''previous-line-completion))
+     (define-key completion-list-mode-map [down] ,(and set ''next-line-completion))
+     (define-key completion-list-mode-map "\C-n" ,(and set ''next-line-completion))))
+
+(defun completions-highlight-unset-completion-bindings ()
+  "Remove extra keybindings from `completion-list-mode-map'."
+  (completions-highlight-completion-bindings nil))
+
+(defun completions-highlight-minibuffer-complete-setup ()
+  "Add extra functionalities for minibuffer when completions are enabled.
+This is called from `completion-setup-function'"
+  (when (and completion-highlight-candidate
+             (minibufferp))
+    (add-hook 'pre-command-hook
+              (lambda ()
+                ;; TODO: probably we need an alist here
+                ;; (message "Precommand %s" (current-local-map))
+                (unless (eq this-command 'minibuffer-complete-and-exit)
+                  (minibuffer-completion-unset-suffix))
+                )
+              nil t)
+    (add-hook 'minibuffer-hide-completions-hook
+              #'completions-highlight-unset-minibuffer-bindings)
+
+    (completions-highlight-minibufer-bindings t)
+    (completions-highlight-completion-bindings t)))
+
 (defun completion--in-region-1 (beg end)
   ;; If the previous command was not this,
   ;; mark the completion buffer obsolete.
@@ -1288,8 +1412,12 @@ completion--in-region-1
     (let ((window minibuffer-scroll-window))
       (with-current-buffer (window-buffer window)
         (if (pos-visible-in-window-p (point-max) window)
-            ;; If end is in view, scroll up to the beginning.
-            (set-window-start window (point-min) nil)
+            (if (and minibuffer-tab-go-completion
+                     (pos-visible-in-window-p (point-min) window))
+                (minibuffer-next-completion 1)
+                ;; If all completions are visible use tab completion
+              ;; If end is in view, scroll up to the beginning.
+              (set-window-start window (point-min) nil))
           ;; Else scroll down one screen.
           (with-selected-window window
 	    (scroll-up)))
@@ -1776,6 +1904,12 @@ completion-setup-hook
 The completion list buffer is available as the value of `standard-output'.
 See also `display-completion-list'.")
 
+(defvar minibuffer-hide-completions-hook nil
+  "Normal hook run at the end of completion-hide-completions.
+The hook is called from the minibuffer after hide completions.
+When this hook is run, the current buffer is the minibuffer and
+the *Completions* buffer is already hidden.")
+
 (defface completions-first-difference
   '((t (:inherit bold)))
   "Face for the first character after point in completions.
@@ -2040,7 +2174,6 @@ minibuffer-completion-help
                                    (completion--done result
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
-
                       (display-completion-list completions)))))
           nil)))
     nil))
@@ -2050,7 +2183,9 @@ minibuffer-hide-completions
   ;; 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.
   (let ((win (get-buffer-window "*Completions*" 0)))
-    (if win (with-selected-window win (bury-buffer)))))
+    (when win
+      (with-selected-window win (bury-buffer))
+      (run-hooks 'minibuffer-hide-completions-hook))))
 
 (defun exit-minibuffer ()
   "Terminate this minibuffer argument."
@@ -2318,6 +2453,7 @@ completion-help-at-point
          (setq completion-in-region--data
                `(,start ,(copy-marker end t) ,collection
                         ,(plist-get plist :predicate)))
+
          (completion-in-region-mode 1)
          (minibuffer-completion-help start end)))
       (`(,hookfun . ,_)
@@ -3754,7 +3890,7 @@ completing-read-default
                                           require-match))
          (minibuffer--require-match require-match)
          (base-keymap (if require-match
-                         minibuffer-local-must-match-map
+                          minibuffer-local-must-match-map
                         minibuffer-local-completion-map))
          (keymap (if (memq minibuffer-completing-file-name '(nil lambda))
                      base-keymap
diff --git a/lisp/simple.el b/lisp/simple.el
index fa6e154004..27dc87217b 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8368,6 +8368,12 @@ set-variable
 \f
 ;; Define the major mode for lists of completions.
 
+(defcustom completion-highlight-candidate t
+  "Non-nil means show help message in *Completions* buffer."
+  :type 'boolean
+  :version "28.1"
+  :group 'completion)
+
 (defvar completion-list-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map [mouse-2] 'choose-completion)
@@ -8381,6 +8387,12 @@ completion-list-mode-map
     (define-key map [backtab] 'previous-completion)
     (define-key map "q" 'quit-window)
     (define-key map "z" 'kill-current-buffer)
+
+    (define-key map "\C-g" 'quit-window)
+    (define-key map [up] 'previous-line-completion)
+    (define-key map "\C-p" 'previous-line-completion)
+    (define-key map [down] 'next-line-completion)
+    (define-key map "\C-n" 'next-line-completion)
     map)
   "Local map for completion list buffers.")
 
@@ -8419,6 +8431,10 @@ completion-base-size
 If nil, Emacs determines which part of the tail end of the
 buffer's text is involved in completion by comparing the text
 directly.")
+
+(defvar completion-overlay nil
+  "Highlight to use when `completion-highlight-candidate' is non nil.")
+
 (make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
 
 (defun delete-completion-window ()
@@ -8432,15 +8448,9 @@ delete-completion-window
       (if (get-buffer-window buf)
 	  (select-window (get-buffer-window buf))))))
 
-(defun previous-completion (n)
-  "Move to the previous item in the completion list."
-  (interactive "p")
-  (next-completion (- n)))
-
-(defun next-completion (n)
+(defun goto-next-completion (n)
   "Move to the next item in the completion list.
 With prefix argument N, move N items (negative N means move backward)."
-  (interactive "p")
   (let ((beg (point-min)) (end (point-max)))
     (while (and (> n 0) (not (eobp)))
       ;; If in a completion, move to the end of it.
@@ -8465,6 +8475,46 @@ next-completion
 		    (point) 'mouse-face nil beg))
 	(setq n (1+ n))))))
 
+(defun next-completion (n)
+  "Move to the next item in the completion list.
+With prefix argument N, move N items (negative N means move backward).
+If completion highlight is enabled, highlights the selected candidate.
+Returns the completion string if available."
+  (interactive "p")
+  (goto-next-completion n)
+
+  (let* ((obeg (point))
+         (oend (next-single-property-change obeg 'mouse-face nil (point-max)))
+         (choice (buffer-substring-no-properties obeg oend)))
+
+    (when completion-highlight-candidate
+      (move-overlay completion-overlay obeg oend)
+      (minibuffer-completion-set-suffix choice))
+
+    ;; Return the current completion
+    choice))
+
+(defun previous-completion (n)
+  "Move to the previous N item in the completion list see `next-completion'."
+  (interactive "p")
+  (next-completion (- n)))
+
+(defun next-line-completion (&optional arg try-vscroll)
+  "Go to completion candidate in line above current.
+With prefix argument ARG, move to ARG candidate bellow current.
+TRY-VSCROLL is passed straight to `line-move'"
+  (interactive "^p\np")
+  (line-move arg t nil try-vscroll)
+  (goto-next-completion 1)
+  (next-completion -1))
+
+(defun previous-line-completion (&optional arg try-vscroll)
+  "Go to completion candidate in line above current.
+With prefix argument ARG, move to ARG candidate above current.
+TRY-VSCROLL is passed straight to `line-move'"
+  (interactive "^p\np")
+  (next-line-completion (- arg) try-vscroll))
+
 (defun choose-completion (&optional event)
   "Choose the completion at point.
 If EVENT, use EVENT's position to determine the starting position."
@@ -8646,6 +8696,12 @@ completion-show-help
   :version "22.1"
   :group 'completion)
 
+
+(defun completions-highlight-completions-pre-command-hook ()
+  "Function `pre-command-hook' to use only in the minibuffer."
+  (move-overlay completion-overlay 0 0)
+  (minibuffer-completion-unset-suffix))
+
 ;; This function goes in completion-setup-hook, so that it is called
 ;; after the text of the completion list buffer is written.
 (defun completion-setup-function ()
@@ -8684,7 +8740,22 @@ completion-setup-function
 	    (insert "Click on a completion to select it.\n"))
 	(insert (substitute-command-keys
 		 "In this buffer, type \\[choose-completion] to \
-select the completion near point.\n\n"))))))
+select the completion near point.\n\n")))
+
+      (when (and completion-highlight-candidate
+                 (string= (buffer-name) "*Completions*"))
+
+        (set (make-local-variable 'completion-overlay) (make-overlay 0 0))
+        (overlay-put completion-overlay 'face 'highlight)
+
+        (add-hook 'pre-command-hook #'completions-highlight-completions-pre-command-hook nil t)
+        (add-hook 'isearch-mode-end-hook (lambda ()
+                                           (goto-next-completion -1)
+                                           (next-completion 1)) nil t)
+        (completions-highlight-completion-bindings t)))
+
+    (completions-highlight-minibuffer-complete-setup)))
+
 
 (add-hook 'completion-setup-hook #'completion-setup-function)
 

  reply	other threads:[~2020-08-24 19:06 UTC|newest]

Thread overview: 48+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <1704199899.1577092.1591806438580.ref@mail.yahoo.com>
2020-06-10 16:27 ` vertical fido-mode Ergus
2020-06-10 16:53   ` Stefan Monnier
2020-06-10 19:01     ` Dmitry Gutov
2020-06-10 19:45       ` Basil L. Contovounesios
2020-06-10 21:54       ` Ergus
2020-06-10 22:00         ` Dmitry Gutov
2020-06-10 23:08           ` Juri Linkov
2020-06-10 23:23             ` Dmitry Gutov
2020-06-11 13:22               ` Ergus
2020-06-11 13:28                 ` Noam Postavsky
2020-06-11 13:40                   ` Ergus
2020-06-11 15:49                     ` Protesilaos Stavrou
2020-06-11 15:52                       ` Omar Antolín Camarena
2020-06-11 17:37                       ` Basil L. Contovounesios
2020-06-17 21:50                 ` Juri Linkov
2020-06-17 21:57                   ` Dmitry Gutov
2020-06-17 22:17                     ` João Távora
2020-06-17 22:31                       ` Drew Adams
2020-06-17 22:40                         ` João Távora
2020-06-17 22:56                           ` Drew Adams
2020-06-17 22:52                         ` Juri Linkov
2020-06-17 23:20                           ` Drew Adams
2020-06-17 22:22                     ` Juri Linkov
2020-06-17 22:52                       ` Dmitry Gutov
2020-06-17 22:57                         ` Dmitry Gutov
2020-06-17 22:58                           ` Drew Adams
2020-06-17 23:15                         ` Drew Adams
2020-06-18 21:54                         ` Juri Linkov
2020-06-18 22:41                           ` João Távora
2020-06-18 22:51                             ` Juri Linkov
2020-06-19  8:53                               ` João Távora
2020-06-18  8:22                     ` Kévin Le Gouguec
2020-06-18 10:19                       ` Ergus
2020-06-11 13:10             ` Ergus
2020-08-19 12:17             ` Ergus via Emacs development discussions.
2020-08-20  0:35               ` Juri Linkov
2020-08-20 10:37                 ` Ergus
2020-08-20 23:15                   ` Juri Linkov
2020-08-21  0:05                     ` Ergus
2020-08-23 18:45                       ` Juri Linkov
2020-08-24 19:06                         ` Ergus via Emacs development discussions. [this message]
2020-08-25 18:55                           ` vertical fido-mode (new branch) Juri Linkov
2020-08-25 23:11                             ` Ergus
2020-08-25 23:42                               ` Stefan Monnier
2020-08-26  4:34                                 ` Ergus
2020-08-26 13:30                                   ` Stefan Monnier
2020-08-28 10:09                             ` Ergus
2020-06-10 19:45     ` vertical fido-mode Basil L. Contovounesios

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=20200824190654.d5obxfwyehdgpr4u@Ergus \
    --to=emacs-devel@gnu.org \
    --cc=juri@linkov.net \
    --cc=spacibba@aol.com \
    /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).