Fixup of previous commit de5278e5. "I should have done as Katsumi
[gnus] / lisp / message.el
index 5ba42b1..aef423c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; message.el --- composing mail and news messages
 
 ;;; message.el --- composing mail and news messages
 
-;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
@@ -1017,7 +1017,8 @@ are replaced:
   %n   The mail address, e.g. \"john.doe@example.invalid\".
   %N   The real name if present, e.g.: \"John Doe\", else fall
        back to the mail address.
   %n   The mail address, e.g. \"john.doe@example.invalid\".
   %N   The real name if present, e.g.: \"John Doe\", else fall
        back to the mail address.
-  %F   The first name if present, e.g.: \"John\".
+  %F   The first name if present, e.g.: \"John\", else fall
+       back to the mail address.
   %L   The last name if present, e.g.: \"Doe\".
   %Z, %z   The time zone in the numeric form, e.g.:\"+0000\".
 
   %L   The last name if present, e.g.: \"Doe\".
   %Z, %z   The time zone in the numeric form, e.g.:\"+0000\".
 
@@ -1800,13 +1801,17 @@ no, only reply back to the author."
   :type '(radio (const :format "%v  " nil)
                (string :format "FQDN: %v")))
 
   :type '(radio (const :format "%v  " nil)
                (string :format "FQDN: %v")))
 
-(defcustom message-use-idna (and (condition-case nil (require 'idna)
-                                  (file-error))
-                                (mm-coding-system-p 'utf-8)
-                                (executable-find idna-program)
-                                (string= (idna-to-ascii "räksmörgås")
-                                         "xn--rksmrgs-5wao1o")
-                                t)
+(defcustom message-use-idna
+  (and (or (mm-coding-system-p 'utf-8)
+          (condition-case nil
+              (let (mucs-ignore-version-incompatibilities)
+                (require 'un-define))
+            (error)))
+       (condition-case nil (require 'idna) (file-error))
+       idna-program
+       (executable-find idna-program)
+       (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o")
+       t)
   "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
 GNU Libidn, and in particular the elisp package \"idna.el\" and
 the external program \"idn\", must be installed for this
   "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
 GNU Libidn, and in particular the elisp package \"idna.el\" and
 the external program \"idn\", must be installed for this
@@ -1963,7 +1968,45 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
          "cat\\|com\\|coop\\|edu\\|gov\\|"
          "info\\|int\\|jobs\\|"
          "mil\\|mobi\\|museum\\|name\\|net\\|"
          "cat\\|com\\|coop\\|edu\\|gov\\|"
          "info\\|int\\|jobs\\|"
          "mil\\|mobi\\|museum\\|name\\|net\\|"
-         "org\\|pro\\|tel\\|travel\\|uucp\\)")
+         "org\\|pro\\|tel\\|travel\\|uucp\\|"
+          ;; ICANN-era generic top-level domains
+          "academy\\|actor\\|agency\\|airforce\\|archi\\|associates\\|axa\\|"
+          "bar\\|bargains\\|bayern\\|beer\\|berlin\\|best\\|bid\\|bike\\|"
+          "biz\\|black\\|blackfriday\\|blue\\|boutique\\|build\\|builders\\|"
+          "buzz\\|cab\\|camera\\|camp\\|capital\\|cards\\|care\\|career\\|"
+          "careers\\|cash\\|catering\\|center\\|ceo\\|cheap\\|christmas\\|"
+          "church\\|citic\\|cleaning\\|clinic\\|clothing\\|club\\|codes\\|"
+          "coffee\\|college\\|cologne\\|com\\|community\\|company\\|computer\\|"
+          "construction\\|contractors\\|cooking\\|cool\\|country\\|creditcard\\|"
+          "cruises\\|dance\\|dating\\|democrat\\|dental\\|desi\\|design\\|"
+          "diamonds\\|directory\\|discount\\|domains\\|education\\|email\\|"
+          "engineering\\|enterprises\\|equipment\\|estate\\|eus\\|events\\|"
+          "exchange\\|expert\\|exposed\\|fail\\|farm\\|feedback\\|finance\\|"
+          "financial\\|fish\\|fishing\\|fitness\\|flights\\|florist\\|foo\\|"
+          "foundation\\|frogans\\|fund\\|furniture\\|futbol\\|gal\\|"
+          "gallery\\|gift\\|glass\\|globo\\|gmo\\|gop\\|graphics\\|gratis\\|"
+          "gripe\\|guide\\|guitars\\|guru\\|hamburg\\|haus\\|hiphop\\|"
+          "holdings\\|holiday\\|homes\\|horse\\|house\\|immobilien\\|"
+          "industries\\|info\\|ink\\|institute\\|insure\\|international\\|"
+          "investments\\|jetzt\\|juegos\\|kaufen\\|kim\\|kitchen\\|kiwi\\|"
+          "koeln\\|kred\\|land\\|lat\\|latino\\|lease\\|life\\|lighting\\|"
+          "limited\\|limo\\|link\\|loans\\|london\\|luxe\\|luxury\\|"
+          "management\\|mango\\|marketing\\|media\\|meet\\|menu\\|miami\\|"
+          "moda\\|moe\\|monash\\|moscow\\|motorcycles\\|nagoya\\|name\\|"
+          "net\\|neustar\\|ninja\\|nyc\\|okinawa\\|onl\\|org\\|paris\\|"
+          "partners\\|parts\\|photo\\|photography\\|photos\\|pics\\|"
+          "pictures\\|pink\\|plumbing\\|pro\\|productions\\|properties\\|"
+          "pub\\|qpon\\|quebec\\|recipes\\|red\\|reisen\\|ren\\|rentals\\|"
+          "repair\\|report\\|rest\\|reviews\\|rich\\|rocks\\|rodeo\\|"
+          "ruhr\\|ryukyu\\|saarland\\|schule\\|scot\\|services\\|sexy\\|"
+          "shiksha\\|shoes\\|singles\\|social\\|sohu\\|solar\\|solutions\\|"
+          "soy\\|supplies\\|supply\\|support\\|surgery\\|systems\\|tattoo\\|"
+          "tax\\|technology\\|tienda\\|tips\\|today\\|tokyo\\|tools\\|"
+          "town\\|toys\\|trade\\|training\\|university\\|uno\\|vacations\\|"
+          "vegas\\|ventures\\|viajes\\|villas\\|vision\\|vodka\\|vote\\|"
+          "voting\\|voto\\|voyage\\|wang\\|watch\\|webcam\\|wed\\|wien\\|"
+          "wiki\\|works\\|wtc\\|wtf\\|xyz\\|yachts\\|yokohama\\|you\\|"
+          "zone\\)")
   ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
   ;; http://en.wikipedia.org/wiki/GTLD
   ;; `approved, but not yet in operation': .xxx
   ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
   ;; http://en.wikipedia.org/wiki/GTLD
   ;; `approved, but not yet in operation': .xxx
@@ -2308,7 +2351,7 @@ Leading \"Re: \" is not stripped by this function.  Use the function
                   ((not (string-match
                          (concat "^[ \t]*"
                                  (regexp-quote new-subject)
                   ((not (string-match
                          (concat "^[ \t]*"
                                  (regexp-quote new-subject)
-                                 " \t]*$")
+                                 "[ \t]*$")
                          old-subject))  ; yes, it really is a new subject
                    ;; delete eventual Re: prefix
                    (setq old-subject
                          old-subject))  ; yes, it really is a new subject
                    ;; delete eventual Re: prefix
                    (setq old-subject
@@ -4041,7 +4084,7 @@ See `message-citation-line-format'."
                       (setq fname lname lname newlname)))))
              ;; The following letters are not used in `format-time-string':
              (push ?E lst) (push "<E>" lst)
                       (setq fname lname lname newlname)))))
              ;; The following letters are not used in `format-time-string':
              (push ?E lst) (push "<E>" lst)
-             (push ?F lst) (push fname lst)
+             (push ?F lst) (push (or fname name-or-net) lst)
              ;; We might want to use "" instead of "<X>" later.
              (push ?J lst) (push "<J>" lst)
              (push ?K lst) (push "<K>" lst)
              ;; We might want to use "" instead of "<X>" later.
              (push ?J lst) (push "<J>" lst)
              (push ?K lst) (push "<K>" lst)
@@ -4908,6 +4951,11 @@ evaluates `message-send-mail-hook' just before sending a message.
 It is useful if your ISP requires the POP-before-SMTP
 authentication.  See the Gnus manual for details."
   (run-hooks 'message-send-mail-hook)
 It is useful if your ISP requires the POP-before-SMTP
 authentication.  See the Gnus manual for details."
   (run-hooks 'message-send-mail-hook)
+  ;; Change header-delimiter to be what smtpmail expects.
+  (goto-char (point-min))
+  (when (re-search-forward
+        (concat "^" (regexp-quote mail-header-separator) "\n"))
+    (replace-match "\n"))
   (smtpmail-send-it))
 
 (defun message-send-mail-with-mailclient ()
   (smtpmail-send-it))
 
 (defun message-send-mail-with-mailclient ()
@@ -5594,7 +5642,7 @@ If NOW, use that time instead."
   "Make date string for the Expires header.  Expiry in DAYS days.
 
 In posting styles use `(\"Expires\" (make-expires-date 30))'."
   "Make date string for the Expires header.  Expiry in DAYS days.
 
 In posting styles use `(\"Expires\" (make-expires-date 30))'."
-  (let* ((cur (decode-time (current-time)))
+  (let* ((cur (decode-time))
         (nday (+ days (nth 3 cur))))
     (setf (nth 3 cur) nday)
     (message-make-date (apply 'encode-time cur))))
         (nday (+ days (nth 3 cur))))
     (setf (nth 3 cur) nday)
     (message-make-date (apply 'encode-time cur))))
@@ -5851,7 +5899,7 @@ give as trustworthy answer as possible."
 
 (defun message-make-fqdn ()
   "Return user's fully qualified domain name."
 
 (defun message-make-fqdn ()
   "Return user's fully qualified domain name."
-  (let* ((system-name (system-name))
+  (let* ((sysname (system-name))
         (user-mail (message-user-mail-address))
         (user-domain
          (if (and user-mail
         (user-mail (message-user-mail-address))
         (user-domain
          (if (and user-mail
@@ -5865,10 +5913,10 @@ give as trustworthy answer as possible."
           (not (string-match message-bogus-system-names message-user-fqdn)))
       ;; `message-user-fqdn' seems to be valid
       message-user-fqdn)
           (not (string-match message-bogus-system-names message-user-fqdn)))
       ;; `message-user-fqdn' seems to be valid
       message-user-fqdn)
-     ((and (string-match message-valid-fqdn-regexp system-name)
-          (not (string-match message-bogus-system-names system-name)))
+     ((and (string-match message-valid-fqdn-regexp sysname)
+          (not (string-match message-bogus-system-names sysname)))
       ;; `system-name' returned the right result.
       ;; `system-name' returned the right result.
-      system-name)
+      sysname)
      ;; Try `mail-host-address'.
      ((and (boundp 'mail-host-address)
           (stringp mail-host-address)
      ;; Try `mail-host-address'.
      ((and (boundp 'mail-host-address)
           (stringp mail-host-address)
@@ -5883,7 +5931,7 @@ give as trustworthy answer as possible."
       user-domain)
      ;; Default to this bogus thing.
      (t
       user-domain)
      ;; Default to this bogus thing.
      (t
-      (concat system-name
+      (concat sysname
              ".i-did-not-set--mail-host-address--so-tickle-me")))))
 
 (defun message-make-domain ()
              ".i-did-not-set--mail-host-address--so-tickle-me")))))
 
 (defun message-make-domain ()