(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)
(defvar gnus-posting-styles nil
"*Alist of styles to use when posting.")
-(defvar gnus-posting-style-alist
- '((organization . message-user-organization)
- (signature . message-signature)
- (signature-file . message-signature-file)
- (address . user-mail-address)
- (name . user-full-name))
- "*Mapping from style parameters to variables.")
-
(defcustom gnus-group-posting-charset-alist
'(("^no\\." iso-8859-1)
- (".*" iso-8859-1)
- (message-this-is-news iso-8859-1)
(message-this-is-mail nil)
- )
+ ("^de\\." 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")))
The buffer below is a mail buffer. When you press `C-c C-c', it will
be sent to the Gnus Bug Exterminators.
-At the bottom of the buffer you'll see lots of variable settings.
-Please do not delete those. They will tell the Bug People what your
-environment is, so that it will be easier to locate the bugs.
+The thing near the bottom of the buffer is how the environment
+settings will be included in the mail. Please do not delete that.
+They will tell the Bug People what your environment is, so that it
+will be easier to locate the bugs.
If you have found a bug that makes Emacs go \"beep\", set
debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
"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
(defun gnus-setup-posting-charset (group)
(let ((alist gnus-group-posting-charset-alist)
+ (group (or group ""))
elem)
(when group
(catch 'found
;; 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
" (" gnus-version ")"
" "
(cond
- ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
+ ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
(concat "Emacs/" (match-string 1 emacs-version)))
((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
emacs-version)
(interactive "P")
(gnus-summary-reply-with-original n t))
-(defun gnus-summary-mail-forward (&optional full-headers post)
+(defun gnus-summary-mail-forward (&optional not-used post)
"Forward the current message to another user.
-If FULL-HEADERS (the prefix), include full headers when forwarding."
+If POST, post instead of mail."
(interactive "P")
(gnus-setup-message 'forward
(gnus-summary-select-article)
(save-excursion
(set-buffer gnus-original-article-buffer)
(setq text (buffer-string)))
- (set-buffer (gnus-get-buffer-create " *Gnus forward*"))
+ (set-buffer (gnus-get-buffer-create
+ (generate-new-buffer-name " *Gnus forward*")))
(erase-buffer)
(insert text)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: ") )
(run-hooks 'gnus-article-decode-hook)
- (let ((message-included-forward-headers
- (if full-headers "" message-included-forward-headers)))
- (message-forward post)))))
+ (message-forward post))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(stringp nntp-server-type))
(insert nntp-server-type))
(insert "\n\n\n\n\n")
- (gnus-debug)
+ (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>")
(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))
+ (gnus-summary-iterate n
+ (let ((gnus-display-mime-function nil)
+ (gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (save-excursion
+ (set-buffer buffer)
+ (message-yank-buffer gnus-article-buffer))))
+
(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."
(save-excursion
(nnheader-set-temp-buffer " *acc*")
(insert-buffer-substring cur)
+ (message-encode-message-body)
+ (save-restriction
+ (message-narrow-to-headers)
+ (mail-encode-encoded-word-buffer))
(goto-char (point-min))
(when (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")
;;; Posting styles.
-(defvar gnus-message-style-insertions nil)
-
(defun gnus-configure-posting-styles ()
"Configure posting styles according to `gnus-posting-styles'."
(unless gnus-inhibit-posting-styles
- (let ((styles gnus-posting-styles)
- (gnus-newsgroup-name (or gnus-newsgroup-name ""))
- style match variable attribute value value-value)
- (make-local-variable 'gnus-message-style-insertions)
+ (let ((group (or gnus-newsgroup-name ""))
+ (styles gnus-posting-styles)
+ 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
;; the others.
- (unless (zerop (length gnus-newsgroup-name))
- (let ((tmp-style (gnus-group-find-parameter
- gnus-newsgroup-name 'posting-style t)))
+ (when gnus-newsgroup-name
+ (let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
(when tmp-style
(setq styles (append styles (list (cons ".*" tmp-style)))))))
;; Go through all styles and look for matches.
- (while styles
- (setq style (pop styles)
- match (pop style))
+ (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 gnus-newsgroup-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
;; This is a form to be evaled.
(eval match)))
;; We have a match, so we set the variables.
- (while style
- (setq attribute (pop style)
- value (cadr attribute)
- variable nil)
- ;; We find the variable that is to be modified.
- (if (and (not (stringp (car attribute)))
- (not (eq 'body (car attribute)))
- (not (setq variable
- (cdr (assq (car attribute)
- gnus-posting-style-alist)))))
- (message "Couldn't find attribute %s" (car attribute))
- ;; We get the value.
- (setq value-value
+ (dolist (attribute style)
+ (setq element (pop attribute)
+ variable nil
+ filep nil)
+ (setq value
+ (cond
+ ((eq (car attribute) :file)
+ (setq filep t)
+ (cadr attribute))
+ ((eq (car attribute) :value)
+ (cadr attribute))
+ (t
+ (car attribute))))
+ ;; We get the value.
+ (setq v
+ (cond
+ ((stringp value)
+ value)
+ ((or (symbolp value)
+ (gnus-functionp value))
+ (cond ((gnus-functionp value)
+ (funcall value))
+ ((boundp value)
+ (symbol-value value))))
+ ((listp value)
+ (eval value))))
+ ;; Translate obsolescent value.
+ (when (eq element 'signature-file)
+ (setq element 'signature
+ filep t))
+ ;; Get the contents of file elems.
+ (when (and filep v)
+ (setq v (with-temp-buffer
+ (insert-file-contents v)
+ (buffer-string))))
+ (setq results (delq (assoc element results) results))
+ (push (cons element v) results))))
+ ;; Now we have all the styles, so we insert them.
+ (setq name (assq 'name results)
+ address (assq 'address results))
+ (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
- ((stringp value)
- value)
- ((or (symbolp value)
- (gnus-functionp value))
- (cond ((gnus-functionp value)
- (funcall value))
- ((boundp value)
- (symbol-value value))))
- ((listp value)
- (eval value))))
- (if variable
- ;; This is an ordinary variable.
- (set (make-local-variable variable) value-value)
- ;; This is either a body or a header to be inserted in the
- ;; message.
- (let ((attr (car attribute)))
- (make-local-variable 'message-setup-hook)
- (if (eq 'body attr)
- (add-hook 'message-setup-hook
- `(lambda ()
- (save-excursion
- (message-goto-body)
- (insert ,value-value))))
- (add-hook 'message-setup-hook
- 'gnus-message-insert-stylings)
- (push (cons (if (stringp attr) attr
- (symbol-name attr))
- value-value)
- gnus-message-style-insertions)))))))))))
-
-(defun gnus-message-insert-stylings ()
- (let (val)
- (save-excursion
- (message-goto-eoh)
- (while (setq val (pop gnus-message-style-insertions))
- (when (cdr val)
- (insert (car val) ": " (cdr val) "\n"))
- (gnus-pull (car val) gnus-message-style-insertions t)))))
+ ((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-remove-header ,header)
+ (message-goto-eoh)
+ (insert ,header ": " ,(cdr result) "\n")))))))))
+ (when (or name address)
+ (add-hook 'message-setup-hook
+ `(lambda ()
+ (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
+ (message-remove-header "From")
+ (message-goto-eoh)
+ (insert "From: " (message-make-from) "\n")))))))))
;;; Allow redefinition of functions.