Importing Pterodactyl Gnus v0.99.
[elisp/gnus.git-] / lisp / message.el
index 6e45b2a..4929c84 100644 (file)
@@ -232,7 +232,7 @@ any confusion."
   :type 'regexp
   :group 'message-various)
 
-(defcustom message-elide-elipsis "\n[...]\n\n"
+(defcustom message-elide-ellipsis "\n[...]\n\n"
   "*The string which is inserted for elided text."
   :type 'string
   :group 'message-various)
@@ -295,6 +295,11 @@ The provided functions are:
  :type '(radio (function-item message-forward-subject-author-subject)
               (function-item message-forward-subject-fwd)))
 
+(defcustom message-forward-as-mime t
+  "*If non-nil, forward messages as an inline/rfc822 MIME section.  Otherwise, directly inline the old message in the forwarded message."
+  :group 'message-forwarding
+  :type 'boolean)
+
 (defcustom message-wash-forwarded-subjects nil
   "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
   :group 'message-forwarding
@@ -305,6 +310,12 @@ The provided functions are:
   :group 'message-interface
   :type 'regexp)
 
+(defcustom message-forward-ignored-headers nil
+  "*All headers that match this regexp will be deleted when forwarding a message."
+  :group 'message-forwarding
+  :type '(choice (const :tag "None" nil)
+                regexp))
+
 (defcustom message-ignored-cited-headers "."
   "*Delete these headers from the messages you yank."
   :group 'message-insertion
@@ -649,6 +660,13 @@ Valid valued are `unique' and `unsent'."
   :group 'message
   :type 'symbol)
 
+(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+  "*A regexp specifying names to prune when doing wide replies.
+A value of nil means exclude your own name only."
+  :group 'message
+  :type '(choice (const :tag "Yourself" nil)
+                regexp))
+
 ;;; Internal variables.
 ;;; Well, not really internal.
 
@@ -939,6 +957,7 @@ The cdr of ech entry is a function for applying the face to a region.")
          "^ *---+ +Original message +---+ *$\\|"
          "^ *--+ +begin message +--+ *$\\|"
          "^ *---+ +Original message follows +---+ *$\\|"
+         "^ *---+ +Undelivered message follows +---+ *$\\|"
          "^|? *---+ +Message text follows: +---+ *|?$")
   "A regexp that matches the separator before the text of a failed message.")
 
@@ -1030,7 +1049,7 @@ The cdr of ech entry is a function for applying the face to a region.")
             (file-readable-p file)
             (file-regular-p file))
     (with-temp-buffer
-      (mm-insert-file-contents file)
+      (nnheader-insert-file-contents file)
       (goto-char (point-min))
       (looking-at message-unix-mail-delimiter))))
 
@@ -1041,7 +1060,7 @@ The cdr of ech entry is a function for applying the face to a region.")
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))
-      ;; We remove all text props.delete-region
+      ;; We remove all text props.
       (format "%s" value))))
 
 (defun message-narrow-to-field ()
@@ -1071,6 +1090,7 @@ The cdr of ech entry is a function for applying the face to a region.")
        (insert (car headers) ?\n))))
     (setq headers (cdr headers))))
 
+
 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (when (and message-reply-buffer
@@ -1280,6 +1300,7 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
 
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
+  (define-key message-mode-map "\C-c\C-Y" 'message-yank-buffer)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
   (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
@@ -1367,7 +1388,8 @@ C-c C-e  message-elide-region (elide the text between point and mark).
 C-c C-v  message-delete-not-region (remove the text outside the region).
 C-c C-z  message-kill-to-signature (kill the text up to the signature).
 C-c C-r  message-caesar-buffer-body (rot13 the message body).
-C-c C-a  mml-attach-file (attach a file as MIME)."
+C-c C-a  mml-attach-file (attach a file as MIME).
+M-RET    message-newline-and-reformat (break the line and reformat)."
   (interactive)
   (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
@@ -1432,12 +1454,12 @@ C-c C-a  mml-attach-file (attach a file as MIME)."
         '(message-font-lock-keywords t)))
   (make-local-variable 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp))
+       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp))
   (unless (boundp 'adaptive-fill-first-line-regexp)
     (setq adaptive-fill-first-line-regexp nil))
   (make-local-variable 'adaptive-fill-first-line-regexp)
   (setq adaptive-fill-first-line-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|"
+       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
                adaptive-fill-first-line-regexp))
   (mm-enable-multibyte)
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
@@ -1598,17 +1620,24 @@ With the prefix argument FORCE, insert the header anyway."
 (defun message-newline-and-reformat ()
   "Insert four newlines, and then reformat if inside quoted text."
   (interactive)
-  (let ((point (point))
-       quoted)
-    (save-excursion
-      (beginning-of-line)
-      (setq quoted (looking-at (regexp-quote message-yank-prefix))))
-    (insert "\n\n\n\n")
+  (let ((prefix "[]>ยป|:}+ \t]*")
+       (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
+       quoted point)
+    (unless (bolp)
+      (save-excursion
+       (beginning-of-line)
+       (when (looking-at (concat prefix
+                                 supercite-thing))
+         (setq quoted (match-string 0))))
+      (insert "\n"))
+    (setq point (point))
+    (insert "\n\n\n")
+    (delete-region (point) (re-search-forward "[ \t]*"))
     (when quoted
-      (insert message-yank-prefix))
+      (insert quoted))
     (fill-paragraph nil)
     (goto-char point)
-    (forward-line 2)))
+    (forward-line 1)))
 
 (defun message-insert-signature (&optional force)
   "Insert a signature.  See documentation for the `message-signature' variable."
@@ -1649,13 +1678,11 @@ With the prefix argument FORCE, insert the header anyway."
 
 (defun message-elide-region (b e)
   "Elide the text between point and mark.
-An ellipsis (from `message-elide-elipsis') will be inserted where the
+An ellipsis (from `message-elide-ellipsis') will be inserted where the
 text was killed."
   (interactive "r")
   (kill-region b e)
-  (unless (bolp)
-    (insert "\n"))
-  (insert message-elide-elipsis))
+  (insert message-elide-ellipsis))
 
 (defvar message-caesar-translation-table nil)
 
@@ -1724,7 +1751,7 @@ Mail and USENET news headers are not rotated."
         (unless (equal 0 (call-process-region
                            (point-min) (point-max) program t t))
             (insert body)
-            (message "%s failed." program))))))
+            (message "%s failed" program))))))
 
 (defun message-rename-buffer (&optional enter-string)
   "Rename the *message* buffer to \"*message* RECIPIENT\".
@@ -1829,6 +1856,24 @@ prefix, and don't delete any headers."
       (unless modified
        (setq message-checksum (message-checksum))))))
 
+(defun message-yank-buffer (buffer)
+  "Insert BUFFER into the current buffer and quote it."
+  (interactive "bYank buffer: ")
+  (let ((message-reply-buffer buffer))
+    (save-window-excursion
+      (message-yank-original))))
+
+(defun message-buffers ()
+  "Return a list of active message buffers."
+  (let (buffers)
+    (save-excursion
+      (dolist (buffer (buffer-list t))
+       (set-buffer buffer)
+       (when (and (eq major-mode 'message-mode)
+                  (null message-sent-message-via))
+         (push (buffer-name buffer) buffers))))
+    (nreverse buffers)))
+
 (defun message-cite-original-without-signature ()
   "Cite function in the standard Message manner."
   (let ((start (point))
@@ -2001,21 +2046,19 @@ the user from the mailer."
        elem sent)
     (while (and success
                (setq elem (pop alist)))
-      (when (and (or (not (funcall (cadr elem)))
-                    (and (or (not (memq (car elem)
-                                        message-sent-message-via))
-                             (y-or-n-p
-                              (format
-                               "Already sent message via %s; resend? "
-                               (car elem))))
-                         (setq success (funcall (caddr elem) arg)))))
+      (when (or (not (funcall (cadr elem)))
+               (and (or (not (memq (car elem)
+                                   message-sent-message-via))
+                        (y-or-n-p
+                         (format
+                          "Already sent message via %s; resend? "
+                          (car elem))))
+                    (setq success (funcall (caddr elem) arg))))
        (setq sent t)))
-    (unless sent
+    (unless (or sent (not success))
       (error "No methods specified to send by"))
     (when (and success sent)
       (message-do-fcc)
-      ;;(when (fboundp 'mail-hist-put-headers-into-history)
-      ;; (mail-hist-put-headers-into-history))
       (save-excursion
        (run-hooks 'message-sent-hook))
       (message "Sending...done")
@@ -3455,8 +3498,9 @@ OTHER-HEADERS is an alist of header/value pairs."
              (while (re-search-forward "[ \t]+" nil t)
                (replace-match " " t t))
              ;; Remove addresses that match `rmail-dont-reply-to-names'.
-             (insert (prog1 (rmail-dont-reply-to (buffer-string))
-                       (erase-buffer)))
+             (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+               (insert (prog1 (rmail-dont-reply-to (buffer-string))
+                         (erase-buffer))))
              (goto-char (point-min))
              ;; Perhaps Mail-Copies-To: never removed the only address?
              (when (eobp)
@@ -3801,15 +3845,29 @@ Optional NEWS will use news to forward instead of mail."
     ;; Put point where we want it before inserting the forwarded
     ;; message.
     (message-goto-body)
-    (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
-    (mml-insert-buffer cur)
-    (insert "<#/part>\n")
+    (if message-forward-as-mime
+        (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
+      (insert "\n\n"))
+    (let ((b (point))
+         e)
+      (mml-insert-buffer cur)
+      (setq e (point))
+      (and message-forward-as-mime
+          (insert "<#/part>\n"))
+      (when (and (not current-prefix-arg)
+                message-forward-ignored-headers)
+       (save-restriction
+         (narrow-to-region b e)
+         (goto-char b)
+         (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point)))
+         (message-remove-header message-forward-ignored-headers t))))
     (message-position-point)))
 
 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."
-  (interactive "sResend message to: ")
+  (interactive
+   (list (message-read-from-minibuffer "Resend message to: ")))
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))
@@ -3861,7 +3919,7 @@ This only makes sense if the current message is a bounce message than
 contains some mail you have written which has been bounced back to
 you."
   (interactive)
-  (let ((handles (mm-dissect-buffer))
+  (let ((handles (mm-dissect-buffer t))
        boundary)
     (message-pop-to-buffer (message-buffer-name "bounce"))
     (if (stringp (car handles))
@@ -3869,7 +3927,7 @@ you."
        (mm-insert-part (car (last handles)))
       ;; This is a non-MIME bounce, so we try to remove things
       ;; manually.
-      (mm-insert-part (car (last handles)))
+      (mm-insert-part handles)
       (undo-boundary)
       (goto-char (point-min))
       (search-forward "\n\n" nil t)
@@ -4164,6 +4222,15 @@ regexp varstr."
        (forward-line 1)
        (insert "Content-Type: text/plain; charset=us-ascii\n")))))
 
+(defun message-read-from-minibuffer (prompt)
+  "Read from the minibuffer while providing abbrev expansion."
+  (if (fboundp 'mail-abbrevs-setup)
+      (let ((mail-abbrev-mode-regexp "")
+           (minibuffer-setup-hook 'mail-abbrevs-setup))
+       (read-from-minibuffer prompt)))
+  (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+    (read-string prompt)))
+
 (provide 'message)
 
 (run-hooks 'message-load-hook)