diff options
Diffstat (limited to 'lisp/minibuffer.el')
| -rw-r--r-- | lisp/minibuffer.el | 42 |
1 files changed, 30 insertions, 12 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e8c6ce6910b..9b6f043b576 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -729,7 +729,8 @@ If ARGS are provided, then pass MESSAGE through `format-message'." (defun minibuffer-completion-contents () "Return the user input in a minibuffer before point as a string. -In Emacs-22, that was what completion commands operated on." +In Emacs 22, that was what completion commands operated on. +If the current buffer is not a minibuffer, return everything before point." (declare (obsolete nil "24.4")) (buffer-substring (minibuffer-prompt-end) (point))) @@ -1319,7 +1320,7 @@ Repeated uses step through the possible completions." (defvar minibuffer-confirm-exit-commands '(completion-at-point minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word) - "A list of commands which cause an immediately following + "List of commands which cause an immediately following `minibuffer-complete-and-exit' to ask for extra confirmation.") (defun minibuffer-complete-and-exit () @@ -1823,12 +1824,7 @@ variables.") ;; window, mark it as softly-dedicated, so bury-buffer in ;; minibuffer-hide-completions will know whether to ;; delete the window or not. - (display-buffer-mark-dedicated 'soft) - ;; Disable `pop-up-windows' temporarily to allow - ;; `display-buffer--maybe-pop-up-frame-or-window' - ;; in the display actions below to pop up a frame - ;; if `pop-up-frames' is non-nil, but not to pop up a window. - (pop-up-windows nil)) + (display-buffer-mark-dedicated 'soft)) (with-displayed-buffer-window "*Completions*" ;; This is a copy of `display-buffer-fallback-action' @@ -1836,7 +1832,7 @@ variables.") ;; with `display-buffer-at-bottom'. `((display-buffer--maybe-same-window display-buffer-reuse-window - display-buffer--maybe-pop-up-frame-or-window + display-buffer--maybe-pop-up-frame ;; Use `display-buffer-below-selected' for inline completions, ;; but not in the minibuffer (e.g. in `eval-expression') ;; for which `display-buffer-at-bottom' is used. @@ -2955,6 +2951,8 @@ or a symbol, see `completion-pcm--merge-completions'." (`(,(and s1 (pred stringp)) ,(and s2 (pred stringp)) . ,rest) (setq p (cons (concat s1 s2) rest))) (`(,(and p1 (pred symbolp)) ,(and p2 (guard (eq p1 p2))) . ,_) + ;; Unused lexical variable warning due to body not using p1, p2. + ;; https://debbugs.gnu.org/16771 (setq p (cdr p))) (`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest))) (`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest))) @@ -2986,6 +2984,17 @@ or a symbol, see `completion-pcm--merge-completions'." (setq re (replace-match "" t t re 1))) re)) +(defun completion-pcm--pattern-point-idx (pattern) + "Return index of subgroup corresponding to `point' element of PATTERN. +Return nil if there's no such element." + (let ((idx nil) + (i 0)) + (dolist (x pattern) + (unless (stringp x) + (cl-incf i) + (if (eq x 'point) (setq idx i)))) + idx)) + (defun completion-pcm--all-completions (prefix pattern table pred) "Find all completions for PATTERN in TABLE obeying PRED. PATTERN is as returned by `completion-pcm--string->pattern'." @@ -3017,7 +3026,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'." (defun completion-pcm--hilit-commonality (pattern completions) (when completions - (let* ((re (completion-pcm--pattern->regex pattern '(point))) + (let* ((re (completion-pcm--pattern->regex pattern 'group)) + (point-idx (completion-pcm--pattern-point-idx pattern)) (case-fold-search completion-ignore-case)) (mapcar (lambda (str) @@ -3025,8 +3035,16 @@ PATTERN is as returned by `completion-pcm--string->pattern'." (setq str (copy-sequence str)) (unless (string-match re str) (error "Internal error: %s does not match %s" re str)) - (let ((pos (or (match-beginning 1) (match-end 0)))) - (put-text-property 0 pos + (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0))) + (md (match-data)) + (start (pop md)) + (end (pop md))) + (while md + (put-text-property start (pop md) + 'font-lock-face 'completions-common-part + str) + (setq start (pop md))) + (put-text-property start end 'font-lock-face 'completions-common-part str) (if (> (length str) pos) |