merge upstream

14 files changed, 220 insertions, 93 deletions

diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index 8e5efc4f87d..6874ef75ef8 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-07  Juri Linkov  <juri@jurta.org>
+
+        * dired.texi (Operating on Files): Rewrite according to the fact
+        that `dired-do-chmod' doesn't use the `chmod' program anymore.
+
 2011-07-30  Michael Albinus  <michael.albinus@gmx.de>
 
         * mini.texi (Minibuffer File): Insert a reference to Tramp for
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 501c4152e6a..80ccd1d10f9 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -645,8 +645,8 @@ link.
 @cindex changing file permissions (in Dired)
 @item M @var{modespec} @key{RET}
 Change the mode (also called ``permission bits'') of the specified files
-(@code{dired-do-chmod}).  This uses the @code{chmod} program, so
-@var{modespec} can be any argument that @code{chmod} can handle.
+(@code{dired-do-chmod}).  @var{modespec} can be in octal or symbolic
+notation like arguments handled by the @code{chmod} program.
 
 @findex dired-do-chgrp
 @kindex G @r{(Dired)}
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7c1fa3a656b..d2ea294d2d0 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,25 @@
+2011-08-08  Daiki Ueno  <ueno@unixuser.org>
+
+        * epg.el (epg--status-KEYEXPIRED, epg--status-KEYREVOKED): Fix typo.
+        (epg-error-to-string, epg-errors-to-string): New function.
+        (epg-wait-for-completion): Reverse errors list.
+        (epg--check-error-for-decrypt, epg-sign-file, epg-sign-string)
+        (epg-encrypt-file, epg-encrypt-string, epg-export-keys-to-file)
+        (epg--import-keys-1, epg-receive-keys, epg-delete-keys)
+        (epg-sign-keys, epg-generate-key-from-file)
+        (epg-generate-key-from-string): Format errors by using
+        epg-errors-to-string (bug#9255).
+        (epg--status-INV_SGNR, epg--status-NO_SGNR): New status handler.
+
+2011-08-07  Juri Linkov  <juri@jurta.org>
+
+        * faces.el (list-faces-display): Remove extra angle bracket
+        from `help-mode-map'.
+
+        * info.el (Info-history-toc-nodes): Doc fix.
+
+        * longlines.el (longlines-mode): Doc fix.
+
 2011-08-05  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * progmodes/js.el (js--regexp-literal): Accept regexps at the beginning
@@ -346,9 +368,6 @@
         (string-rectangle): Go to the point after the last operation
         (bug#7522).
 
-        * simple.el (current-kill): Clarify what
-        `interprogram-paste-function' does (bug#7500).
-
         * printing.el (pr-toggle-region): Clarify the documentation
         slightly (bug#7493).
 
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 190be56dd09..2acf847cddc 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -3573,7 +3573,7 @@
         * locate.el (locate-default-make-command-line): Don't consider
         drive letter and root directory part of
         `directory-listing-before-filename-regexp'.  (Bug#7308)
-        (locate-post-command-hook, locate-post-command-hook): New defcustoms.
+        (locate-post-command-hook, locate-mode-hook): New defcustoms.
 
 2010-11-27  Stefan Monnier  <monnier@iro.umontreal.ca>
 
diff --git a/lisp/epg.el b/lisp/epg.el
index 348ad970b14..9ca07e213b4 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1069,6 +1069,59 @@ This function is for internal use only."
               (format " secret keys unchanged: %d\n"
                       (epg-import-result-secret-unchanged import-result)))))
 
+(defun epg-error-to-string (error)
+  (cond
+   ((eq (car error) 'exit)
+    "Exit")
+   ((eq (car error) 'quit)
+    "Cancelled")
+   ((eq (car error) 'no-data)
+    (let ((entry (assq (cdr error) epg-no-data-reason-alist)))
+      (if entry
+          (format "No data (%s)" (downcase (cdr entry)))
+        "No data")))
+   ((eq (car error) 'unexpected)
+    (let ((entry (assq (cdr error) epg-unexpected-reason-alist)))
+      (if entry
+          (format "Unexpected (%s)" (downcase (cdr entry)))
+        "Unexpected")))
+   ((eq (car error) 'bad-armor)
+    "Bad armor")
+   ((memq (car error) '(invalid-recipient invalid-signer))
+    (concat
+     (if (eq (car error) 'invalid-recipient)
+         "Unusable public key"
+       "Unusable secret key")
+     (let ((entry (assq 'requested (cdr error))))
+       (if entry
+           (format ": %s" (cdr entry))
+         ": <unknown>"))
+     (let ((entry (assq 'reason (cdr error))))
+       (if (and entry
+                (> (cdr entry) 0)       ;no specific reason given
+                (setq entry (assq (cdr entry)
+                                  epg-invalid-recipients-reason-alist)))
+           (format " (%s)" (downcase (cdr entry)))
+         ""))))
+   ((eq (car error) 'no-pubkey)
+    (format "No public key: %s" (cdr error)))
+   ((eq (car error) 'no-seckey)
+    (format "No secret key: %s" (cdr error)))
+   ((eq (car error) 'no-recipients)
+    "No recipients")
+   ((eq (car error) 'no-signers)
+    "No signers")
+   ((eq (car error) 'delete-problem)
+    (let ((entry (assq (cdr error) epg-delete-problem-reason-alist)))
+      (if entry
+          (format "Delete problem (%s)" (downcase (cdr entry)))
+        "Delete problem")))
+   ((eq (car error) 'key-not-created)
+    "Key not created")))
+
+(defun epg-errors-to-string (errors)
+  (mapconcat #'epg-error-to-string errors "; "))
+
 (defun epg--start (context args)
   "Start `epg-gpg-program' in a subprocess with given ARGS."
   (if (and (epg-context-process context)
@@ -1195,7 +1248,7 @@ This function is for internal use only."
     (if epg-pending-status-list
         (epg-context-set-result-for
          context 'error
-         (cons (list 'exit)
+         (cons '(exit)
                (epg-context-result-for context 'error))))))
 
 (defun epg-wait-for-completion (context)
@@ -1203,7 +1256,10 @@ This function is for internal use only."
   (while (eq (process-status (epg-context-process context)) 'run)
     (accept-process-output (epg-context-process context) 1))
   ;; This line is needed to run the process-filter right now.
-  (sleep-for 0.1))
+  (sleep-for 0.1)
+  (epg-context-set-result-for
+   context 'error
+   (nreverse (epg-context-result-for context 'error))))
 
 (defun epg-reset (context)
   "Reset the CONTEXT."
@@ -1399,11 +1455,22 @@ This function is for internal use only."
   (epg--status-*SIG context 'bad string))
 
 (defun epg--status-NO_PUBKEY (context string)
-  (let ((signature (car (epg-context-result-for context 'verify))))
-    (if (and signature
-             (eq (epg-signature-status signature) 'error)
-             (equal (epg-signature-key-id signature) string))
-        (epg-signature-set-status signature 'no-pubkey))))
+  (if (eq (epg-context-operation context) 'verify)
+      (let ((signature (car (epg-context-result-for context 'verify))))
+        (if (and signature
+                 (eq (epg-signature-status signature) 'error)
+                 (equal (epg-signature-key-id signature) string))
+            (epg-signature-set-status signature 'no-pubkey)))
+    (epg-context-set-result-for
+     context 'error
+     (cons (cons 'no-pubkey string)
+           (epg-context-result-for context 'error)))))
+
+(defun epg--status-NO_SECKEY (context string)
+  (epg-context-set-result-for
+   context 'error
+   (cons (cons 'no-seckey string)
+         (epg-context-result-for context 'error))))
 
 (defun epg--time-from-seconds (seconds)
   (let ((number-seconds (string-to-number (concat seconds ".0"))))
@@ -1564,13 +1631,13 @@ This function is for internal use only."
    context 'key
    (cons (list 'key-expired (cons 'expiration-time
                                   (epg--time-from-seconds string)))
-         (epg-context-result-for context 'error))))
+         (epg-context-result-for context 'key))))
 
 (defun epg--status-KEYREVOKED (context _string)
   (epg-context-set-result-for
    context 'key
    (cons '(key-revoked)
-         (epg-context-result-for context 'error))))
+         (epg-context-result-for context 'key))))
 
 (defun epg--status-BADARMOR (context _string)
   (epg-context-set-result-for
@@ -1585,7 +1652,18 @@ This function is for internal use only."
        (cons (list 'invalid-recipient
                    (cons 'reason
                          (string-to-number (match-string 1 string)))
-                   (cons 'requested-recipient
+                   (cons 'requested
+                         (match-string 2 string)))
+             (epg-context-result-for context 'error)))))
+
+(defun epg--status-INV_SGNR (context string)
+  (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
+      (epg-context-set-result-for
+       context 'error
+       (cons (list 'invalid-signer
+                   (cons 'reason
+                         (string-to-number (match-string 1 string)))
+                   (cons 'requested
                          (match-string 2 string)))
              (epg-context-result-for context 'error)))))
 
@@ -1595,6 +1673,12 @@ This function is for internal use only."
    (cons '(no-recipients)
          (epg-context-result-for context 'error))))
 
+(defun epg--status-NO_SGNR (context _string)
+  (epg-context-set-result-for
+   context 'error
+   (cons '(no-signers)
+         (epg-context-result-for context 'error))))
+
 (defun epg--status-DELETE_PROBLEM (context string)
   (if (string-match "\\`\\([0-9]+\\)" string)
       (epg-context-set-result-for
@@ -1960,17 +2044,13 @@ If you are unsure, use synchronous version of this function
     (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
 
 (defun epg--check-error-for-decrypt (context)
-  (if (epg-context-result-for context 'decryption-failed)
-      (signal 'epg-error (list "Decryption failed")))
-  (if (epg-context-result-for context 'no-secret-key)
-      (signal 'epg-error
-              (list "No secret key"
-                    (epg-context-result-for context 'no-secret-key))))
+  (let ((errors (epg-context-result-for context 'error)))
+    (if (epg-context-result-for context 'decryption-failed)
+        (signal 'epg-error
+                (list "Decryption failed" (epg-errors-to-string errors))))
     (unless (epg-context-result-for context 'decryption-okay)
-      (let* ((error (epg-context-result-for context 'error)))
-        (if (assq 'no-data error)
-            (signal 'epg-error (list "No data")))
-        (signal 'epg-error (list "Can't decrypt" error)))))
+      (signal 'epg-error
+              (list "Can't decrypt" (epg-errors-to-string errors))))))
 
 (defun epg-decrypt-file (context cipher plain)
   "Decrypt a file CIPHER and store the result to a file PLAIN.
@@ -2165,10 +2245,9 @@ Otherwise, it makes a cleartext signature."
         (epg-start-sign context (epg-make-data-from-file plain) mode)
         (epg-wait-for-completion context)
         (unless (epg-context-result-for context 'sign)
-          (if (epg-context-result-for context 'error)
-              (error "Sign failed: %S"
-                     (epg-context-result-for context 'error))
-            (error "Sign failed")))
+          (let ((errors (epg-context-result-for context 'error)))
+            (signal 'epg-error
+                    (list "Sign failed" (epg-errors-to-string errors)))))
         (unless signature
           (epg-read-output context)))
     (unless signature
@@ -2203,9 +2282,9 @@ Otherwise, it makes a cleartext signature."
           (epg-wait-for-completion context)
           (unless (epg-context-result-for context 'sign)
             (if (epg-context-result-for context 'error)
-                (error "Sign failed: %S"
-                       (epg-context-result-for context 'error))
-              (error "Sign failed")))
+                (let ((errors (epg-context-result-for context 'error)))
+                  (signal 'epg-error
+                          (list "Sign failed" (epg-errors-to-string errors))))))
           (epg-read-output context))
       (epg-delete-output-file context)
       (if input-file
@@ -2276,15 +2355,14 @@ If RECIPIENTS is nil, it performs symmetric encryption."
         (epg-start-encrypt context (epg-make-data-from-file plain)
                            recipients sign always-trust)
         (epg-wait-for-completion context)
-        (if (and sign
-                 (not (epg-context-result-for context 'sign)))
-            (if (epg-context-result-for context 'error)
-                (error "Sign failed: %S"
-                       (epg-context-result-for context 'error))
-                (error "Sign failed")))
-        (if (epg-context-result-for context 'error)
-            (error "Encrypt failed: %S"
-                   (epg-context-result-for context 'error)))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if (and sign
+                   (not (epg-context-result-for context 'sign)))
+              (signal 'epg-error
+                      (list "Sign failed" (epg-errors-to-string errors))))
+          (if errors
+              (signal 'epg-error
+                      (list "Encrypt failed" (epg-errors-to-string errors)))))
         (unless cipher
           (epg-read-output context)))
     (unless cipher
@@ -2317,15 +2395,14 @@ If RECIPIENTS is nil, it performs symmetric encryption."
                                (epg-make-data-from-string plain))
                              recipients sign always-trust)
           (epg-wait-for-completion context)
-          (if (and sign
-                   (not (epg-context-result-for context 'sign)))
-              (if (epg-context-result-for context 'error)
-                  (error "Sign failed: %S"
-                         (epg-context-result-for context 'error))
-                (error "Sign failed")))
-          (if (epg-context-result-for context 'error)
-              (error "Encrypt failed: %S"
-                     (epg-context-result-for context 'error)))
+          (let ((errors (epg-context-result-for context 'error)))
+            (if (and sign
+                     (not (epg-context-result-for context 'sign)))
+                (signal 'epg-error
+                        (list "Sign failed" (epg-errors-to-string errors))))
+            (if errors
+                (signal 'epg-error
+                        (list "Encrypt failed" (epg-errors-to-string errors)))))
           (epg-read-output context))
       (epg-delete-output-file context)
       (if input-file
@@ -2359,9 +2436,11 @@ If you are unsure, use synchronous version of this function
                                        (epg--make-temp-file "epg-output")))
         (epg-start-export-keys context keys)
         (epg-wait-for-completion context)
-        (if (epg-context-result-for context 'error)
-            (error "Export keys failed: %S"
-                   (epg-context-result-for context 'error)))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if errors
+              (signal 'epg-error
+                      (list "Export keys failed"
+                            (epg-errors-to-string errors)))))
         (unless file
           (epg-read-output context)))
     (unless file
@@ -2398,9 +2477,11 @@ If you are unsure, use synchronous version of this function
       (progn
         (epg-start-import-keys context keys)
         (epg-wait-for-completion context)
-        (if (epg-context-result-for context 'error)
-            (error "Import keys failed: %S"
-                   (epg-context-result-for context 'error))))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if errors
+              (signal 'epg-error
+                      (list "Import keys failed"
+                            (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg-import-keys-from-file (context keys)
@@ -2431,9 +2512,11 @@ KEYS is a list of key IDs"
       (progn
         (epg-start-receive-keys context keys)
         (epg-wait-for-completion context)
-        (if (epg-context-result-for context 'error)
-            (error "Receive keys failed: %S"
-                   (epg-context-result-for context 'error))))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if errors
+              (signal 'epg-error
+                      (list "Receive keys failed"
+                            (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defalias 'epg-import-keys-from-server 'epg-receive-keys)
@@ -2463,13 +2546,11 @@ If you are unsure, use synchronous version of this function
       (progn
         (epg-start-delete-keys context keys allow-secret)
         (epg-wait-for-completion context)
-        (let ((entry (assq 'delete-problem
-                           (epg-context-result-for context 'error))))
-          (if entry
-              (if (setq entry (assq (cdr entry)
-                                    epg-delete-problem-reason-alist))
-                  (error "Delete keys failed: %s" (cdr entry))
-                (error "Delete keys failed")))))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if errors
+              (signal 'epg-error
+                      (list "Delete keys failed"
+                            (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg-start-sign-keys (context keys &optional local)
@@ -2498,9 +2579,11 @@ If you are unsure, use synchronous version of this function
       (progn
         (epg-start-sign-keys context keys local)
         (epg-wait-for-completion context)
-        (if (epg-context-result-for context 'error)
-            (error "Sign keys failed: %S"
-                   (epg-context-result-for context 'error))))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if errors
+              (signal 'epg-error
+                      (list "Sign keys failed"
+                            (epg-errors-to-string errors))))))
     (epg-reset context)))
 (make-obsolete 'epg-sign-keys "do not use." "23.1")
 
@@ -2532,9 +2615,11 @@ PARAMETERS is a file which tells how to create the key."
       (progn
         (epg-start-generate-key context (epg-make-data-from-file parameters))
         (epg-wait-for-completion context)
-        (if (epg-context-result-for context 'error)
-            (error "Generate key failed: %S"
-                   (epg-context-result-for context 'error))))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if errors
+              (signal 'epg-error
+                      (list "Generate key failed"
+                            (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg-generate-key-from-string (context parameters)
@@ -2544,9 +2629,11 @@ PARAMETERS is a string which tells how to create the key."
       (progn
         (epg-start-generate-key context (epg-make-data-from-string parameters))
         (epg-wait-for-completion context)
-        (if (epg-context-result-for context 'error)
-            (error "Generate key failed: %S"
-                   (epg-context-result-for context 'error))))
+        (let ((errors (epg-context-result-for context 'error)))
+          (if errors
+              (signal 'epg-error
+                      (list "Generate key failed"
+                            (epg-errors-to-string errors))))))
     (epg-reset context)))
 
 (defun epg--decode-percent-escape (string)
diff --git a/lisp/faces.el b/lisp/faces.el
index 302f8af35ac..9a78ab69caa 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1255,7 +1255,7 @@ arg, prompt for a regular expression."
         (insert
          (substitute-command-keys
           (concat
-           "\\<help-mode-map>>Use "
+           "\\<help-mode-map>Use "
            (if (display-mouse-p) "\\[help-follow-mouse] or ")
            "\\[help-follow] on a face name to customize it\n"
            "or on its sample text for a description of the face.\n\n")))
diff --git a/lisp/info.el b/lisp/info.el
index 447c86b3e9e..191e75f9750 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2128,7 +2128,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
                ))
 
 (defun Info-history-toc-nodes (filename)
-  "History-specific implementation of `Info-history-toc-nodes'."
+  "History-specific implementation of `Info-toc-nodes'."
   `(,filename
     ("Top" nil nil nil)))
 
diff --git a/lisp/longlines.el b/lisp/longlines.el
index e81a235a17b..f625d8fcac7 100644
--- a/lisp/longlines.el
+++ b/lisp/longlines.el
@@ -100,8 +100,8 @@ In Long Lines mode, long lines are wrapped if they extend beyond
 `fill-column'.  The soft newlines used for line wrapping will not
 show up when the text is yanked or saved to disk.
 
-With no argument, this command toggles Flyspell mode.
-With a prefix argument ARG, turn Flyspell minor mode on if ARG is positive,
+With no argument, this command toggles Long Lines mode.
+With a prefix argument ARG, turn Long Lines minor mode on if ARG is positive,
 otherwise turn it off.
 
 If the variable `longlines-auto-wrap' is non-nil, lines are automatically
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 6a3638c4232..5714179fcfe 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-07  Chong Yidong  <cyd@stupidchicken.com>
+
+        * url-http.el (url-http-parse-headers): For HTTP 301/302/307,
+        don't convert to a GET request (Bug#701).
+
 2011-07-13  Chris Newton  <redshodan@gmail.com>  (tiny change)
 
         * url-http.el (url-http): Copy over `url-show-status' to the async
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index def35449397..a21aed21436 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -563,16 +563,8 @@ should be shown to the user."
             ;; automatically redirect the request unless it can be
             ;; confirmed by the user, since this might change the
             ;; conditions under which the request was issued.
-            (if (member url-http-method '("HEAD" "GET"))
-                ;; Automatic redirection is ok
-                nil
-              ;; It is just too big of a pain in the ass to get this
-              ;; prompt all the time.  We will just silently lose our
-              ;; data and convert to a GET method.
-              (url-http-debug "Converting `%s' request to `GET' because of REDIRECT(%d)"
-                              url-http-method url-http-response-status)
-              (setq url-http-method "GET"
-                    url-http-data nil)))
+            (unless (member url-http-method '("HEAD" "GET"))
+              (setq redirect-uri nil)))
            (see-other                   ; 303
             ;; The response to the request can be found under a different
             ;; URI and SHOULD be retrieved using a GET method on that
diff --git a/src/ChangeLog b/src/ChangeLog
index 039c225c1f6..4df4455e862 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,18 @@
+2011-08-08  Chong Yidong  <cyd@stupidchicken.com>
+
+        * ftfont.c (ftfont_pattern_entity): Copy the extras argument to
+        the font entity extracted from the cache (Bug#8109).
+
+2011-08-07  Chong Yidong  <cyd@stupidchicken.com>
+
+        * composite.c (autocmp_chars): Don't reset point.  That is done by
+        restore_point_unwind (Bug#5984).
+
+2011-08-07  Juri Linkov  <juri@jurta.org>
+
+        * editfns.c (Fformat_time_string): Doc fix, add tag `usage:'
+        to show the arg `TIME' instead of `TIMEVAL'.
+
 2011-08-06  Eli Zaretskii  <eliz@gnu.org>
 
         * xdisp.c (set_cursor_from_row): Fix cursor positioning when a
diff --git a/src/composite.c b/src/composite.c
index d402d5ad0c4..3308a028042 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -960,8 +960,6 @@ autocmp_chars (Lisp_Object rule, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT
       args[4] = font_object;
       args[5] = string;
       lgstring = safe_call (6, args);
-      if (NILP (string))
-        TEMP_SET_PT_BOTH (pt, pt_byte);
     }
   return unbind_to (count, lgstring);
 }
diff --git a/src/editfns.c b/src/editfns.c
index 577263c5aea..5eed386afb7 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1695,7 +1695,9 @@ The modifiers are `E' and `O'.  For certain characters X,
 %EX is a locale's alternative version of %X;
 %OX is like %X, but uses the locale's number symbols.
 
-For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z".  */)
+For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z".
+
+usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL)  */)
   (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
 {
   time_t value;
diff --git a/src/ftfont.c b/src/ftfont.c
index 4e313a89021..5c98073057c 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -214,6 +214,10 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra)
 
       for (i = 0; i < FONT_OBJLIST_INDEX; i++)
         ASET (val, i, AREF (entity, i));
+
+      ASET (val, FONT_EXTRA_INDEX, Fcopy_sequence (extra));
+      font_put_extra (val, QCfont_entity, key);
+
       return val;
     }
   entity = font_make_entity ();