Mercurial > emacs
comparison lisp/minibuffer.el @ 100929:2677429036c3
(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.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 06 Jan 2009 04:17:04 +0000 |
| parents | a9dc0e7c3f2b |
| children | 4efc7ca085ce |
comparison
equal
deleted
inserted
replaced
| 100928:e22977dd0d51 | 100929:2677429036c3 |
|---|---|
| 787 ;; display-completion-list, `elem' may be a list. | 787 ;; display-completion-list, `elem' may be a list. |
| 788 (if (consp elem) | 788 (if (consp elem) |
| 789 (car (setq elem (cons (copy-sequence (car elem)) | 789 (car (setq elem (cons (copy-sequence (car elem)) |
| 790 (cdr elem)))) | 790 (cdr elem)))) |
| 791 (setq elem (copy-sequence elem))))) | 791 (setq elem (copy-sequence elem))))) |
| 792 (put-text-property 0 com-str-len | 792 (put-text-property 0 |
| 793 ;; If completion-boundaries returns incorrect | |
| 794 ;; values, all-completions may return strings | |
| 795 ;; that don't contain the prefix. | |
| 796 (min com-str-len (length str)) | |
| 793 'font-lock-face 'completions-common-part | 797 'font-lock-face 'completions-common-part |
| 794 str) | 798 str) |
| 795 (if (> (length str) com-str-len) | 799 (if (> (length str) com-str-len) |
| 796 (put-text-property com-str-len (1+ com-str-len) | 800 (put-text-property com-str-len (1+ com-str-len) |
| 797 'font-lock-face 'completions-first-difference | 801 'font-lock-face 'completions-first-difference |
| 1331 :initialize 'custom-initialize-reset | 1335 :initialize 'custom-initialize-reset |
| 1332 :group 'minibuffer | 1336 :group 'minibuffer |
| 1333 :type 'string) | 1337 :type 'string) |
| 1334 | 1338 |
| 1335 (defun completion-pcm--pattern-trivial-p (pattern) | 1339 (defun completion-pcm--pattern-trivial-p (pattern) |
| 1336 (and (stringp (car pattern)) (null (cdr pattern)))) | 1340 (and (stringp (car pattern)) |
| 1341 ;; It can be followed by `point' and "" and still be trivial. | |
| 1342 (let ((trivial t)) | |
| 1343 (dolist (elem (cdr pattern)) | |
| 1344 (unless (member elem '(point "")) | |
| 1345 (setq trivial nil))) | |
| 1346 trivial))) | |
| 1337 | 1347 |
| 1338 (defun completion-pcm--string->pattern (string &optional point) | 1348 (defun completion-pcm--string->pattern (string &optional point) |
| 1339 "Split STRING into a pattern. | 1349 "Split STRING into a pattern. |
| 1340 A pattern is a list where each element is either a string | 1350 A pattern is a list where each element is either a string |
| 1341 or a symbol chosen among `any', `star', `point'." | 1351 or a symbol chosen among `any', `star', `point'." |
| 1409 poss))))) | 1419 poss))))) |
| 1410 | 1420 |
| 1411 (defun completion-pcm--hilit-commonality (pattern completions) | 1421 (defun completion-pcm--hilit-commonality (pattern completions) |
| 1412 (when completions | 1422 (when completions |
| 1413 (let* ((re (completion-pcm--pattern->regex pattern '(point))) | 1423 (let* ((re (completion-pcm--pattern->regex pattern '(point))) |
| 1414 (case-fold-search completion-ignore-case) | 1424 (case-fold-search completion-ignore-case)) |
| 1415 (last (last completions)) | |
| 1416 (base-size (cdr last))) | |
| 1417 ;; Remove base-size during mapcar, and add it back later. | 1425 ;; Remove base-size during mapcar, and add it back later. |
| 1418 (setcdr last nil) | 1426 (mapcar |
| 1419 (nconc | 1427 (lambda (str) |
| 1420 (mapcar | 1428 ;; Don't modify the string itself. |
| 1421 (lambda (str) | 1429 (setq str (copy-sequence str)) |
| 1422 ;; Don't modify the string itself. | 1430 (unless (string-match re str) |
| 1423 (setq str (copy-sequence str)) | 1431 (error "Internal error: %s does not match %s" re str)) |
| 1424 (unless (string-match re str) | 1432 (let ((pos (or (match-beginning 1) (match-end 0)))) |
| 1425 (error "Internal error: %s does not match %s" re str)) | 1433 (put-text-property 0 pos |
| 1426 (let ((pos (or (match-beginning 1) (match-end 0)))) | 1434 'font-lock-face 'completions-common-part |
| 1427 (put-text-property 0 pos | 1435 str) |
| 1428 'font-lock-face 'completions-common-part | 1436 (if (> (length str) pos) |
| 1429 str) | 1437 (put-text-property pos (1+ pos) |
| 1430 (if (> (length str) pos) | 1438 'font-lock-face 'completions-first-difference |
| 1431 (put-text-property pos (1+ pos) | 1439 str))) |
| 1432 'font-lock-face 'completions-first-difference | 1440 str) |
| 1433 str))) | 1441 completions)))) |
| 1434 str) | |
| 1435 completions) | |
| 1436 base-size)))) | |
| 1437 | 1442 |
| 1438 (defun completion-pcm--find-all-completions (string table pred point | 1443 (defun completion-pcm--find-all-completions (string table pred point |
| 1439 &optional filter) | 1444 &optional filter) |
| 1440 "Find all completions for STRING at POINT in TABLE, satisfying PRED. | 1445 "Find all completions for STRING at POINT in TABLE, satisfying PRED. |
| 1441 POINT is a position inside STRING. | 1446 POINT is a position inside STRING. |