X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=4929c84e77ee819e4bea218b1db59666a6a5424e;hb=73edf76920c3d86afa1628ca8f1509394cb7b26c;hp=822a349494cd1cfdaf3f5bb9c17e41df78690173;hpb=c8b25eebe2bfccd8b707d8c9e8ffa0d88d4a20af;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index 822a349..4929c84 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -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,7 +310,6 @@ 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 @@ -953,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.") @@ -1055,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 () @@ -1295,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) @@ -1382,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) @@ -1613,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." @@ -1664,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) @@ -1739,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\". @@ -1844,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)) @@ -3815,23 +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") + (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)) - (insert "<#/part>\n") - (when message-forward-ignored-headers + (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) - (message-narrow-to-head) + (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)) @@ -4186,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)