* gnus-sieve.el (gnus-sieve-crosspost): Fix type.
[gnus] / lisp / message.el
index 2a077e1..abd30b9 100644 (file)
@@ -145,7 +145,7 @@ If the string contains the format spec \"%s\", the Newsgroups
 the article has been posted to will be inserted there.
 If this variable is nil, no such courtesy message will be added."
   :group 'message-sending
-  :type 'string)
+  :type '(radio (string :format "%t: %v\n" :size 0) (const nil)))
 
 (defcustom message-ignored-bounced-headers
   "^\\(Received\\|Return-Path\\|Delivered-To\\):"
@@ -330,7 +330,7 @@ few false positives here."
 (defcustom message-archive-header
   "X-No-Archive: Yes\n"
   "Header to insert when you don't want your article to be archived.
-Archives \(such as groups.googgle.com\) respect this header."
+Archives \(such as groups.google.com\) respect this header."
   :type 'string
   :group 'message-various)
 
@@ -339,7 +339,8 @@ Archives \(such as groups.googgle.com\) respect this header."
   "X-No-Archive: Yes - save http://groups.google.com/"
   "Note to insert why you wouldn't want this posting archived.
 If nil, don't insert any text in the body."
-  :type 'string
+  :type '(radio (string :format "%t: %v\n" :size 0)
+               (const nil))
   :group 'message-various)
 
 ;;; Crossposts and Followups
@@ -456,6 +457,7 @@ The provided functions are:
   :group 'message-forwarding
   :type '(radio (function-item message-forward-subject-author-subject)
                (function-item message-forward-subject-fwd)
+               (function-item message-forward-subject-name-subject)
                (repeat :tag "List of functions" function)))
 
 (defcustom message-forward-as-mime t
@@ -602,7 +604,7 @@ always use the value."
 
 (defcustom message-subscribed-address-functions nil
   "*Specifies functions for determining list subscription.
-If nil, do not attempt to determine list subscribtion with functions.
+If nil, do not attempt to determine list subscription with functions.
 If non-nil, this variable contains a list of functions which return
 regular expressions to match lists.  These functions can be used in
 conjunction with `message-subscribed-regexps' and
@@ -615,12 +617,13 @@ conjunction with `message-subscribed-regexps' and
 If nil, do not look at any files to determine list subscriptions.  If
 non-nil, each line of this file should be a mailing list address."
   :group 'message-interface
-  :type 'string)
+  :type '(radio (file :format "%t: %v\n" :size 0)
+               (const nil)))
 
 (defcustom message-subscribed-addresses nil
   "*Specifies a list of addresses the user is subscribed to.
 If nil, do not use any predefined list subscriptions.  This list of
-addresses can be used in conjuction with
+addresses can be used in conjunction with
 `message-subscribed-address-functions' and `message-subscribed-regexps'."
   :group 'message-interface
   :type '(repeat string))
@@ -628,7 +631,7 @@ addresses can be used in conjuction with
 (defcustom message-subscribed-regexps nil
   "*Specifies a list of addresses the user is subscribed to.
 If nil, do not use any predefined list subscriptions.  This list of
-regular expressions can be used in conjuction with
+regular expressions can be used in conjunction with
 `message-subscribed-address-functions' and `message-subscribed-addresses'."
   :group 'message-interface
   :type '(repeat regexp))
@@ -1311,7 +1314,8 @@ no, only reply back to the author."
   "*Domain part of Messsage-Ids."
   :group 'message-headers
   :link '(custom-manual "(message)News Headers")
-  :type 'string)
+  :type '(radio (const :format "%v  " nil)
+               (string :format "FQDN: %v\n" :size 0)))
 
 (defcustom message-use-idna (and (condition-case nil (require 'idna)
                                   (file-error))
@@ -3322,11 +3326,14 @@ It should typically alter the sending method in some way or other."
        (add-text-properties point (1+ point)
                             '(invisible nil intangible nil)))))
   ;; Make invisible text visible.
+  ;; It doesn't seem as if this is useful, since the invisible property
+  ;; is clobbered by an after-change hook anyhow.
   (message-check 'invisible-text
     (let ((points (message-text-with-property 'invisible)))
       (when points
        (goto-char (car points))
        (dolist (point points)
+         (put-text-property point (1+ point) 'invisible nil)
          (message-overlay-put (message-make-overlay point (1+ point))
                               'face 'highlight))
        (unless (yes-or-no-p
@@ -3644,7 +3651,7 @@ If you always want Gnus to send messages in one piece, set
                        (if resend-to-addresses
                            (list resend-to-addresses)
                          '("-t"))))))
-           (unless (or (null cpr) (zerop cpr))
+           (unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
              (error "Sending...failed with exit value %d" cpr)))
          (when message-interactive
            (save-excursion
@@ -3730,7 +3737,7 @@ documentation for the function `mail-source-touch-pop'."
   (smtpmail-send-it))
 
 (defun message-canlock-generate ()
-  "Return a string that is non-trival to guess.
+  "Return a string that is non-trivial to guess.
 Do not use this for anything important, it is cryptographically weak."
   (let (sha1-maximum-internal-length)
     (sha1 (concat (message-unique-id)
@@ -4546,6 +4553,16 @@ If NOW, use that time instead."
                         (aset tmp (1- (match-end 0)) ?-))
                       (string-match "[\\()]" tmp)))))
        (insert fullname)
+       (goto-char (point-min))
+       ;; Look for a character that cannot appear unquoted
+       ;; according to RFC 822.
+       (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
+         ;; Quote fullname, escaping specials.
+         (goto-char (point-min))
+         (insert "\"")
+         (while (re-search-forward "[\"\\]" nil 1)
+           (replace-match "\\\\\\&" t))
+         (insert "\""))
        (insert " <" login ">"))
        (t                              ; 'parens or default
        (insert login " (")
@@ -5085,8 +5102,17 @@ than 988 characters long, and if they are not, trim them until they are."
   :type 'boolean)
 
 (defun message-beginning-of-line (&optional n)
-  "Move point to beginning of header value.
-If the option `message-beginning-of-line' is non-nil move to
+  "Move point to beginning of header value or to beginning of line.
+The prefix argument N is passed directly to `beginning-of-line'.
+
+This command is identical to `beginning-of-line' if point is
+outside the message header or if the option `message-beginning-of-line'
+is nil.
+
+If point is in the message header and on a (non-continued) header
+line, move point to the beginning of the header value.  If point
+is already there, move point to beginning of line.  Therefore,
+repeated calls will toggle point between beginning of field and
 beginning of line."
   (interactive "p")
   (let ((zrs 'zmacs-region-stays))
@@ -5693,6 +5719,48 @@ responses here are directed to other newsgroups."))
 
      cur)))
 
+(defun message-is-yours-p ()
+  "Non-nil means current article is yours.
+If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles
+are yours except those that have Cancel-Lock header not belonging to you.
+Instead of shooting GNKSA feet, you should modify 'message-alternative-emails'
+regexp to match all of yours addresses."
+  ;; Canlock-logic as suggested by Per Abrahamsen
+  ;; <abraham@dina.kvl.dk>
+  ;;
+  ;; IF article has cancel-lock THEN
+  ;;   IF we can verify it THEN
+  ;;     issue cancel
+  ;;   ELSE
+  ;;     error: cancellock: article is not yours
+  ;; ELSE
+  ;;   Use old rules, comparing sender...
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-head-1)
+      (if (message-fetch-field "Cancel-Lock")
+         (if (null (canlock-verify))
+             t
+           (error "Failed to verify Cancel-lock: This article is not yours"))
+       (let (sender from)
+         (or
+          (message-gnksa-enable-p 'cancel-messages)
+          (and (setq sender (message-fetch-field "sender"))
+               (string-equal (downcase sender)
+                             (downcase (message-make-sender))))
+          ;; Email address in From field equals to our address
+          (and (setq from (message-fetch-field "from"))
+               (string-equal
+                (downcase (cadr (mail-extract-address-components from)))
+                (downcase (cadr (mail-extract-address-components
+                                 (message-make-from))))))
+          ;; Email address in From field matches
+          ;; 'message-alternative-emails' regexp
+          (and from
+               message-alternative-emails
+               (string-match
+                message-alternative-emails
+                (cadr (mail-extract-address-components from))))))))))
 
 ;;;###autoload
 (defun message-cancel-news (&optional arg)
@@ -5701,42 +5769,17 @@ If ARG, allow editing of the cancellation message."
   (interactive "P")
   (unless (message-news-p)
     (error "This is not a news article; canceling is impossible"))
-  (let (from newsgroups message-id distribution buf sender)
+  (let (from newsgroups message-id distribution buf)
     (save-excursion
       ;; Get header info from original article.
       (save-restriction
        (message-narrow-to-head-1)
        (setq from (message-fetch-field "from")
-             sender (message-fetch-field "sender")
              newsgroups (message-fetch-field "newsgroups")
              message-id (message-fetch-field "message-id" t)
              distribution (message-fetch-field "distribution")))
       ;; Make sure that this article was written by the user.
-      (unless (or
-              ;; Canlock-logic as suggested by Per Abrahamsen
-              ;; <abraham@dina.kvl.dk>
-              ;;
-              ;; IF article has cancel-lock THEN
-              ;;   IF we can verify it THEN
-              ;;     issue cancel
-              ;;   ELSE
-              ;;     error: cancellock: article is not yours
-              ;; ELSE
-              ;;   Use old rules, comparing sender...
-              (if (message-fetch-field "Cancel-Lock")
-                  (if (null (canlock-verify))
-                      t
-                    (error "Failed to verify Cancel-lock: This article is not yours"))
-                nil)
-              (message-gnksa-enable-p 'cancel-messages)
-              (and sender
-                   (string-equal
-                    (downcase sender)
-                    (downcase (message-make-sender))))
-              (string-equal
-               (downcase (cadr (mail-extract-address-components from)))
-               (downcase (cadr (mail-extract-address-components
-                                (message-make-from))))))
+      (unless (message-is-yours-p)
        (error "This article is not yours"))
       (when (yes-or-no-p "Do you really want to cancel this article? ")
        ;; Make control message.
@@ -5768,35 +5811,9 @@ If ARG, allow editing of the cancellation message."
 This is done simply by taking the old article and adding a Supersedes
 header line with the old Message-ID."
   (interactive)
-  (let ((cur (current-buffer))
-       (sender (message-fetch-field "sender"))
-       (from (message-fetch-field "from")))
+  (let ((cur (current-buffer)))
     ;; Check whether the user owns the article that is to be superseded.
-    (unless (or
-            ;; Canlock-logic as suggested by Per Abrahamsen
-            ;; <abraham@dina.kvl.dk>
-            ;;
-            ;; IF article has cancel-lock THEN
-            ;;   IF we can verify it THEN
-            ;;     issue cancel
-            ;;   ELSE
-            ;;     error: cancellock: article is not yours
-            ;; ELSE
-            ;;   Use old rules, comparing sender...
-            (if (message-fetch-field "Cancel-Lock")
-                (if (null (canlock-verify))
-                    t
-                  (error "Failed to verify Cancel-lock: This article is not yours"))
-              nil)
-            (message-gnksa-enable-p 'cancel-messages)
-               (and sender
-                    (string-equal
-                     (downcase sender)
-                     (downcase (message-make-sender))))
-               (string-equal
-                (downcase (cadr (mail-extract-address-components from)))
-                (downcase (cadr (mail-extract-address-components
-                                 (message-make-from))))))
+    (unless (message-is-yours-p)
       (error "This article is not yours"))
     ;; Get a normal message buffer.
     (message-pop-to-buffer (message-buffer-name "supersede"))
@@ -6413,10 +6430,10 @@ The following arguments may contain lists of values."
         (list list))))
 
 (defun message-generate-new-buffer-clone-locals (name &optional varstr)
-  "Create and return a buffer with name based on NAME using `generate-new-buffer.'
+  "Create and return a buffer with name based on NAME using `generate-new-buffer'.
 Then clone the local variables and values from the old buffer to the
 new one, cloning only the locals having a substring matching the
-regexp varstr."
+regexp VARSTR."
   (let ((oldbuf (current-buffer)))
     (save-excursion
       (set-buffer (generate-new-buffer name))