;;; gnus-msg.el --- mail and post interface for Semi-gnus
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(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))
+ '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+ ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
(message-this-is-mail nil nil)
(message-this-is-news nil t))
"Alist of regexps and permitted unencoded charsets for posting.
content-transfer encoding in the body, or one of the special values
nil (always encode using quoted-printable) or t (always use 8bit).
-Note that any value other tha nil for HEADER infringes some RFCs, so
+Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
:type '(repeat (list :tag "Permitted unencoded charsets"
(choice :tag "Where"
"\M-c" gnus-summary-mail-crosspost-complaint
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
- "Om" gnus-summary-mail-digest
- "Op" gnus-summary-post-digest)
+ "Om" gnus-uu-digest-mail-forward
+ "Op" gnus-uu-digest-post-forward)
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
(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
+Gcc: header for archiving purposes."
+ (interactive)
+ (gnus-setup-message 'message
+ (apply 'message-mail args))
+ ;; COMPOSEFUNC should return t if succeed. Undocumented ???
+ t)
+
+;;;###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 ""))
(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)))
(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)
- (let ((inhibit-read-only t))
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (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)
+ (let ((inhibit-read-only t))
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ ;; Encode bitmap smileys to ordinary text.
+ ;; Possibly, the original text might be restored.
+ (static-unless (featurep 'xemacs)
+ (when (featurep 'smiley-mule)
+ (smiley-encode-buffer)))
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
+ (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)
- (gnus-article-delete-text-of-type 'annotation)
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)
- (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
- (insert
- (prog1
- (format "%s" (buffer-string))
- (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)))
- ;; Encode bitmap smileys to ordinary text.
- (static-unless (featurep 'xemacs)
- (when (featurep 'smiley-mule)
- (smiley-encode-buffer)))
- ;; Insert the original article headers.
- (insert-buffer-substring gnus-original-article-buffer beg end)
- (article-decode-encoded-words)))
+ (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
(article-buffer 'reply)
(t 'message))
(let* ((group (or group gnus-newsgroup-name))
+ (charset (gnus-group-name-charset nil group))
(pgroup group)
to-address to-group mailing-list to-list
newsgroup-p)
newsgroup-p (gnus-group-find-parameter group 'newsgroup)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
- group (gnus-group-real-name group)))
+ group (gnus-group-name-decode (gnus-group-real-name group)
+ charset)))
(if (or (and to-group
(gnus-news-group-p to-group))
newsgroup-p
(if full-headers "" message-included-forward-headers)))
(message-forward post))))
-;;; XXX: generate Subject and ``Topics''?
-(defun gnus-summary-mail-digest (&optional n post)
- "Digests and forwards all articles in this series."
- (interactive "P")
- (let ((subject "Digested Articles")
- (articles (gnus-summary-work-articles n))
- article frame)
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (if post (message-news nil subject) (message-mail nil subject))
- (when (and message-use-multi-frames (cdr articles))
- (setq frame (window-frame (get-buffer-window (current-buffer)))))
- (message-goto-body)
- (while (setq article (pop articles))
- (save-window-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-select-article nil nil nil article)
- (gnus-summary-remove-process-mark article))
- (when frame
- (select-frame frame))
- (insert (mime-make-tag "message" "rfc822") "\n")
- (insert-buffer-substring gnus-original-article-buffer))
- (push-mark)
- (message-goto-body)
- (mime-edit-enclose-digest-region (point)(mark t)))))
-
-(defun gnus-summary-post-digest (&optional n)
- "Digest and forwards all articles in this series to a newsgroup."
- (interactive "P")
- (gnus-summary-mail-digest n t))
+;;;;; XXX: generate Subject and ``Topics''?
+;;(defun gnus-summary-mail-digest (&optional n post)
+;; "Digests and forwards all articles in this series."
+;; (interactive "P")
+;; (let ((subject "Digested Articles")
+;; (articles (gnus-summary-work-articles n))
+;; article frame)
+;; (gnus-setup-message 'forward
+;; (gnus-summary-select-article)
+;; (if post (message-news nil subject) (message-mail nil subject))
+;; (when (and message-use-multi-frames (cdr articles))
+;; (setq frame (window-frame (get-buffer-window (current-buffer)))))
+;; (message-goto-body)
+;; (while (setq article (pop articles))
+;; (save-window-excursion
+;; (set-buffer gnus-summary-buffer)
+;; (gnus-summary-select-article nil nil nil article)
+;; (gnus-summary-remove-process-mark article))
+;; (when frame
+;; (select-frame frame))
+;; (insert (mime-make-tag "message" "rfc822") "\n")
+;; (insert-buffer-substring gnus-original-article-buffer))
+;; (push-mark)
+;; (message-goto-body)
+;; (mime-edit-enclose-digest-region (point)(mark t)))))
+;;
+;;(defun gnus-summary-post-digest (&optional n)
+;; "Digest and forwards all articles in this series to a newsgroup."
+;; (interactive "P")
+;; (gnus-summary-mail-digest n t))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(insert (with-temp-buffer
(gnus-debug)
(buffer-string)))
+ (let (mime-content-types)
+ (mime-edit-insert-tag "text" "plain"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
(let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
"gnus-art.el" "gnus-start.el" "gnus-async.el"
"gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
- "nnmail.el" "message.el"))
+ "nnmail.el" "nntp.el" "message.el"))
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(goto-char (point-min))
(while (setq expr (ignore-errors (read (current-buffer))))
(ignore-errors
- (and (or (eq (car expr) 'defvar)
- (eq (car expr) 'defcustom))
+ (and (memq (car expr) '(defvar defcustom defvoo))
(stringp (nth 3 expr))
(or (not (boundp (nth 1 expr)))
(not (equal (eval (nth 2 expr))
(push (nth 1 expr) olist)))))))
(kill-buffer (current-buffer)))
(when (setq olist (nreverse olist))
- (insert "------------------ Environment follows ------------------\n\n"))
+ (insert ";----------------- Environment follows ------------------\n\n"))
(while olist
(if (boundp (car olist))
(condition-case ()
(format "(setq %s 'whatever)\n" (car olist))))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
- (insert "\n\n")
;; Remove any control chars - they seem to cause trouble for some
;; mailers. (Byte-compiled output from the stuff above.)
(goto-char point)
(while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
(replace-match (format "\\%03o" (string-to-char (match-string 0)))
- t t))))
+ t t))
+ ;; Break MIME tags purposely.
+ (goto-char point)
+ (while (re-search-forward mime-edit-tag-regexp nil t)
+ (goto-char (1+ (match-beginning 0)))
+ (insert "X"))))
;;; Treatment of rejected articles.
;;; Bounced mail.
;;; 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)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
(coding-system-for-write 'raw-text)
(output-coding-system 'raw-text)
- groups group method)
+ groups group method group-art)
(when gcc
(message-remove-header "gcc")
(widen)
- (setq groups (message-tokenize-header gcc " ,"))
+ (setq groups (message-unquote-tokens
+ (message-tokenize-header gcc " ,")))
;; 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
(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 (and group-art gnus-inews-mark-gcc-as-read)
+ (let ((active (gnus-active group)))
+ (if active
+ (if (< (cdr active) (cdr group-art))
+ (gnus-set-active group (cons (car active)
+ (cdr group-art))))
+ (gnus-activate-group group)))
+ (let ((buffer (concat "*Summary " group "*"))
+ (mark gnus-read-mark)
+ (article (cdr group-art)))
+ (unless
+ (and
+ (get-buffer buffer)
+ (with-current-buffer buffer
+ (when gnus-newsgroup-prepared
+ (when (and gnus-newsgroup-auto-expire
+ (memq mark gnus-auto-expirable-marks))
+ (setq mark gnus-expirable-mark))
+ (setq mark (gnus-request-update-mark
+ group article mark))
+ (gnus-mark-article-as-read article mark)
+ (setq gnus-newsgroup-active (gnus-active group))
+ t)))
+ (gnus-group-make-articles-read group
+ (list article))
+ (when (gnus-group-auto-expirable-p group)
+ (gnus-add-marked-articles
+ group 'expire (list article))))))
(kill-buffer (current-buffer))))))))))
(defun gnus-inews-insert-gcc ()
(group (or group gnus-newsgroup-name ""))
(gcc-self-val
(and gnus-newsgroup-name
+ (not (equal gnus-newsgroup-name ""))
(gnus-group-find-parameter
gnus-newsgroup-name 'gcc-self)))
result
(setq results (delq name (delq address results)))
(make-local-variable 'message-setup-hook)
(dolist (result results)
- (when (cdr result)
- (add-hook 'message-setup-hook
- (cond
- ((eq 'eval (car result))
- 'ignore)
- ((eq 'body (car result))
+ (add-hook 'message-setup-hook
+ (cond
+ ((eq 'eval (car result))
+ 'ignore)
+ ((eq 'body (car result))
+ `(lambda ()
+ (save-excursion
+ (message-goto-body)
+ (insert ,(cdr result)))))
+ ((eq 'signature (car result))
+ (set (make-local-variable 'message-signature) nil)
+ (set (make-local-variable 'message-signature-file) nil)
+ (if (not (cdr result))
+ 'ignore
+ `(lambda ()
+ (save-excursion
+ (let ((message-signature ,(cdr result)))
+ (when message-signature
+ (message-insert-signature)))))))
+ (t
+ (let ((header
+ (if (symbolp (car result))
+ (capitalize (symbol-name (car result)))
+ (car result))))
`(lambda ()
(save-excursion
- (message-goto-body)
- (insert ,(cdr result)))))
- ((eq 'signature (car result))
- (set (make-local-variable 'message-signature) nil)
- (set (make-local-variable 'message-signature-file) nil)
- (if (not (cdr result))
- 'ignore
- `(lambda ()
- (save-excursion
- (let ((message-signature ,(cdr result)))
- (when message-signature
- (message-insert-signature)))))))
- (t
- (let ((header
- (if (symbolp (car result))
- (capitalize (symbol-name (car result)))
- (car result))))
- `(lambda ()
- (save-excursion
- (message-remove-header ,header)
- (message-goto-eoh)
- (insert ,header ": " ,(cdr result) "\n")))))))))
+ (message-remove-header ,header)
+ (let ((value ,(cdr result)))
+ (when value
+ (message-goto-eoh)
+ (insert ,header ": " value "\n"))))))))))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
projects / elisp / gnus.git- / blobdiff