;;; 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>
;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
(require 'gnus)
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
-(defcustom gnus-post-method nil
+(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
If this variable is `current', Gnus will use the \"current\" select
method when posting. If it is nil (which is the default), Gnus will
-use the native posting method of the server.
+use the native select method when posting.
This method will not be used in mail groups and the like, only in
\"real\" newsgroups.
If not nil nor `native', the value must be a valid method as discussed
-in the documentation of `gnus-select-method'. It can also be a list of
-methods. If that is the case, the user will be queried for what select
+in the documentation of `gnus-select-method'. It can also be a list of
+methods. If that is the case, the user will be queried for what select
method to use when posting."
:group 'gnus-group-foreign
:type `(choice (const nil)
"*Alist of styles to use when posting.")
(defcustom gnus-group-posting-charset-alist
- '(("^no\\." iso-8859-1)
- (message-this-is-mail nil)
- (".*" iso-8859-1)
- (message-this-is-news iso-8859-1))
- "Alist of regexps (to match group names) and default charsets to be unencoded when posting."
- :type '(repeat (list (regexp :tag "Group")
- (symbol :tag "Charset")))
+ '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" 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.
+Each element of the alist has the form (TEST HEADER BODY-LIST), where
+TEST is either a regular expression matching the newsgroup header or a
+variable to query,
+HEADER is the charset which may be left unencoded in the header (nil
+means encode all charsets),
+BODY-LIST is a list of charsets which may be encoded using 8bit
+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
+use this option with care."
+ :type '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
:group 'gnus-charset)
;;; Internal variables.
"c" gnus-summary-cancel-article
"s" gnus-summary-supersede-article
"r" gnus-summary-reply
+ "y" gnus-summary-yank-message
"R" gnus-summary-reply-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
- (set (make-local-variable 'message-posting-charset)
- (gnus-setup-posting-charset ,group))
(gnus-run-hooks 'gnus-message-setup-hook))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(funcall (car elem) group))
(and (symbolp (car elem))
(symbol-value (car elem))))
- (throw 'found (cadr elem))))))))
+ (throw 'found (cons (cadr elem) (caddr elem)))))))))
(defun gnus-inews-add-send-actions (winconf buffer article)
(make-local-hook 'message-sent-hook)
(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)))
;; the default method.
((null group-method)
(or (and (null (eq gnus-post-method 'active)) gnus-post-method)
- gnus-select-method message-post-method))
+ gnus-select-method message-post-method))
;; We want the inverse of the default
((and arg (not (eq arg 0)))
(if (eq gnus-post-method 'active)
;; Override normal method.
((and (eq gnus-post-method 'current)
(not (eq (car group-method) 'nndraft))
+ (gnus-get-function group-method 'request-post t)
(not arg))
group-method)
((and gnus-post-method
\f
-(defun gnus-extended-version ()
- "Stringified gnus version."
- (concat gnus-product-name "/" gnus-version-number
- " (based on "
- gnus-original-product-name " v" gnus-original-version-number ")"
- (if (zerop (string-to-number gnus-revision-number))
- ""
- (concat " (revision " gnus-revision-number ")"))
- ))
-
(defun gnus-message-make-user-agent (&optional include-mime-info max-column)
"Return user-agent info.
INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable
(insert gnus-bug-message)
(goto-char (point-min)))
(message-pop-to-buffer "*Gnus Bug*")
- (message-setup
- `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . "")))
+ (message-setup `((To . ,gnus-maintainer) (Subject . "")))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
- (insert (gnus-version) "\n"
+ (insert gnus-product-name " " gnus-version-number
+ " (r" gnus-revision-number ") "
+ "based on " gnus-original-product-name " v"
+ gnus-original-version-number "\n"
(emacs-version) "\n")
(when (and (boundp 'nntp-server-type)
(stringp nntp-server-type))
(insert nntp-server-type))
(insert "\n\n\n\n\n")
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
- (gnus-debug))
- (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>")
+ (let (mime-content-types)
+ (mime-edit-insert-tag "text" "plain" "; type=emacs-lisp"))
+ (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 "")))
(when (get-buffer "*Gnus Help Bug*")
(kill-buffer "*Gnus Help Bug*")))
+(defun gnus-summary-yank-message (buffer n)
+ "Yank the current article into a composed message."
+ (interactive
+ (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
+ current-prefix-arg))
+ (when (gnus-buffer-live-p buffer)
+ (let ((summary-frame (selected-frame))
+ (message-frame (when (static-if (featurep 'xemacs)
+ (device-on-window-system-p)
+ window-system)
+ (let ((window (get-buffer-window buffer t)))
+ (when window
+ (window-frame window)))))
+ (separator (concat "^" (regexp-quote mail-header-separator)
+ "\n")))
+ (gnus-summary-iterate n
+ (gnus-summary-select-article)
+ (gnus-copy-article-buffer)
+ (when (frame-live-p message-frame)
+ (raise-frame message-frame)
+ (select-frame message-frame))
+ (with-current-buffer buffer
+ (when (save-excursion
+ (beginning-of-line)
+ (let (case-fold-search)
+ (and (not (re-search-backward separator nil t))
+ (re-search-forward separator nil t))))
+ (goto-char (match-end 0)))
+ (message-yank-buffer gnus-article-copy))
+ (select-frame summary-frame))
+ (when (frame-live-p message-frame)
+ (select-frame message-frame)))))
+
(defun gnus-debug ()
"Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(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.
(message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
(coding-system-for-write 'raw-text)
+ (output-coding-system 'raw-text)
groups group method)
(when gcc
(message-remove-header "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
(unless gnus-inhibit-posting-styles
(let ((group (or gnus-newsgroup-name ""))
(styles gnus-posting-styles)
- style match variable attribute value v styles results
+ style match variable attribute value v results
filep name address element)
;; If the group has a posting-style parameter, add it at the end with a
;; regexp matching everything, to be sure it takes precedence over all
;; Go through all styles and look for matches.
(dolist (style styles)
(setq match (pop style))
+ (goto-char (point-min))
(when (cond
((stringp match)
;; Regexp string match on the group name.
(string-match match group))
+ ((eq match 'header)
+ (let ((header (message-fetch-field (pop style))))
+ (and header
+ (string-match (pop style) header))))
((or (symbolp match)
(gnus-functionp match))
(cond
filep nil)
(setq value
(cond
- ((eq (car attribute) :file)
+ ((eq (car attribute) ':file)
(setq filep t)
(cadr attribute))
((eq (car attribute) :value)
(setq element 'signature
filep t))
;; Get the contents of file elems.
- (when filep
+ (when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
(buffer-string))))
(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 '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
- (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)
+ (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
- (let ((message-signature ,(cdr result)))
- (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 ()
- (let ((user-full-name ,(or (cdr name) user-full-name))
+ (set (make-local-variable 'user-mail-address)
+ ,(or (cdr address) user-mail-address))
+ (let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
(save-excursion
))))
+;;; @ for MIME view mode
+;;;
+
+(defun gnus-following-method (buf)
+ (gnus-setup-message 'reply-yank
+ (set-buffer buf)
+ (if (message-news-p)
+ (message-followup)
+ (message-reply nil 'wide))
+ (let ((message-reply-buffer buf))
+ (message-yank-original))
+ (message-goto-body))
+ (kill-buffer buf))
+
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff