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)
next prev parent 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
* 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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.