Accept new TLDs when validating FQDNs
[gnus] / lisp / message.el
index 86a4d02..a0ac449 100644 (file)
@@ -47,6 +47,7 @@
 (require 'mml)
 (require 'rfc822)
 (require 'format-spec)
+(require 'dired)
 
 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
 
@@ -626,7 +627,7 @@ This may also be a list of regexps."
   "If non-nil, delete non-matching headers when forwarding a message.
 Only headers that match this regexp will be included.  This
 variable should be a regexp or a list of regexps."
-  :version "24.5"
+  :version "25.1"
   :group 'message-forwarding
   :type '(repeat :value-to-internal (lambda (widget value)
                                      (custom-split-regexp-maybe value))
@@ -1009,8 +1010,8 @@ configuration.  See the variable `gnus-cite-attribution-suffix'."
 (defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
   "Format of the \"Whomever writes:\" line.
 
-The string is formatted using `format-spec'.  The following
-constructs are replaced:
+The string is formatted using `format-spec'.  The following constructs
+are replaced:
 
   %f   The full From, e.g. \"John Doe <john.doe@example.invalid>\".
   %n   The mail address, e.g. \"john.doe@example.invalid\".
@@ -1018,11 +1019,14 @@ constructs are replaced:
        back to the mail address.
   %F   The first name if present, e.g.: \"John\".
   %L   The last name if present, e.g.: \"Doe\".
+  %Z, %z   The time zone in the numeric form, e.g.:\"+0000\".
 
 All other format specifiers are passed to `format-time-string'
-which is called using the date from the article your replying to.
-Extracting the first (%F) and last name (%L) is done
-heuristically, so you should always check it yourself.
+which is called using the date from the article your replying to, but
+the date in the formatted string will be expressed in the author's
+time zone as much as possible.
+Extracting the first (%F) and last name (%L) is done heuristically,
+so you should always check it yourself.
 
 Please also read the note in the documentation of
 `message-citation-line-function'."
@@ -1959,7 +1963,45 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
          "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
@@ -3571,15 +3613,16 @@ Message buffers and is not meant to be called directly."
       (goto-char (point-max))
       ;; Insert the signature.
       (unless (bolp)
-       (insert "\n"))
+       (newline))
       (when message-signature-insert-empty-line
-       (insert "\n"))
-      (insert "-- \n")
+       (newline))
+      (insert "-- ")
+      (newline)
       (if (eq signature t)
          (insert-file-contents signature-file)
        (insert signature))
       (goto-char (point-max))
-      (or (bolp) (insert "\n")))))
+      (or (bolp) (newline)))))
 
 (defun message-insert-importance-high ()
   "Insert header to mark message as important."
@@ -3963,9 +4006,13 @@ This function uses `mail-citation-hook' if that is non-nil."
 (defvar gnus-extract-address-components)
 
 (autoload 'format-spec "format-spec")
+(autoload 'gnus-date-get-time "gnus-util")
 
-(defun message-insert-formatted-citation-line (&optional from date)
+(defun message-insert-formatted-citation-line (&optional from date tz)
   "Function that inserts a formatted citation line.
+The optional FROM, and DATE are strings containing the contents of
+the From header and the Date header respectively.  The optional TZ
+is a number of seconds, overrides the time zone of DATE.
 
 See `message-citation-line-format'."
   ;; The optional args are for testing/debugging.  They will disappear later.
@@ -3973,7 +4020,7 @@ See `message-citation-line-format'."
   ;; (with-temp-buffer
   ;;   (message-insert-formatted-citation-line
   ;;    "John Doe <john.doe@example.invalid>"
-  ;;    (current-time))
+  ;;    (message-make-date))
   ;;   (buffer-string))
   (when (or message-reply-headers (and from date))
     (unless from
@@ -3990,28 +4037,43 @@ See `message-citation-line-format'."
           (net (car (cdr data)))
           (name-or-net (or (car data)
                            (car (cdr data)) from))
-          (replydate
-           (or
-            date
-            ;; We need Gnus functionality if the user wants date or time from
-            ;; the original article:
-            (when (string-match "%[^fnNFL]" message-citation-line-format)
-              (autoload 'gnus-date-get-time "gnus-util")
-              (gnus-date-get-time (mail-header-date message-reply-headers)))))
+          (time
+           (when (string-match "%[^fnNFL]" message-citation-line-format)
+             (cond ((numberp (car-safe date)) date) ;; backward compatibility
+                   (date (gnus-date-get-time date))
+                   (t
+                    (gnus-date-get-time
+                     (setq date (mail-header-date message-reply-headers)))))))
+          (tz (or tz
+                  (when (stringp date)
+                    (nth 8 (parse-time-string date)))))
           (flist
            (let ((i ?A) lst)
              (when (stringp name)
                ;; Guess first name and last name:
-                (let* ((names (delq nil (mapcar (lambda (x)
-                                                 (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" x) x nil))
-                                               (split-string name "[ \t]+"))))
-                      (count (length names)))
-                  (cond ((= count 1) (setq fname (car names)
-                                           lname ""))
-                        ((or (= count 2) (= count 3)) (setq fname (car names)
-                                                            lname (mapconcat 'identity (cdr names) " ")))
-                        ((> count 3) (setq fname (mapconcat 'identity (butlast names (- count 2)) " ")
-                                           lname (mapconcat 'identity (nthcdr 2 names) " "))) )
+               (let* ((names (delq
+                              nil
+                              (mapcar
+                               (lambda (x)
+                                 (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'"
+                                                   x)
+                                     x
+                                   nil))
+                               (split-string name "[ \t]+"))))
+                      (count (length names)))
+                 (cond ((= count 1)
+                        (setq fname (car names)
+                              lname ""))
+                       ((or (= count 2) (= count 3))
+                        (setq fname (car names)
+                              lname (mapconcat 'identity (cdr names) " ")))
+                       ((> count 3)
+                        (setq fname (mapconcat 'identity
+                                               (butlast names (- count 2))
+                                               " ")
+                              lname (mapconcat 'identity
+                                               (nthcdr 2 names)
+                                               " "))))
                   (when (string-match "\\(.*\\),\\'" fname)
                     (let ((newlname (match-string 1 fname)))
                       (setq fname lname lname newlname)))))
@@ -4041,7 +4103,7 @@ See `message-citation-line-format'."
                               (>= i ?a)))
                  (push i lst)
                  (push (condition-case nil
-                           (format-time-string (format "%%%c" i) replydate)
+                           (gmm-format-time-string (format "%%%c" i) time tz)
                          (error (format ">%c<" i)))
                        lst))
                (setq i (1+ i)))
@@ -5570,7 +5632,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))'."
-  (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))))
@@ -7991,8 +8053,9 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed."
 
 (defun message-tab ()
   "Complete names according to `message-completion-alist'.
-Execute function specified by `message-tab-body-function' when not in
-those headers."
+Execute function specified by `message-tab-body-function' when
+not in those headers.  If that variable is nil, indent with the
+regular text mode tabbing command."
   (interactive)
   (cond
    ((if (and (boundp 'completion-fail-discreetly)
@@ -8484,6 +8547,17 @@ Used in `message-simplify-recipients'."
         (message-fetch-field hdr) t))
       ", "))))
 
+;;; multipart/related and HTML support.
+
+(defun message-make-html-message-with-image-files (files)
+  (interactive (list (dired-get-marked-files nil current-prefix-arg)))
+  (message-mail)
+  (message-goto-body)
+  (insert "<#part type=text/html>\n\n")
+  (dolist (file files)
+    (insert (format "<img src=%S>\n\n" file)))
+  (message-goto-to))
+
 (when (featurep 'xemacs)
   (require 'messagexmas)
   (message-xmas-redefine))