Mercurial > emacs
changeset 94465:e2562e0fe05e
(completion-hilit-commonality): Remove leftover code.
(completion-pcm--pattern->regex): Let `group' be a list of symbols.
(completion-pcm--hilit-commonality): New function.
(completion-pcm-all-completions): Use it.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 29 Apr 2008 06:00:21 +0000 |
| parents | 66b02cd7b956 |
| children | f3f81db34133 |
| files | lisp/ChangeLog lisp/minibuffer.el |
| diffstat | 2 files changed, 47 insertions(+), 16 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Apr 29 05:36:55 2008 +0000 +++ b/lisp/ChangeLog Tue Apr 29 06:00:21 2008 +0000 @@ -1,5 +1,10 @@ 2008-04-29 Stefan Monnier <monnier@iro.umontreal.ca> + * minibuffer.el (completion-hilit-commonality): Remove leftover code. + (completion-pcm--pattern->regex): Let `group' be a list of symbols. + (completion-pcm--hilit-commonality): New function. + (completion-pcm-all-completions): Use it. + * minibuffer.el (completion-common-substring): Mark obsolete. (completions-first-difference, completions-common-part): Move from simple.el.
--- a/lisp/minibuffer.el Tue Apr 29 05:36:55 2008 +0000 +++ b/lisp/minibuffer.el Tue Apr 29 06:00:21 2008 +0000 @@ -653,20 +653,17 @@ (setcdr last nil) (nconc (mapcar - (lambda (elem) - (let ((str - (if (consp elem) - (car (setq elem (cons (copy-sequence (car elem)) - (cdr elem)))) - (setq elem (copy-sequence elem))))) - (put-text-property 0 com-str-len - 'font-lock-face 'completions-common-part - str) - (if (> (length str) com-str-len) - (put-text-property com-str-len (1+ com-str-len) - 'font-lock-face 'completions-first-difference - str))) - elem) + (lambda (str) + ;; Don't modify the string itself. + (setq str (copy-sequence str)) + (put-text-property 0 com-str-len + 'font-lock-face 'completions-common-part + str) + (if (> (length str) com-str-len) + (put-text-property com-str-len (1+ com-str-len) + 'font-lock-face 'completions-first-difference + str)) + str) completions) base-size)))) @@ -1156,7 +1153,8 @@ (mapconcat (lambda (x) (case x - ((star any point) (if group "\\(.*?\\)" ".*?")) + ((star any point) (if (if (consp group) (memq x group) group) + "\\(.*?\\)" ".*?")) (t (regexp-quote x)))) pattern ""))) @@ -1190,9 +1188,37 @@ (when (string-match regex c) (push c poss))) poss))))) +(defun completion-pcm--hilit-commonality (pattern completions) + (when completions + (let* ((re (completion-pcm--pattern->regex pattern '(point))) + (last (last completions)) + (base-size (cdr last))) + ;; 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)))) + (defun completion-pcm-all-completions (string table pred point) (let ((pattern (completion-pcm--string->pattern string point))) - (completion-pcm--all-completions pattern table pred))) + (completion-pcm--hilit-commonality + pattern + (completion-pcm--all-completions pattern table pred)))) (defun completion-pcm--merge-completions (strs pattern) "Extract the commonality in STRS, with the help of PATTERN."