merge from upstream

4 files changed, 110 insertions, 56 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 333764d846c..4902da03f4d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2010-08-19  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * files.el (locate-file-completion-table): Only list the .el and .elc
+        extensions if there's no other choice (bug#5955).
+
+        * facemenu.el (facemenu-self-insert-data): New var.
+        (facemenu-post-self-insert-function, facemenu-set-self-insert-face):
+        New functions.
+        (facemenu-add-face): Use them.
+
+        * simple.el (blink-matching-open): Obey forward-sexp-function.
+
 2010-08-18  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * simple.el (prog-mode-map): New var.
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 20b86676ea9..992c6418d45 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -699,6 +699,22 @@ determine the correct answer."
   (cond ((equal a b) t)
         ((equal (color-values a) (color-values b)))))
 
+
+(defvar facemenu-self-insert-data nil)
+
+(defun facemenu-post-self-insert-function ()
+  (when (and (car facemenu-self-insert-data)
+             (eq last-command (cdr facemenu-self-insert-data)))
+    (put-text-property (1- (point)) (point)
+                       'face (car facemenu-self-insert-data))
+    (setq facemenu-self-insert-data nil))
+  (remove-hook 'post-self-insert-hook 'facemenu-post-self-insert-function))
+
+(defun facemenu-set-self-insert-face (face)
+  "Arrange for the next self-inserted char to have face `face'."
+  (setq facemenu-self-insert-data (cons face this-command))
+  (add-hook 'post-self-insert-hook 'facemenu-post-self-insert-function))
+
 (defun facemenu-add-face (face &optional start end)
   "Add FACE to text between START and END.
 If START is nil or START to END is empty, add FACE to next typed character
@@ -712,51 +728,52 @@ As a special case, if FACE is `default', then the region is left with NO face
 text property.  Otherwise, selecting the default face would not have any
 effect.  See `facemenu-remove-face-function'."
   (interactive "*xFace: \nr")
-  (if (and (eq face 'default)
-           (not (eq facemenu-remove-face-function t)))
-      (if facemenu-remove-face-function
-          (funcall facemenu-remove-face-function start end)
-        (if (and start (< start end))
-            (remove-text-properties start end '(face default))
-          (setq self-insert-face 'default
-                self-insert-face-command this-command)))
-    (if facemenu-add-face-function
-        (save-excursion
-          (if end (goto-char end))
-          (save-excursion
-            (if start (goto-char start))
-            (insert-before-markers
-             (funcall facemenu-add-face-function face end)))
-          (if facemenu-end-add-face
-              (insert (if (stringp facemenu-end-add-face)
-                          facemenu-end-add-face
-                        (funcall facemenu-end-add-face face)))))
+  (cond
+   ((and (eq face 'default)
+         (not (eq facemenu-remove-face-function t)))
+    (if facemenu-remove-face-function
+        (funcall facemenu-remove-face-function start end)
       (if (and start (< start end))
-          (let ((part-start start) part-end)
-            (while (not (= part-start end))
-              (setq part-end (next-single-property-change part-start 'face
-                                                          nil end))
-              (let ((prev (get-text-property part-start 'face)))
-                (put-text-property part-start part-end 'face
-                                   (if (null prev)
-                                       face
-                                     (facemenu-active-faces
-                                      (cons face
-                                            (if (listp prev)
-                                                prev
-                                              (list prev)))
-                                      ;; Specify the selected frame
-                                      ;; because nil would mean to use
-                                      ;; the new-frame default settings,
-                                      ;; and those are usually nil.
-                                      (selected-frame)))))
-              (setq part-start part-end)))
-        (setq self-insert-face (if (eq last-command self-insert-face-command)
-                                   (cons face (if (listp self-insert-face)
-                                                  self-insert-face
-                                                (list self-insert-face)))
-                                 face)
-              self-insert-face-command this-command))))
+          (remove-text-properties start end '(face default))
+        (facemenu-set-self-insert-face 'default))))
+   (facemenu-add-face-function
+    (save-excursion
+      (if end (goto-char end))
+      (save-excursion
+        (if start (goto-char start))
+        (insert-before-markers
+         (funcall facemenu-add-face-function face end)))
+      (if facemenu-end-add-face
+          (insert (if (stringp facemenu-end-add-face)
+                      facemenu-end-add-face
+                    (funcall facemenu-end-add-face face))))))
+   ((and start (< start end))
+    (let ((part-start start) part-end)
+      (while (not (= part-start end))
+        (setq part-end (next-single-property-change part-start 'face
+                                                    nil end))
+        (let ((prev (get-text-property part-start 'face)))
+          (put-text-property part-start part-end 'face
+                             (if (null prev)
+                                 face
+                               (facemenu-active-faces
+                                (cons face
+                                      (if (listp prev)
+                                          prev
+                                        (list prev)))
+                                ;; Specify the selected frame
+                                ;; because nil would mean to use
+                                ;; the new-frame default settings,
+                                ;; and those are usually nil.
+                                (selected-frame)))))
+        (setq part-start part-end))))
+   (t
+    (facemenu-set-self-insert-face
+     (if (eq last-command (cdr facemenu-self-insert-data))
+         (cons face (if (listp (car facemenu-self-insert-data))
+                        (car facemenu-self-insert-data)
+                      (list (car facemenu-self-insert-data))))
+       face))))
   (unless (facemenu-enable-faces-p)
     (message "Font-lock mode will override any faces you set in this buffer")))
 
diff --git a/lisp/files.el b/lisp/files.el
index 8b131e04ebc..9a07509ed8b 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -757,21 +757,44 @@ one or more of those symbols."
              (let ((x (file-name-directory suffix)))
                (if x (1- (length x)) (length suffix))))))
    (t
-    (let ((names nil)
+    (let ((names '())
+          ;; If we have files like "foo.el" and "foo.elc", we could load one of
+          ;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the
+          ;; preferred way.  So if we list all 3, that gives a lot of redundant
+          ;; entries for the poor soul looking just for "foo".  OTOH, sometimes
+          ;; the user does want to pay attention to the extension.  We try to
+          ;; diffuse this tension by stripping the suffix, except when the
+          ;; result is a single element (i.e. usually we only list "foo" unless
+          ;; it's the only remaining element in the list, in which case we do
+          ;; list "foo", "foo.elc" and "foo.el").
+          (fullnames '())
           (suffix (concat (regexp-opt suffixes t) "\\'"))
           (string-dir (file-name-directory string))
           (string-file (file-name-nondirectory string)))
       (dolist (dir dirs)
-        (unless dir
-          (setq dir default-directory))
-        (if string-dir (setq dir (expand-file-name string-dir dir)))
-        (when (file-directory-p dir)
-          (dolist (file (file-name-all-completions
-                         string-file dir))
-            (push file names)
-            (when (string-match suffix file)
-              (setq file (substring file 0 (match-beginning 0)))
-              (push file names)))))
+        (unless dir
+          (setq dir default-directory))
+        (if string-dir (setq dir (expand-file-name string-dir dir)))
+        (when (file-directory-p dir)
+          (dolist (file (file-name-all-completions
+                         string-file dir))
+            (if (not (string-match suffix file))
+                (push file names)
+              (push file fullnames)
+              (push (substring file 0 (match-beginning 0)) names)))))
+      ;; Switching from names to names+fullnames creates a non-monotonicity
+      ;; which can cause problems with things like partial-completion.
+      ;; To minimize the problem, filter out completion-regexp-list, so that
+      ;; M-x load-library RET t/x.e TAB finds some files.
+      (if completion-regexp-list
+          (setq names (all-completions "" names)))
+      ;; Remove duplicates of the first element, so that we can easily check
+      ;; if `names' really only contains a single element.
+      (when (cdr names) (setcdr names (delete (car names) (cdr names))))
+      (unless (cdr names)
+        ;; There's no more than one matching non-suffixed element, so expand
+        ;; the list by adding the suffixed elements as well.
+        (setq names (nconc names fullnames)))
       (completion-table-with-context
        string-dir names string-file pred action)))))
 
diff --git a/lisp/simple.el b/lisp/simple.el
index 7c941fd63b9..b998eef88a0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5495,7 +5495,9 @@ it skips the contents of comments that end before point."
                        (and parse-sexp-ignore-comments
                             (not blink-matching-paren-dont-ignore-comments))))
                   (condition-case ()
-                      (scan-sexps oldpos -1)
+                      (progn
+                        (forward-sexp -1)
+                        (point))
                     (error nil))))))
            (matching-paren
             (and blinkpos