* message.el (message-indent-citation): Revert last change which made `F' not work.
[gnus] / lisp / message.el
index 198c5d8..0183b87 100644 (file)
@@ -686,6 +686,7 @@ Done before generating the new subject of a forward."
 (defcustom message-send-mail-function
   (cond ((eq send-mail-function 'smtpmail-send-it) 'message-smtpmail-send-it)
        ((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it)
+       ((eq send-mail-function 'sendmail-query-once) 'sendmail-query-once)
        ((eq send-mail-function 'mailclient-send-it)
         'message-send-mail-with-mailclient)
        (t (message-send-mail-function)))
@@ -1135,7 +1136,7 @@ Note: Many newsgroups frown upon nontraditional reply styles. You
 probably want to set this variable only for specific groups,
 e.g. using `gnus-posting-styles':
 
-  (eval (set (make-local-variable 'message-cite-reply-above) 'above))"
+  (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
   :type '(choice (const :tag "Reply inline" 'traditional)
                 (const :tag "Reply above" 'above)
                 (const :tag "Reply below" 'below))
@@ -1228,7 +1229,7 @@ It is a vector of the following headers:
 (defvar message-send-actions nil
   "A list of actions to be performed upon successful sending of a message.")
 (defvar message-return-action nil
-  "Action to return to the caller after sending or postphoning a message.")
+  "Action to return to the caller after sending or postponing a message.")
 (defvar message-exit-actions nil
   "A list of actions to be performed upon exiting after sending a message.")
 (defvar message-kill-actions nil
@@ -1353,7 +1354,9 @@ text and it replaces `self-insert-command' with the other command, e.g.
   :type '(repeat function))
 
 (defcustom message-auto-save-directory
-  (file-name-as-directory (expand-file-name "drafts" message-directory))
+  (if (file-writable-p message-directory)
+      (file-name-as-directory (expand-file-name "drafts" message-directory))
+    "~/")
   "*Directory where Message auto-saves buffers if Gnus isn't running.
 If nil, Message won't auto-save."
   :group 'message-buffers
@@ -1394,7 +1397,8 @@ candidates:
 `quoted-text-only'  Allow you to post quoted text only;
 `multiple-copies'   Allow you to post multiple copies;
 `cancel-messages'   Allow you to cancel or supersede messages from
-                   your other email addresses.")
+                   your other email addresses;
+`canlock-verify'    Allow you to cancel messages without verifying canlock.")
 
 (defsubst message-gnksa-enable-p (feature)
   (or (not (listp message-shoot-gnksa-feet))
@@ -1926,7 +1930,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (defvar message-send-mail-real-function nil
   "Internal send mail function.")
 
-(defvar message-bogus-system-names "^localhost\\.\\|\\.local$"
+(defvar message-bogus-system-names "\\`localhost\\.\\|\\.local\\'"
   "The regexp of bogus system names.")
 
 (defcustom message-valid-fqdn-regexp
@@ -3468,8 +3472,12 @@ Message buffers and is not meant to be called directly."
 (defun message-point-in-header-p ()
   "Return t if point is in the header."
   (save-excursion
-    (not (re-search-backward
-         (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
+    (and
+     (not
+      (re-search-backward
+       (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
+     (re-search-forward
+      (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
 
 (defun message-do-auto-fill ()
   "Like `do-auto-fill', but don't fill in message header."
@@ -3756,22 +3764,9 @@ To use this automatically, you may add this function to
       (while (re-search-forward citexp nil t)
        (replace-match (if remove "" "\n"))))))
 
-(defun message-yank-original (&optional arg)
-  "Insert the message being replied to, if any.
-Puts point before the text and mark after.
-Normally indents each nonblank line ARG spaces (default 3).  However,
-if `message-yank-prefix' is non-nil, insert that prefix on each line.
-
-This function uses `message-cite-function' to do the actual citing.
-
-Just \\[universal-argument] as argument means don't indent, insert no
-prefix, and don't delete any headers."
-  (interactive "P")
+(defun message--yank-original-internal (arg)
   (let ((modified (buffer-modified-p))
        body-text)
-    ;; eval the let forms contained in message-cite-style
-    (eval
-     `(let ,message-cite-style
        (when (and message-reply-buffer
                   message-cite-function)
          (when (equal message-cite-reply-position 'above)
@@ -3800,18 +3795,34 @@ prefix, and don't delete any headers."
                (goto-char (mark t))
                (insert-before-markers ?\n)
                (goto-char pt))))
-         (cond
-           ((eq 'above message-cite-reply-position)
+         (case message-cite-reply-position
+           (above
             (message-goto-body)
             (insert body-text)
             (insert (if (bolp) "\n" "\n\n"))
             (message-goto-body))
-           ((eq 'below message-cite-reply-position)
+           (below
             (message-goto-signature)))
          ;; Add a `message-setup-very-last-hook' here?
          ;; Add `gnus-article-highlight-citation' here?
          (unless modified
-           (setq message-checksum (message-checksum))))))))
+        (setq message-checksum (message-checksum))))))
+
+(defun message-yank-original (&optional arg)
+  "Insert the message being replied to, if any.
+Puts point before the text and mark after.
+Normally indents each nonblank line ARG spaces (default 3).  However,
+if `message-yank-prefix' is non-nil, insert that prefix on each line.
+
+This function uses `message-cite-function' to do the actual citing.
+
+Just \\[universal-argument] as argument means don't indent, insert no
+prefix, and don't delete any headers."
+  (interactive "P")
+  ;; eval the let forms contained in message-cite-style
+  (eval
+   `(let ,message-cite-style
+      (message--yank-original-internal ',arg))))
 
 (defun message-yank-buffer (buffer)
   "Insert BUFFER into the current buffer and quote it."
@@ -4287,8 +4298,10 @@ conformance."
                 "Invisible text found and made visible; continue sending? ")
          (error "Invisible text found and made visible")))))
   (message-check 'illegible-text
-    (let (char found choice)
+    (let (char found choice nul-chars)
       (message-goto-body)
+      (setq nul-chars (save-excursion
+                       (search-forward "\000" nil t)))
       (while (progn
               (skip-chars-forward mm-7bit-chars)
               (when (get-text-property (point) 'no-illegible-text)
@@ -4314,7 +4327,9 @@ conformance."
       (when found
        (setq choice
              (gnus-multiple-choice
-              "Non-printable characters found.  Continue sending?"
+              (if nul-chars
+                  "NUL characters found, which may cause problems.  Continue sending?"
+                "Non-printable characters found.  Continue sending?")
               `((?d "Remove non-printable characters and send")
                 (?r ,(format
                       "Replace non-printable characters with \"%s\" and send"
@@ -4662,6 +4677,8 @@ If you always want Gnus to send messages in one piece, set
     (set-buffer mailbuf)
     (push 'mail message-sent-message-via)))
 
+(defvar sendmail-program)
+
 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
   (require 'sendmail)
@@ -4697,16 +4714,7 @@ If you always want Gnus to send messages in one piece, set
                 (cpr (apply
                       'call-process-region
                       (append
-                       (list (point-min) (point-max)
-                             (cond ((boundp 'sendmail-program)
-                                    sendmail-program)
-                                   ((file-exists-p "/usr/sbin/sendmail")
-                                    "/usr/sbin/sendmail")
-                                   ((file-exists-p "/usr/lib/sendmail")
-                                    "/usr/lib/sendmail")
-                                   ((file-exists-p "/usr/ucblib/sendmail")
-                                    "/usr/ucblib/sendmail")
-                                   (t "fakemail"))
+                       (list (point-min) (point-max) sendmail-program
                              nil errbuf nil "-oi")
                        message-sendmail-extra-arguments
                        ;; Always specify who from,
@@ -4826,7 +4834,9 @@ Do not use this for anything important, it is cryptographically weak."
   (require 'sha1)
   (let (sha1-maximum-internal-length)
     (sha1 (concat (message-unique-id)
-                 (format "%x%x%x" (random) (random t) (random))
+                 (format "%x%x%x" (random)
+                         (progn (random t) (random))
+                         (random))
                  (prin1-to-string (recent-keys))
                  (prin1-to-string (garbage-collect))))))
 
@@ -5529,10 +5539,12 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
 ;; You might for example insert a "." somewhere (not next to another dot
 ;; or string boundary), or modify the "fsf" string.
 (defun message-unique-id ()
+  (random t)
   ;; Don't use microseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq message-unique-id-char
-       (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+       (% (1+ (or message-unique-id-char
+                  (logand (random most-positive-fixnum) (1- (lsh 1 20)))))
           ;; (current-time) returns 16-bit ints,
           ;; and 2^16*25 just fits into 4 digits i base 36.
           (* 25 25)))
@@ -6361,7 +6373,7 @@ between beginning of field and beginning of line."
              (progn
                (gnus-select-frame-set-input-focus (window-frame window))
                (select-window window))
-           (funcall (or switch-function 'pop-to-buffer) buffer)
+           (funcall (or switch-function 'switch-to-buffer) buffer)
            (set-buffer buffer))
          (when (and (buffer-modified-p)
                     (not (prog1
@@ -6369,7 +6381,7 @@ between beginning of field and beginning of line."
                               "Message already being composed; erase? ")
                            (message nil))))
            (error "Message being composed")))
-      (funcall (or switch-function 'pop-to-buffer) name)
+      (funcall (or switch-function 'switch-to-buffer) name)
       (set-buffer name))
     (erase-buffer)
     (message-mode)))
@@ -6562,7 +6574,9 @@ are not included."
   (message-position-point)
   ;; Allow correct handling of `message-checksum' in `message-yank-original':
   (set-buffer-modified-p nil)
-  (undo-boundary))
+  (undo-boundary)
+  ;; rmail-start-mail expects message-mail to return t (Bug#9392)
+  t)
 
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."
@@ -6792,10 +6806,13 @@ want to get rid of this query permanently.")))
                                  addr))
                 (cons (downcase (mail-strip-quoted-names addr)) addr)))
             (message-tokenize-header recipients)))
-      ;; Remove first duplicates.  (Why not all duplicates?  Is this a bug?)
+      ;; Remove all duplicates.
       (let ((s recipients))
        (while s
-         (setq recipients (delq (assoc (car (pop s)) s) recipients))))
+         (let ((address (car (pop s))))
+           (while (assoc address s)
+             (setq recipients (delq (assoc address s) recipients)
+                   s (delq (assoc address s) s))))))
 
       ;; Remove hierarchical lists that are contained within each other,
       ;; if message-hierarchical-addresses is defined.
@@ -6918,20 +6935,19 @@ Useful functions to put in this list include:
       (unless follow-to
        (setq follow-to (message-get-reply-headers wide to-address))))
 
-    (unless (message-mail-user-agent)
-      (message-pop-to-buffer
-       (message-buffer-name
-       (if wide "wide reply" "reply") from
-       (if wide to-address nil))
-       switch-function))
-
-    (setq message-reply-headers
-         (vector 0 subject from date message-id references 0 0 ""))
-
-    (message-setup
-     `((Subject . ,subject)
-       ,@follow-to)
-     cur)))
+    (let ((headers
+          `((Subject . ,subject)
+            ,@follow-to)))
+      (unless (message-mail-user-agent)
+       (message-pop-to-buffer
+        (message-buffer-name
+         (if wide "wide reply" "reply") from
+         (if wide to-address nil))
+        switch-function))
+      (setq message-reply-headers
+           (vector 0 (cdr (assq 'Subject headers))
+                   from date message-id references 0 0 ""))
+      (message-setup headers cur))))
 
 ;;;###autoload
 (defun message-wide-reply (&optional to-address)
@@ -7072,7 +7088,8 @@ regexp to match all of yours addresses."
   (save-excursion
     (save-restriction
       (message-narrow-to-head-1)
-      (if (message-fetch-field "Cancel-Lock")
+      (if (and (message-fetch-field "Cancel-Lock")
+              (message-gnksa-enable-p 'canlock-verify))
          (if (null (canlock-verify))
              t
            (error "Failed to verify Cancel-lock: This article is not yours"))
@@ -7646,12 +7663,8 @@ you."
   "Like `message-mail' command, but display mail buffer in another window."
   (interactive)
   (unless (message-mail-user-agent)
-    (let ((pop-up-windows t)
-         (special-display-buffer-names nil)
-         (special-display-regexps nil)
-         (same-window-buffer-names nil)
-         (same-window-regexps nil))
-      (message-pop-to-buffer (message-buffer-name "mail" to))))
+    (message-pop-to-buffer (message-buffer-name "mail" to)
+                          'switch-to-buffer-other-window))
   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
                   nil nil nil 'switch-to-buffer-other-window)))
@@ -7661,12 +7674,8 @@ you."
   "Like `message-mail' command, but display mail buffer in another frame."
   (interactive)
   (unless (message-mail-user-agent)
-    (let ((pop-up-frames t)
-         (special-display-buffer-names nil)
-         (special-display-regexps nil)
-         (same-window-buffer-names nil)
-         (same-window-regexps nil))
-      (message-pop-to-buffer (message-buffer-name "mail" to))))
+    (message-pop-to-buffer (message-buffer-name "mail" to)
+                          'switch-to-buffer-other-frame))
   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
                   nil nil nil 'switch-to-buffer-other-frame)))
@@ -7675,12 +7684,8 @@ you."
 (defun message-news-other-window (&optional newsgroups subject)
   "Start editing a news article to be sent."
   (interactive)
-  (let ((pop-up-windows t)
-       (special-display-buffer-names nil)
-       (special-display-regexps nil)
-       (same-window-buffer-names nil)
-       (same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
+  (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)
+                        'switch-to-buffer-other-window)
   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))
@@ -7689,12 +7694,8 @@ you."
 (defun message-news-other-frame (&optional newsgroups subject)
   "Start editing a news article to be sent."
   (interactive)
-  (let ((pop-up-frames t)
-       (special-display-buffer-names nil)
-       (special-display-regexps nil)
-       (same-window-buffer-names nil)
-       (same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
+  (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)
+                        'switch-to-buffer-other-frame)
   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))
@@ -8111,10 +8112,10 @@ regexp VARSTR."
 (defun message-read-from-minibuffer (prompt &optional initial-contents)
   "Read from the minibuffer while providing abbrev expansion."
   (if (fboundp 'mail-abbrevs-setup)
-      (let ((mail-abbrev-mode-regexp "")
-           (minibuffer-setup-hook 'mail-abbrevs-setup)
+      (let ((minibuffer-setup-hook 'mail-abbrevs-setup)
            (minibuffer-local-map message-minibuffer-local-map))
-       (read-from-minibuffer prompt initial-contents))
+       (flet ((mail-abbrev-in-expansion-header-p nil t))
+         (read-from-minibuffer prompt initial-contents)))
     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
          (minibuffer-local-map message-minibuffer-local-map))
       (read-string prompt initial-contents))))