diff options
Diffstat (limited to 'lisp/minibuffer.el')
| -rw-r--r-- | lisp/minibuffer.el | 70 |
1 files changed, 40 insertions, 30 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7e7856f3a96..f8e328f6152 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))) @@ -1127,7 +1128,7 @@ when the buffer's text is already an exact match." ;; Show the completion table, if requested. ((not exact) (if (pcase completion-auto-help - (`lazy (eq this-command last-command)) + ('lazy (eq this-command last-command)) (_ completion-auto-help)) (minibuffer-completion-help beg end) (completion--message "Next char not unique"))) @@ -1320,7 +1321,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 () @@ -1824,12 +1825,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' @@ -1837,7 +1833,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. @@ -2099,9 +2095,9 @@ a completion function or god knows what else.") ;; like comint-completion-at-point or mh-letter-completion-at-point, which ;; could be sometimes safe and sometimes misbehaving (and sometimes neither). (if (pcase which - (`all t) - (`safe (member fun completion--capf-safe-funs)) - (`optimist (not (member fun completion--capf-misbehave-funs)))) + ('all t) + ('safe (member fun completion--capf-safe-funs)) + ('optimist (not (member fun completion--capf-misbehave-funs)))) (let ((res (funcall fun))) (cond ((and (consp res) (not (functionp res))) @@ -2726,17 +2722,9 @@ See `read-file-name' for the meaning of the arguments." (if (string= val1 (cadr file-name-history)) (pop file-name-history) (setcar file-name-history val1))) - (if add-to-history - ;; Add the value to the history--but not if it matches - ;; the last value already there. - (let ((val1 (minibuffer-maybe-quote-filename val))) - (unless (and (consp file-name-history) - (equal (car file-name-history) val1)) - (setq file-name-history - (cons val1 - (if history-delete-duplicates - (delete val1 file-name-history) - file-name-history))))))) + (when add-to-history + (add-to-history 'file-name-history + (minibuffer-maybe-quote-filename val)))) val)))) (defun internal-complete-buffer-except (&optional buffer) @@ -2962,12 +2950,14 @@ 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))) - (`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest))) - (`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest))) - (`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest))) + (`(point ,(or 'any 'any-delim) . ,rest) (setq p `(point . ,rest))) + (`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest))) + (`(any ,(or 'any 'any-delim) . ,rest) (setq p `(any . ,rest))) (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'. (_ (push (pop p) n)))) (nreverse n))) @@ -2993,6 +2983,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'." @@ -3024,7 +3025,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) @@ -3032,8 +3034,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) |