changeset 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 e22977dd0d51
children 7d332b05e8ac
files lisp/ChangeLog lisp/minibuffer.el
diffstat 2 files changed, 49 insertions(+), 38 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Jan 06 02:13:40 2009 +0000
+++ b/lisp/ChangeLog	Tue Jan 06 04:17:04 2009 +0000
@@ -1,11 +1,20 @@
+2009-01-06  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* minibuffer.el (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.
+
 2009-01-06  Juanma Barranquero  <lekktu@gmail.com>
 
 	* international/mule.el (define-coding-system): Fix typos in docstring.
 
 2009-01-05  Alan Mackenzie  <acm@muc.de>
 
-	* progmodes/cc-styles.el (c-setup-paragraph-variables): Ensure
-	paragraph-\(start\|separate\) match blank lines.  For AWK Mode.
+	* progmodes/cc-styles.el (c-setup-paragraph-variables):
+	Ensure paragraph-\(start\|separate\) match blank lines.  For AWK Mode.
 
 2009-01-05  Michael Albinus  <michael.albinus@gmx.de>
 
@@ -90,34 +99,31 @@
 	(tramp-prefix-domain-regexp, tramp-domain-regexp)
 	(tramp-user-with-domain-regexp, tramp-prefix-ipv6-format)
 	(tramp-prefix-ipv6-regexp, tramp-ipv6-regexp)
-	(tramp-postfix-ipv6-format, tramp-postfix-ipv6-regexp): New
-	defconst.
+	(tramp-postfix-ipv6-format, tramp-postfix-ipv6-regexp): New defconst.
 	(tramp-file-name-structure, tramp-file-name-regexp-unified)
 	(tramp-completion-dissect-file-name, tramp-parse-hosts-group)
 	(tramp-dissect-file-name, tramp-make-tramp-file-name)
 	(tramp-completion-make-tramp-file-name): Handle IPv6 addresses.
 	(tramp-handle-insert-file-contents): Fix setting of
 	`buffer-read-only'.
-	(tramp-compute-multi-hops, tramp-local-host-p): Use
-	`tramp-local-host-regexp'.
-	(tramp-file-name-real-user, tramp-file-name-domain): Use
-	`tramp-user-with-domain-regexp'.
+	(tramp-compute-multi-hops, tramp-local-host-p):
+	Use `tramp-local-host-regexp'.
+	(tramp-file-name-real-user, tramp-file-name-domain):
+	Use `tramp-user-with-domain-regexp'.
 
 	* net/tramp-smb.el (top): Use `tramp-prefix-domain-regexp'.
-	(tramp-smb-maybe-open-connection): Use `tramp-file-name-*'
-	methods.
+	(tramp-smb-maybe-open-connection): Use `tramp-file-name-*' methods.
 
 2009-01-03  Roland Winkler  <Roland.Winkler@physik.uni-erlangen.de>
 
 	* proced.el (proced-grammar-alist): Refiner can be a
 	list (function help-echo) instead of a cons pair.
 	(proced-post-display-hook): New variable.
-	(proced-tree-depth): Renamed from proced-tree-indent.
+	(proced-tree-depth): Rename from proced-tree-indent.
 	(proced-mode): Derive mode from special-mode.
-	(proced-mode-map): Changed accordingly.
+	(proced-mode-map): Change accordingly.
 	(proced, proced-update): Run proced-post-display-hook.
-	(proced-do-mark-all): Count processes for which mark has been
-	updated.
+	(proced-do-mark-all): Count processes for which mark has been updated.
 	(proced-format): Check for ppid attribute.
 	(proced-process-attributes): Take time and ctime attribute from
 	system-process-attributes.
--- a/lisp/minibuffer.el	Tue Jan 06 02:13:40 2009 +0000
+++ b/lisp/minibuffer.el	Tue Jan 06 04:17:04 2009 +0000
@@ -789,7 +789,11 @@
                      (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 @@
   :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 @@
 (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)