summaryrefslogtreecommitdiff
path: root/lisp/minibuffer.el
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2009-01-06 04:17:04 +0000
committerStefan Monnier <monnier@iro.umontreal.ca>2009-01-06 04:17:04 +0000
commit1bba1cfc46bc13ee9be30614086b7005d5a0c1df (patch)
treec059ef99c561dcbc02adfb3c6d54121a4f58aff9 /lisp/minibuffer.el
parent8d5e14a9c7098f476e7a6716e22016e88f39c5bd (diff)
downloademacs-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.el53
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)