diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2009-01-06 04:17:04 +0000 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2009-01-06 04:17:04 +0000 |
commit | 1bba1cfc46bc13ee9be30614086b7005d5a0c1df (patch) | |
tree | c059ef99c561dcbc02adfb3c6d54121a4f58aff9 /lisp/minibuffer.el | |
parent | 8d5e14a9c7098f476e7a6716e22016e88f39c5bd (diff) | |
download | emacs-1bba1cfc46bc13ee9be30614086b7005d5a0c1df.tar.gz |
(completion-hilit-commonality): Don't presume
all-completions always include the input as prefix.
(completion-pcm--pattern-trivial-p): Accept a few more patterns
as trivial.
(completion-pcm--hilit-commonality): Remove leftover code that used to
deal with the now removed cdr-in-last-cons.
Diffstat (limited to 'lisp/minibuffer.el')
-rw-r--r-- | lisp/minibuffer.el | 53 |
1 files changed, 29 insertions, 24 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 51e0358136b..364ee3d909f 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -789,7 +789,11 @@ of the differing parts is, by contrast, slightly highlighted." (car (setq elem (cons (copy-sequence (car elem)) (cdr elem)))) (setq elem (copy-sequence elem))))) - (put-text-property 0 com-str-len + (put-text-property 0 + ;; If completion-boundaries returns incorrect + ;; values, all-completions may return strings + ;; that don't contain the prefix. + (min com-str-len (length str)) 'font-lock-face 'completions-common-part str) (if (> (length str) com-str-len) @@ -1333,7 +1337,13 @@ expression (not containing character ranges like `a-z')." :type 'string) (defun completion-pcm--pattern-trivial-p (pattern) - (and (stringp (car pattern)) (null (cdr pattern)))) + (and (stringp (car pattern)) + ;; It can be followed by `point' and "" and still be trivial. + (let ((trivial t)) + (dolist (elem (cdr pattern)) + (unless (member elem '(point "")) + (setq trivial nil))) + trivial))) (defun completion-pcm--string->pattern (string &optional point) "Split STRING into a pattern. @@ -1411,29 +1421,24 @@ 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))) - (case-fold-search completion-ignore-case) - (last (last completions)) - (base-size (cdr last))) + (case-fold-search completion-ignore-case)) ;; Remove base-size during mapcar, and add it back later. - (setcdr last nil) - (nconc - (mapcar - (lambda (str) - ;; Don't modify the string itself. - (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 - 'font-lock-face 'completions-common-part - str) - (if (> (length str) pos) - (put-text-property pos (1+ pos) - 'font-lock-face 'completions-first-difference - str))) - str) - completions) - base-size)))) + (mapcar + (lambda (str) + ;; Don't modify the string itself. + (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 + 'font-lock-face 'completions-common-part + str) + (if (> (length str) pos) + (put-text-property pos (1+ pos) + 'font-lock-face 'completions-first-difference + str))) + str) + completions)))) (defun completion-pcm--find-all-completions (string table pred point &optional filter) |