Mercurial > emacs
comparison lisp/gnus/message.el @ 34797:b473bc6d9a55
* mml.el (gnus-add-minor-mode): Autoload.
* message.el (message-forward): Save-restriction.
* message.el (message-mail-user-agent): Add :version.
* message.el (message-mail-user-agent): New variable.
(message-setup): Renamed to message-setup-1. Support
mail-user-agent.
(message-mail-user-agent): New function.
(message-mail): Use it.
(message-reply): Use it.
(message-resend): Use it.
(message-mail-other-window): Use it.
(message-mail-other-frame): Use it.
* gnus-msg.el (gnus-bug): Support mail-user-agent.
author | ShengHuo ZHU <zsh@cs.rochester.edu> |
---|---|
date | Thu, 21 Dec 2000 19:58:34 +0000 |
parents | 053098519a45 |
children | 6c93e7d6a930 |
comparison
equal
deleted
inserted
replaced
34796:560b081d8800 | 34797:b473bc6d9a55 |
---|---|
301 :group 'message-forwarding | 301 :group 'message-forwarding |
302 :type 'boolean) | 302 :type 'boolean) |
303 | 303 |
304 (defcustom message-forward-show-mml t | 304 (defcustom message-forward-show-mml t |
305 "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." | 305 "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." |
306 :version "21.1" | |
306 :group 'message-forwarding | 307 :group 'message-forwarding |
307 :type 'boolean) | 308 :type 'boolean) |
308 | 309 |
309 (defcustom message-forward-before-signature t | 310 (defcustom message-forward-before-signature t |
310 "*If non-nil, put forwarded message before signature, else after." | 311 "*If non-nil, put forwarded message before signature, else after." |
914 "A regexp to match the alternative email addresses. | 915 "A regexp to match the alternative email addresses. |
915 The first matched address (not primary one) is used in the From field." | 916 The first matched address (not primary one) is used in the From field." |
916 :group 'message-headers | 917 :group 'message-headers |
917 :type '(choice (const :tag "Always use primary" nil) | 918 :type '(choice (const :tag "Always use primary" nil) |
918 regexp)) | 919 regexp)) |
920 | |
921 (defcustom message-mail-user-agent nil | |
922 "Like `mail-user-agent'. | |
923 Except if it is `nil', use Gnus native MUA; if it is t, use | |
924 `mail-user-agent'." | |
925 :type '(radio (const :tag "Gnus native" | |
926 :format "%t\n" | |
927 nil) | |
928 (const :tag "`mail-user-agent'" | |
929 :format "%t\n" | |
930 t) | |
931 (function-item :tag "Default Emacs mail" | |
932 :format "%t\n" | |
933 sendmail-user-agent) | |
934 (function-item :tag "Emacs interface to MH" | |
935 :format "%t\n" | |
936 mh-e-user-agent) | |
937 (function :tag "Other")) | |
938 :version "21.1" | |
939 :group 'message) | |
919 | 940 |
920 ;;; Internal variables. | 941 ;;; Internal variables. |
921 | 942 |
922 (defvar message-sending-message "Sending...") | 943 (defvar message-sending-message "Sending...") |
923 (defvar message-buffer-list nil) | 944 (defvar message-buffer-list nil) |
2984 (if (or | 3005 (if (or |
2985 (and message-reply-headers | 3006 (and message-reply-headers |
2986 (mail-header-references message-reply-headers) | 3007 (mail-header-references message-reply-headers) |
2987 (mail-header-subject message-reply-headers) | 3008 (mail-header-subject message-reply-headers) |
2988 psubject | 3009 psubject |
2989 (mail-header-subject message-reply-headers) | |
2990 (not (string= | 3010 (not (string= |
2991 (message-strip-subject-re | 3011 (message-strip-subject-re |
2992 (mail-header-subject message-reply-headers)) | 3012 (mail-header-subject message-reply-headers)) |
2993 (message-strip-subject-re psubject)))) | 3013 (message-strip-subject-re psubject)))) |
2994 (and psupersedes | 3014 (and psupersedes |
3558 ;; Push the current buffer onto the list. | 3578 ;; Push the current buffer onto the list. |
3559 (when message-max-buffers | 3579 (when message-max-buffers |
3560 (setq message-buffer-list | 3580 (setq message-buffer-list |
3561 (nconc message-buffer-list (list (current-buffer)))))) | 3581 (nconc message-buffer-list (list (current-buffer)))))) |
3562 | 3582 |
3583 (defun message-mail-user-agent () | |
3584 (let ((mua (cond | |
3585 ((not message-mail-user-agent) nil) | |
3586 ((eq message-mail-user-agent t) mail-user-agent) | |
3587 (t message-mail-user-agent)))) | |
3588 (if (memq mua '(message-user-agent gnus-user-agent)) | |
3589 nil | |
3590 mua))) | |
3591 | |
3592 (defun message-setup (headers &optional replybuffer actions switch-function) | |
3593 (let ((mua (message-mail-user-agent)) | |
3594 subject to field yank-action) | |
3595 (if (not (and message-this-is-mail mua)) | |
3596 (message-setup-1 headers replybuffer actions) | |
3597 (if replybuffer | |
3598 (setq yank-action (list 'insert-buffer replybuffer))) | |
3599 (setq headers (copy-sequence headers)) | |
3600 (setq field (assq 'Subject headers)) | |
3601 (when field | |
3602 (setq subject (cdr field)) | |
3603 (setq headers (delq field headers))) | |
3604 (setq field (assq 'To headers)) | |
3605 (when field | |
3606 (setq to (cdr field)) | |
3607 (setq headers (delq field headers))) | |
3608 (let ((mail-user-agent mua)) | |
3609 (compose-mail to subject | |
3610 (mapcar (lambda (item) | |
3611 (cons | |
3612 (format "%s" (car item)) | |
3613 (cdr item))) | |
3614 headers) | |
3615 nil switch-function yank-action actions))))) | |
3616 | |
3563 (eval-when-compile (defvar mc-modes-alist)) | 3617 (eval-when-compile (defvar mc-modes-alist)) |
3564 (defun message-setup (headers &optional replybuffer actions) | 3618 (defun message-setup-1 (headers &optional replybuffer actions) |
3565 (when (and (boundp 'mc-modes-alist) | 3619 (when (and (boundp 'mc-modes-alist) |
3566 (not (assq 'message-mode mc-modes-alist))) | 3620 (not (assq 'message-mode mc-modes-alist))) |
3567 (push '(message-mode (encrypt . mc-encrypt-message) | 3621 (push '(message-mode (encrypt . mc-encrypt-message) |
3568 (sign . mc-sign-message)) | 3622 (sign . mc-sign-message)) |
3569 mc-modes-alist)) | 3623 mc-modes-alist)) |
3673 yank-action send-actions) | 3727 yank-action send-actions) |
3674 "Start editing a mail message to be sent. | 3728 "Start editing a mail message to be sent. |
3675 OTHER-HEADERS is an alist of header/value pairs." | 3729 OTHER-HEADERS is an alist of header/value pairs." |
3676 (interactive) | 3730 (interactive) |
3677 (let ((message-this-is-mail t)) | 3731 (let ((message-this-is-mail t)) |
3678 (message-pop-to-buffer (message-buffer-name "mail" to)) | 3732 (unless (message-mail-user-agent) |
3733 (message-pop-to-buffer (message-buffer-name "mail" to))) | |
3679 (message-setup | 3734 (message-setup |
3680 (nconc | 3735 (nconc |
3681 `((To . ,(or to "")) (Subject . ,(or subject ""))) | 3736 `((To . ,(or to "")) (Subject . ,(or subject ""))) |
3682 (when other-headers other-headers))))) | 3737 (when other-headers other-headers))))) |
3683 | 3738 |
3789 (setq message-id (match-string 0 gnus-warning))) | 3844 (setq message-id (match-string 0 gnus-warning))) |
3790 | 3845 |
3791 (unless follow-to | 3846 (unless follow-to |
3792 (setq follow-to (message-get-reply-headers wide to-address)))) | 3847 (setq follow-to (message-get-reply-headers wide to-address)))) |
3793 | 3848 |
3794 (message-pop-to-buffer | 3849 (unless (message-mail-user-agent) |
3795 (message-buffer-name | 3850 (message-pop-to-buffer |
3796 (if wide "wide reply" "reply") from | 3851 (message-buffer-name |
3797 (if wide to-address nil))) | 3852 (if wide "wide reply" "reply") from |
3853 (if wide to-address nil)))) | |
3798 | 3854 |
3799 (setq message-reply-headers | 3855 (setq message-reply-headers |
3800 (vector 0 subject from date message-id references 0 0 "")) | 3856 (vector 0 subject from date message-id references 0 0 "")) |
3801 | 3857 |
3802 (message-setup | 3858 (message-setup |
4144 (mm-disable-multibyte) ;; Must copy buffer in unibyte mode | 4200 (mm-disable-multibyte) ;; Must copy buffer in unibyte mode |
4145 (setq tmp (current-buffer)) | 4201 (setq tmp (current-buffer)) |
4146 (set-buffer cur) | 4202 (set-buffer cur) |
4147 (mm-with-unibyte-current-buffer | 4203 (mm-with-unibyte-current-buffer |
4148 (set-buffer tmp) | 4204 (set-buffer tmp) |
4149 (insert-buffer-substring cur)) | 4205 (insert-buffer-substring cur) |
4206 (set-buffer cur)) | |
4150 (set-buffer tmp) | 4207 (set-buffer tmp) |
4151 (mm-enable-multibyte) | 4208 (mm-enable-multibyte) |
4152 (mime-to-mml) | 4209 (mime-to-mml) |
4153 (goto-char (point-min)) | 4210 (goto-char (point-min)) |
4154 (when (looking-at "From ") | 4211 (when (looking-at "From ") |
4155 (replace-match "X-From-Line: ")) | 4212 (replace-match "X-From-Line: ")) |
4156 (set-buffer target) | 4213 (set-buffer target) |
4157 (insert-buffer-substring tmp) | 4214 (insert-buffer-substring tmp) |
4158 (set-buffer tmp)) | 4215 (set-buffer tmp))) |
4159 (goto-char (point-max))) | 4216 (save-restriction |
4160 (mml-insert-buffer cur) | 4217 (narrow-to-region (point) (point)) |
4161 (goto-char (point-min)) | 4218 (mml-insert-buffer cur) |
4162 (when (looking-at "From ") | 4219 (goto-char (point-min)) |
4163 (replace-match "X-From-Line: ")) | 4220 (when (looking-at "From ") |
4164 (goto-char (point-max)))) | 4221 (replace-match "X-From-Line: ")) |
4222 (goto-char (point-max))))) | |
4165 (setq e (point)) | 4223 (setq e (point)) |
4166 (if message-forward-as-mime | 4224 (if message-forward-as-mime |
4167 (if digest | 4225 (if digest |
4168 (insert "<#/multipart>\n") | 4226 (insert "<#/multipart>\n") |
4169 (if message-forward-show-mml | 4227 (if message-forward-show-mml |
4195 (message "Resending message to %s..." address) | 4253 (message "Resending message to %s..." address) |
4196 (save-excursion | 4254 (save-excursion |
4197 (let ((cur (current-buffer)) | 4255 (let ((cur (current-buffer)) |
4198 beg) | 4256 beg) |
4199 ;; We first set up a normal mail buffer. | 4257 ;; We first set up a normal mail buffer. |
4200 (set-buffer (get-buffer-create " *message resend*")) | 4258 (unless (message-mail-user-agent) |
4201 (erase-buffer) | 4259 (set-buffer (get-buffer-create " *message resend*")) |
4202 (message-setup `((To . ,address))) | 4260 (erase-buffer)) |
4261 (let ((message-this-is-mail t)) | |
4262 (message-setup `((To . ,address)))) | |
4203 ;; Insert our usual headers. | 4263 ;; Insert our usual headers. |
4204 (message-generate-headers '(From Date To)) | 4264 (message-generate-headers '(From Date To)) |
4205 (message-narrow-to-headers) | 4265 (message-narrow-to-headers) |
4206 ;; Rename them all to "Resent-*". | 4266 ;; Rename them all to "Resent-*". |
4207 (while (re-search-forward "^[A-Za-z]" nil t) | 4267 (while (re-search-forward "^[A-Za-z]" nil t) |
4279 | 4339 |
4280 ;;;###autoload | 4340 ;;;###autoload |
4281 (defun message-mail-other-window (&optional to subject) | 4341 (defun message-mail-other-window (&optional to subject) |
4282 "Like `message-mail' command, but display mail buffer in another window." | 4342 "Like `message-mail' command, but display mail buffer in another window." |
4283 (interactive) | 4343 (interactive) |
4284 (let ((pop-up-windows t) | 4344 (unless (message-mail-user-agent) |
4285 (special-display-buffer-names nil) | 4345 (let ((pop-up-windows t) |
4286 (special-display-regexps nil) | 4346 (special-display-buffer-names nil) |
4287 (same-window-buffer-names nil) | 4347 (special-display-regexps nil) |
4288 (same-window-regexps nil)) | 4348 (same-window-buffer-names nil) |
4289 (message-pop-to-buffer (message-buffer-name "mail" to))) | 4349 (same-window-regexps nil)) |
4350 (message-pop-to-buffer (message-buffer-name "mail" to)))) | |
4290 (let ((message-this-is-mail t)) | 4351 (let ((message-this-is-mail t)) |
4291 (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))) | 4352 (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) |
4353 nil nil 'switch-to-buffer-other-window))) | |
4292 | 4354 |
4293 ;;;###autoload | 4355 ;;;###autoload |
4294 (defun message-mail-other-frame (&optional to subject) | 4356 (defun message-mail-other-frame (&optional to subject) |
4295 "Like `message-mail' command, but display mail buffer in another frame." | 4357 "Like `message-mail' command, but display mail buffer in another frame." |
4296 (interactive) | 4358 (interactive) |
4297 (let ((pop-up-frames t) | 4359 (unless (message-mail-user-agent) |
4298 (special-display-buffer-names nil) | 4360 (let ((pop-up-frames t) |
4299 (special-display-regexps nil) | 4361 (special-display-buffer-names nil) |
4300 (same-window-buffer-names nil) | 4362 (special-display-regexps nil) |
4301 (same-window-regexps nil)) | 4363 (same-window-buffer-names nil) |
4302 (message-pop-to-buffer (message-buffer-name "mail" to))) | 4364 (same-window-regexps nil)) |
4365 (message-pop-to-buffer (message-buffer-name "mail" to)))) | |
4303 (let ((message-this-is-mail t)) | 4366 (let ((message-this-is-mail t)) |
4304 (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))) | 4367 (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) |
4368 nil nil 'switch-to-buffer-other-frame))) | |
4305 | 4369 |
4306 ;;;###autoload | 4370 ;;;###autoload |
4307 (defun message-news-other-window (&optional newsgroups subject) | 4371 (defun message-news-other-window (&optional newsgroups subject) |
4308 "Start editing a news article to be sent." | 4372 "Start editing a news article to be sent." |
4309 (interactive) | 4373 (interactive) |