auto upstream

11 files changed, 139 insertions, 53 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 66c18a25803..3d5308875de 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,28 @@
+2013-02-17  Didier Verna  <didier@didierverna.net>
+
+        * net/network-stream.el (network-stream-open-starttls):
+        Check that response to the starttls-command is non-nil.  (Bug#13706)
+
+2013-02-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * font-lock.el (lisp-font-lock-keywords-1, lisp-font-lock-keywords-2):
+        Don't assume all identifier chars have syntax word.
+        * emacs-lisp/lisp-mode.el (lisp-mode-variables):
+        Remove bar-not-symbol.  Adjust callers.
+        (lisp-mode-variables): Don't set a font-lock-syntax-table.
+
+2013-02-17  Leo Liu  <sdl.web@gmail.com>
+
+        * net/rcirc.el (rcirc-keepalive): Fix invalid timer error.
+
+2013-02-17  Glenn Morris  <rgm@gnu.org>
+
+        * menu-bar.el (menu-bar-tools-menu): Fix case of EDE entry.
+
+        * image-mode.el (image-mode-map): Add image-dired menu entry.
+
+        * image-dired.el (tumme): Make this alias obsolete.
+
 2013-02-16  Glenn Morris  <rgm@gnu.org>
 
         * image.el (image-animated-types): Remove.
@@ -20,8 +45,8 @@
 
         * net/tramp-compat.el (top): Require 'trampver.
 
-        * net/tramp-sh.el (tramp-remote-process-environment): Set
-        tramp-autoload cookie.
+        * net/tramp-sh.el (tramp-remote-process-environment):
+        Set tramp-autoload cookie.
 
 2013-02-16  Kevin Ryde  <user42@zip.com.au>
 
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index cd60d80b056..4ebaa0a49d5 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -187,14 +187,12 @@ It has `lisp-mode-abbrev-table' as its parent."
               font-lock-string-face))))
     font-lock-comment-face))
 
-(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive
-                                      bar-not-symbol)
+(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive)
   "Common initialization routine for lisp modes.
 The LISP-SYNTAX argument is used by code in inf-lisp.el and is
 \(uselessly) passed from pp.el, chistory.el, gnus-kill.el and
 score-mode.el.  KEYWORDS-CASE-INSENSITIVE non-nil means that for
-font-lock keywords will not be case sensitive.  BAR-NOT-SYMBOL
-non-nil means that | is not a symbol character."
+font-lock keywords will not be case sensitive."
   (when lisp-syntax
     (set-syntax-table lisp-mode-syntax-table))
   (setq-local paragraph-ignore-fill-prefix t)
@@ -228,9 +226,7 @@ non-nil means that | is not a symbol character."
   (setq font-lock-defaults
         `((lisp-font-lock-keywords
            lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
-          nil ,keywords-case-insensitive
-          ((,(concat "+-*/.<>=!?$%_&~^:@" (if bar-not-symbol "" "|")) . "w"))
-          nil
+          nil ,keywords-case-insensitive nil nil
           (font-lock-mark-block-function . mark-defun)
           (font-lock-syntactic-face-function
            . lisp-font-lock-syntactic-face-function))))
@@ -553,7 +549,7 @@ or to switch back to an existing one.
 
 Entry to this mode calls the value of `lisp-mode-hook'
 if that value is non-nil."
-  (lisp-mode-variables nil t t)
+  (lisp-mode-variables nil t)
   (setq-local find-tag-default-function 'lisp-find-tag-default)
   (setq-local comment-start-skip
               "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 6e3476ac9a5..e5ce4db171b 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -2259,10 +2259,10 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
                 "\\(const\\(ant\\)?\\|custom\\|varalias\\|face\\|parameter\\|var\\(?:-local\\)?\\)\\|"
                 ;; Structure declarations.
                 "\\(class\\|group\\|theme\\|package\\|struct\\|type\\)"
-                "\\)\\)\\>"
+                "\\)\\)\\_>"
                 ;; Any whitespace and defined object.
                 "[ \t'\(]*"
-                "\\(setf[ \t]+\\sw+\\|\\sw+\\)?")
+                "\\(setf[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
        (1 font-lock-keyword-face)
        (9 (cond ((match-beginning 3) font-lock-function-name-face)
                 ((match-beginning 6) font-lock-variable-name-face)
@@ -2299,7 +2299,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
                  "with-silent-modifications" "with-syntax-table"
                  "with-temp-buffer" "with-temp-file" "with-temp-message"
                  "with-timeout" "with-timeout-handler" "with-wrapper-hook") t)
-          "\\>")
+          "\\_>")
           .  1)
        ;; Control structures.  Common Lisp forms.
        (,(concat
@@ -2320,23 +2320,25 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
                  "with-open-stream" "with-output-to-string"
                  "with-package-iterator" "with-simple-restart"
                  "with-slots" "with-standard-io-syntax") t)
-          "\\>")
+          "\\_>")
           . 1)
        ;; Exit/Feature symbols as constants.
        (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\>"
-                 "[ \t']*\\(\\sw+\\)?")
+                 "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
         (1 font-lock-keyword-face)
         (2 font-lock-constant-face nil t))
        ;; Erroneous structures.
        ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face)
        ;; Words inside \\[] tend to be for `substitute-command-keys'.
-       ("\\\\\\\\\\[\\(\\sw+\\)\\]" 1 font-lock-constant-face prepend)
+       ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
+        (1 font-lock-constant-face prepend))
        ;; Words inside `' tend to be symbol names.
-       ("`\\(\\sw\\sw+\\)'" 1 font-lock-constant-face prepend)
+       ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
+        (1 font-lock-constant-face prepend))
        ;; Constant values.
-       ("\\<:\\sw+\\>" 0 font-lock-builtin-face)
+       ("\\<:\\(?:\\sw\\|\\s_\\)+\\>" 0 font-lock-builtin-face)
        ;; ELisp and CLisp `&' keywords as types.
-       ("\\<\\&\\sw+\\>" . font-lock-type-face)
+       ("\\<\\&\\(?:\\sw\\|\\s_\\)+\\>" . font-lock-type-face)
        ;; ELisp regexp grouping constructs
        ((lambda (bound)
           (catch 'found
@@ -2353,11 +2355,11 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
                     (throw 'found t)))))))
         (1 'font-lock-regexp-grouping-backslash prepend)
         (3 'font-lock-regexp-grouping-construct prepend))
-;;;  This is too general -- rms.
-;;;  A user complained that he has functions whose names start with `do'
-;;;  and that they get the wrong color.
-;;;      ;; CL `with-' and `do-' constructs
-;;;      ("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+       ;; This is too general -- rms.
+       ;; A user complained that he has functions whose names start with `do'
+       ;; and that they get the wrong color.
+       ;; ;; CL `with-' and `do-' constructs
+       ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
       )))
   "Gaudy level highlighting for Lisp modes.")
 
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 5030da87672..8de9e89a23d 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,18 @@
+2013-02-17  Daiki Ueno  <ueno@gnu.org>
+
+        * mml2015.el (epg-key-user-id-list, epg-user-id-string)
+        (epg-user-id-validity): Autoload.
+        (mml2015-epg-check-user-id): New function.
+        (mml2015-epg-check-sub-key): New function split from
+        mml2015-epg-find-usable-key.
+        (mml2015-epg-find-usable-key): Accept context, name, usage, and
+        optional name-is-key-id, to handle the case when user-id is unusable.
+        Reported by Łukasz Stelmach <stlman@poczta.fm>.
+
+2013-02-17  Glenn Morris  <rgm@gnu.org>
+
+        * shr.el (shr-put-image): Use image-multi-frame-p if available.
+
 2013-02-16  Glenn Morris  <rgm@gnu.org>
 
         * shr.el (shr-put-image): Only animate images that specify a delay.
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 275a4867e85..b20c02aa26f 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -757,6 +757,9 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
 (autoload 'epg-sub-key-fingerprint "epg")
 (autoload 'epg-signature-key-id "epg")
 (autoload 'epg-signature-to-string "epg")
+(autoload 'epg-key-user-id-list "epg")
+(autoload 'epg-user-id-string "epg")
+(autoload 'epg-user-id-validity "epg")
 (autoload 'epg-configuration "epg-config")
 (autoload 'epg-expand-group "epg-config")
 (autoload 'epa-select-keys "epa")
@@ -786,21 +789,53 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
               (cons password-cache-key-id mml2015-epg-secret-key-id-list))
         (copy-sequence passphrase)))))
 
-(defun mml2015-epg-find-usable-key (keys usage)
-  (catch 'found
+(defun mml2015-epg-check-user-id (key recipient)
+  (let ((pointer (epg-key-user-id-list key))
+        result)
+    (while pointer
+      (if (and (equal (car (mail-header-parse-address
+                            (epg-user-id-string (car pointer))))
+                      (car (mail-header-parse-address
+                            recipient)))
+               (not (memq (epg-user-id-validity (car pointer))
+                          '(revoked expired))))
+          (setq result t
+                pointer nil)
+        (setq pointer (cdr pointer))))
+    result))
+
+(defun mml2015-epg-check-sub-key (key usage)
+  (let ((pointer (epg-key-sub-key-list key))
+        result)
+    ;; The primary key will be marked as disabled, when the entire
+    ;; key is disabled (see 12 Field, Format of colon listings, in
+    ;; gnupg/doc/DETAILS)
+    (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
+      (while pointer
+        (if (and (memq usage (epg-sub-key-capability (car pointer)))
+                 (not (memq (epg-sub-key-validity (car pointer))
+                            '(revoked expired))))
+            (setq result t
+                  pointer nil)
+          (setq pointer (cdr pointer)))))
+    result))
+
+(defun mml2015-epg-find-usable-key (context name usage
+                                            &optional name-is-key-id)
+  (let ((keys (epg-list-keys context name))
+        key)
     (while keys
-      (let ((pointer (epg-key-sub-key-list (car keys))))
-        ;; The primary key will be marked as disabled, when the entire
-        ;; key is disabled (see 12 Field, Format of colon listings, in
-        ;; gnupg/doc/DETAILS)
-        (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
-          (while pointer
-            (if (and (memq usage (epg-sub-key-capability (car pointer)))
-                     (not (memq (epg-sub-key-validity (car pointer))
-                                '(revoked expired))))
-                (throw 'found (car keys)))
-            (setq pointer (cdr pointer)))))
-      (setq keys (cdr keys)))))
+      (if (and (or name-is-key-id
+                   ;; Non email user-id can be supplied through
+                   ;; mml2015-signers if mml2015-encrypt-to-self is set.
+                   ;; Treat it as valid, as it is user's intention.
+                   (not (string-match "\\`<" name))
+                   (mml2015-epg-check-user-id (car keys) name))
+               (mml2015-epg-check-sub-key (car keys) usage))
+          (setq key (car keys)
+                keys nil)
+        (setq keys (cdr keys))))
+    key))
 
 ;; XXX: since gpg --list-secret-keys does not return validity of each
 ;; key, `mml2015-epg-find-usable-key' defined above is not enough for
@@ -811,10 +846,12 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
         secret-key)
     (while (and (not secret-key) secret-keys)
       (if (mml2015-epg-find-usable-key
-           (epg-list-keys context (epg-sub-key-fingerprint
-                                   (car (epg-key-sub-key-list
-                                         (car secret-keys)))))
-           usage)
+           context
+           (epg-sub-key-fingerprint
+            (car (epg-key-sub-key-list
+                  (car secret-keys))))
+           usage
+           t)
           (setq secret-key (car secret-keys)
                 secret-keys nil)
         (setq secret-keys (cdr secret-keys))))
@@ -1115,8 +1152,7 @@ If no one is selected, symmetric encryption will be performed.  "
                     (mapcar
                      (lambda (recipient)
                        (setq recipient-key (mml2015-epg-find-usable-key
-                                            (epg-list-keys context recipient)
-                                            'encrypt))
+                                            context recipient 'encrypt))
                        (unless (or recipient-key
                                    (y-or-n-p
                                     (format "No public key for %s; skip it? "
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 1294ca7cd69..886f4da53dc 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -615,8 +615,12 @@ size, and full-buffer size."
                   (overlay-put overlay 'face 'default)))
             (insert-image image (or alt "*")))
           (put-text-property start (point) 'image-size size)
-          ;; Only animate multi-frame things that specify a delay.  FIXME?
-          (when (cdr (image-animated-p image))
+          (when (if (fboundp 'image-multi-frame-p)
+                    ;; Only animate multi-frame things that specify a
+                    ;; delay; eg animated gifs as opposed to
+                    ;; multi-page tiffs.  FIXME?
+                    (cdr (image-multi-frame-p image))
+                  (image-animated-p image))
             (image-animate image nil 60)))
         image)
     (insert alt)))
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 354e16b0bfb..bbb41d49a1d 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -883,7 +883,7 @@ displayed."
 (defalias 'image-dired 'image-dired-show-all-from-dir)
 
 ;;;###autoload
-(defalias 'tumme 'image-dired-show-all-from-dir)
+(define-obsolete-function-alias 'tumme 'image-dired "24.4")
 
 (defun image-dired-sane-db-file ()
   "Check if `image-dired-db-file' exists.
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 52367811341..7787a26cc08 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -376,9 +376,15 @@ call."
          :visible (eq image-type 'imagemagick)
          :help "Rotate the image"]
         "--"
-        ["Next Image" image-next-file :active t
+        ["Show Thumbnails"
+         (lambda ()
+           (interactive)
+           (image-dired default-directory))
+         :active default-directory
+         :help "Show thumbnails for all images in this directory"]
+        ["Next Image" image-next-file :active buffer-file-name
          :help "Move to next image in this directory"]
-        ["Previous Image" image-previous-file :active t
+        ["Previous Image" image-previous-file :active buffer-file-name
          :help "Move to previous image in this directory"]
         "--"
         ["Animate Image" image-toggle-animation :style toggle
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 60f2bc2999f..be459fe38d5 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1518,7 +1518,7 @@ mail status in mode line"))
                   :button (:toggle . (bound-and-true-p semantic-mode))))
 
     (bindings--define-key menu [ede]
-      '(menu-item "Project support (EDE)"
+      '(menu-item "Project Support (EDE)"
                   global-ede-mode
                   :help "Toggle the Emacs Development Environment (Global EDE mode)"
                   :button (:toggle . (bound-and-true-p global-ede-mode))))
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 8cf9ec67e53..fd21997ba28 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -262,8 +262,9 @@ STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
         ;; EHLO for SMTP.
         (when (plist-get parameters :always-query-capabilities)
           (network-stream-command stream capability-command eo-capa)))
-      (when (string-match success-string
-                          (network-stream-command stream starttls-command eoc))
+      (when (let ((response
+                   (network-stream-command stream starttls-command eoc)))
+              (and response (string-match success-string response)))
         ;; The server said it was OK to begin STARTTLS negotiations.
         (if builtin-starttls
             (let ((cert (network-stream-certificate host service parameters)))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 086043c2b4a..7c70ded3eaa 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -625,7 +625,8 @@ last ping."
                                            (rcirc-float-time))))))
             (rcirc-process-list))
     ;; no processes, clean up timer
-    (cancel-timer rcirc-keepalive-timer)
+    (when (timerp rcirc-keepalive-timer)
+      (cancel-timer rcirc-keepalive-timer))
     (setq rcirc-keepalive-timer nil)))
 
 (defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)