X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=971709adc1564feb085da5e751caf5b6b203f584;hb=99ed16919eb88d1f82250c2c4ef6309f8cceb571;hp=78d196bdeb2d2855930dc28f71fe3eef16b4cb8c;hpb=3ceba700f6602a35f03913957b3e5c56418fe046;p=gnus diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 78d196bde..971709adc 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -101,6 +101,9 @@ the second with the current group name.") (defvar gnus-posting-styles nil "*Alist of styles to use when posting.") +(defvar gnus-inews-mark-gcc-as-read nil + "If non-nil, automatically mark Gcc articles as read.") + (defcustom gnus-group-posting-charset-alist '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) @@ -202,20 +205,6 @@ Thank you for your help in stamping out bugs. ;; "c" gnus-summary-send-draft "r" gnus-summary-resend-message) -;;;###autoload -(defun gnus-msg-mail (&rest args) - "Start editing a mail message to be sent. -Like `message-mail', but with Gnus paraphernalia, particularly the -the Gcc: header for archiving purposes." - (interactive) - (gnus-setup-message 'message - (apply 'message-mail args))) - -;;;###autoload -(define-mail-user-agent 'gnus-user-agent - 'gnus-msg-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook) - ;;; Internal functions. (defvar gnus-article-reply nil) @@ -246,12 +235,9 @@ the Gcc: header for archiving purposes." (set (make-local-variable 'gnus-newsgroup-name) ,group) (gnus-run-hooks 'gnus-message-setup-hook) (if (eq major-mode 'message-mode) - ;; Make mml-buffer-list local. - ;; Restore global mml-buffer-list value as mbl. - ;; What a hack! -- Shenghuo - (let ((mml-buffer-list mml-buffer-list)) - (setq mml-buffer-list mbl) - (make-local-variable 'mml-buffer-list) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) ;; Global value + (set (make-local-variable 'mml-buffer-list) mbl1);; Local value (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)) (mml-destroy-buffers) (setq mml-buffer-list mbl))) @@ -259,6 +245,20 @@ the Gcc: header for archiving purposes." (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) +;;;###autoload +(defun gnus-msg-mail (&rest args) + "Start editing a mail message to be sent. +Like `message-mail', but with Gnus paraphernalia, particularly the +the Gcc: header for archiving purposes." + (interactive) + (gnus-setup-message 'message + (apply 'message-mail args))) + +;;;###autoload +(define-mail-user-agent 'gnus-user-agent + 'gnus-msg-mail 'message-send-and-exit + 'message-kill-buffer 'message-send-hook) + (defun gnus-setup-posting-charset (group) (let ((alist gnus-group-posting-charset-alist) (group (or group "")) @@ -276,7 +276,11 @@ the Gcc: header for archiving purposes." (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) - (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) + (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc + 'gnus-inews-do-gcc) nil t) + (when gnus-agent + (make-local-hook 'message-header-hook) + (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) @@ -449,33 +453,38 @@ header line with the old Message-ID." (error "Can't find any article buffer") (save-excursion (set-buffer article-buffer) - (save-restriction - ;; Copy over the (displayed) article buffer, delete - ;; hidden text and remove text properties. - (widen) - (copy-to-buffer gnus-article-copy (point-min) (point-max)) - (set-buffer gnus-article-copy) - (gnus-article-delete-text-of-type 'annotation) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next) - (insert - (prog1 - (buffer-substring-no-properties (point-min) (point-max)) - (erase-buffer))) - ;; Find the original headers. - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (while (looking-at message-unix-mail-delimiter) - (forward-line 1)) - (setq beg (point)) - (setq end (or (search-forward "\n\n" nil t) (point))) - ;; Delete the headers from the displayed articles. - (set-buffer gnus-article-copy) - (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - ;; Insert the original article headers. - (insert-buffer-substring gnus-original-article-buffer beg end) - (article-decode-encoded-words))) + (let ((gnus-newsgroup-charset (or gnus-article-charset + gnus-newsgroup-charset)) + (gnus-newsgroup-ignored-charsets + (or gnus-article-ignored-charsets + gnus-newsgroup-ignored-charsets))) + (save-restriction + ;; Copy over the (displayed) article buffer, delete + ;; hidden text and remove text properties. + (widen) + (copy-to-buffer gnus-article-copy (point-min) (point-max)) + (set-buffer gnus-article-copy) + (gnus-article-delete-text-of-type 'annotation) + (gnus-remove-text-with-property 'gnus-prev) + (gnus-remove-text-with-property 'gnus-next) + (insert + (prog1 + (buffer-substring-no-properties (point-min) (point-max)) + (erase-buffer))) + ;; Find the original headers. + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (while (looking-at message-unix-mail-delimiter) + (forward-line 1)) + (setq beg (point)) + (setq end (or (search-forward "\n\n" nil t) (point))) + ;; Delete the headers from the displayed articles. + (set-buffer gnus-article-copy) + (delete-region (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-max))) + ;; Insert the original article headers. + (insert-buffer-substring gnus-original-article-buffer beg end) + (article-decode-encoded-words)))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject @@ -723,8 +732,7 @@ If POST, post instead of mail." text) (save-excursion (set-buffer gnus-original-article-buffer) - (mm-with-unibyte-current-buffer - (setq text (buffer-string)))) + (setq text (buffer-string))) (set-buffer (gnus-get-buffer-create (generate-new-buffer-name " *Gnus forward*"))) @@ -1038,6 +1046,21 @@ this is a reply." ;;; Gcc handling. +(defun gnus-inews-group-method (group) + (cond ((and (null (gnus-get-info group)) + (eq (car gnus-message-archive-method) + (car + (gnus-server-to-method + (gnus-group-method group))))) + ;; If the group doesn't exist, we assume + ;; it's an archive group... + gnus-message-archive-method) + ;; Use the method. + ((gnus-info-method (gnus-get-info group)) + (gnus-info-method (gnus-get-info group))) + ;; Find the method. + (t (gnus-group-method group)))) + ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) (interactive) @@ -1047,7 +1070,7 @@ this is a reply." (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) (cur (current-buffer)) - groups group method) + groups group method group-art) (when gcc (message-remove-header "gcc") (widen) @@ -1056,21 +1079,7 @@ this is a reply." ;; Copy the article over to some group(s). (while (setq group (pop groups)) (gnus-check-server - (setq method - (cond ((and (null (gnus-get-info group)) - (eq (car gnus-message-archive-method) - (car - (gnus-server-to-method - (gnus-group-method group))))) - ;; If the group doesn't exist, we assume - ;; it's an archive group... - gnus-message-archive-method) - ;; Use the method. - ((gnus-info-method (gnus-get-info group)) - (gnus-info-method (gnus-get-info group))) - ;; Find the method. - (t (gnus-group-method group))))) - (gnus-check-server method) + (setq method (gnus-inews-group-method group))) (unless (gnus-request-group group t method) (gnus-request-create-group group method)) (save-excursion @@ -1089,10 +1098,19 @@ this is a reply." (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - (unless (gnus-request-accept-article group method t t) + (unless (setq group-art + (gnus-request-accept-article group method t t)) (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) + (when gnus-inews-mark-gcc-as-read + (let ((active (gnus-active group))) + (when active + (if (< (cdr active) (cdr group-art)) + (gnus-set-active group (cons (car active) + (cdr group-art)))) + (gnus-group-make-articles-read group + (list (cdr group-art)))))) (kill-buffer (current-buffer)))))))))) (defun gnus-inews-insert-gcc ()