;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(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)
+ )
+ "Alist of regexps (to match group names) and default charsets to be unencoded when posting."
+ :type '(repeat (list (regexp :tag "Group")
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
- (make-local-variable 'gnus-newsgroup-name)
+ (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)
(set-buffer-modified-p nil))))
+(defun gnus-setup-posting-charset (group)
+ (let ((alist gnus-group-posting-charset-alist)
+ elem)
+ (when group
+ (catch 'found
+ (while (setq elem (pop alist))
+ (when (or (and (stringp (car elem))
+ (string-match (car elem) group))
+ (and (gnus-functionp (car elem))
+ (funcall (car elem) group))
+ (and (symbolp (car elem))
+ (symbol-value (car elem))))
+ (throw 'found (cadr elem))))))))
+
(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)
If ARG, use the group under the point to find a posting style.
If ARG is 1, prompt for a group name to find the posting style."
(interactive "P")
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (completing-read "Use style of group: " gnus-active-hashtb nil
- (gnus-read-active-file-p))
- (gnus-group-group-name))
- "")))
- (gnus-setup-message 'message (message-mail))
- ))
+ ;; We can't `let' gnus-newsgroup-name here, since that leads
+ ;; to local variables leaking.
+ (let ((group gnus-newsgroup-name)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use posting style of group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ ""))
+ (gnus-setup-message 'message (message-mail)))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
(defun gnus-group-post-news (&optional arg)
"Start composing a news message.
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
;; this buffer should be passed to all mail/news reply/post routines.
(setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
- (buffer-disable-undo gnus-article-copy)
(save-excursion
(set-buffer gnus-article-copy)
(mm-enable-multibyte))
;; 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)))
+ (or (search-forward "\n\n" nil t) (point-max)))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
- (gnus-article-decode-rfc1522)))
+ (article-decode-encoded-words)))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
((and (eq gnus-post-method 'current)
(not (eq (car group-method) 'nndraft))
(not arg))
- group-method)
+ group-method)
((and gnus-post-method
(not (eq gnus-post-method 'current)))
gnus-post-method)
\f
-;; Dummy to avoid byte-compile warning.
+;; Dummies to avoid byte-compile warning.
(defvar nnspool-rejected-article-hook)
(defvar xemacs-codename)
-;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
-;;; as well include the Emacs version as well.
-;;; The following function works with later GNU Emacs, and XEmacs.
(defun gnus-extended-version ()
"Stringified Gnus version and Emacs version."
(interactive)
(concat
- gnus-version
- "/"
+ "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t)
+ " (" gnus-version ")"
+ " "
(cond
- ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
- (concat "Emacs " (substring emacs-version
- (match-beginning 1)
- (match-end 1))))
+ ((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)
- (concat (substring emacs-version
- (match-beginning 1)
- (match-end 1))
- (format " %d.%d" emacs-major-version emacs-minor-version)
+ (concat (match-string 1 emacs-version)
+ (format "/%d.%d" emacs-major-version emacs-minor-version)
(if (match-beginning 3)
- (substring emacs-version
- (match-beginning 3)
- (match-end 3))
+ (match-string 3 emacs-version)
"")
(if (boundp 'xemacs-codename)
- (concat " - \"" xemacs-codename "\""))))
+ (concat " (" xemacs-codename ")")
+ "")))
(t emacs-version))))
\f
(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)
- (set-buffer gnus-original-article-buffer)
- (let ((message-included-forward-headers
- (if full-headers "" message-included-forward-headers)))
+ (let (text)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (setq text (buffer-string)))
+ (set-buffer (gnus-get-buffer-create
+ (generate-new-buffer-name " *Gnus forward*")))
+ (erase-buffer)
+ (insert text)
+ (run-hooks 'gnus-article-decode-hook)
(message-forward post))))
(defun gnus-summary-resend-message (address n)
(gnus-summary-select-article)
(set-buffer gnus-original-article-buffer)
(if (and (<= (length (message-tokenize-header
- (setq newsgroups (mail-fetch-field "newsgroups"))
+ (setq newsgroups
+ (mail-fetch-field "newsgroups"))
", "))
1)
(or (not (setq followup-to (mail-fetch-field "followup-to")))
(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/emacs-lisp buffer=\" *gnus environment info*\" disposition=inline><#/part>")
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
;; Go through all the files looking for non-default values for variables.
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus bug info*"))
- (buffer-disable-undo (current-buffer))
(while files
(erase-buffer)
(when (and (setq file (locate-library (pop files)))
(concat "^" (regexp-quote mail-header-separator) "$")
nil t)
(replace-match "" t t ))
- (unless (gnus-request-accept-article group method t)
+ (unless (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))
(and gnus-newsgroup-name
(gnus-group-find-parameter
gnus-newsgroup-name 'gcc-self)))
- result
+ result
(groups
(cond
((null gnus-message-archive-method)
(gnus-newsgroup-name (or gnus-newsgroup-name ""))
style match variable attribute value value-value)
(make-local-variable 'gnus-message-style-insertions)
+ ;; 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 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))
- (when (cond ((stringp match)
- ;; Regexp string match on the group name.
- (string-match match gnus-newsgroup-name))
- ((or (symbolp match)
- (gnus-functionp match))
- (cond ((gnus-functionp match)
- ;; Function to be called.
- (funcall match))
- ((boundp match)
- ;; Variable to be checked.
- (symbol-value match))))
- ((listp match)
- ;; This is a form to be evaled.
- (eval match)))
+ (when (cond
+ ((stringp match)
+ ;; Regexp string match on the group name.
+ (string-match match gnus-newsgroup-name))
+ ((or (symbolp match)
+ (gnus-functionp match))
+ (cond
+ ((gnus-functionp match)
+ ;; Function to be called.
+ (funcall match))
+ ((boundp match)
+ ;; Variable to be checked.
+ (symbol-value match))))
+ ((listp match)
+ ;; This is a form to be evaled.
+ (eval match)))
;; We have a match, so we set the variables.
(while style
(setq attribute (pop style)
(if (and (not (stringp (car attribute)))
(not (eq 'body (car attribute)))
(not (setq variable
- (cdr (assq (car attribute)
+ (cdr (assq (car attribute)
gnus-posting-style-alist)))))
(message "Couldn't find attribute %s" (car attribute))
;; We get the value.
(setq value-value
- (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))))
+ (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.
- (when value-value
- (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))))
+ (let ((attr (car attribute)))
+ (make-local-variable 'message-setup-hook)
+ (if (eq 'body attr)
(add-hook 'message-setup-hook
- 'gnus-message-insert-stylings)
- (push (cons (if (stringp attr) attr
- (symbol-name attr))
- value-value)
- gnus-message-style-insertions))))))))))))
+ `(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)
(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)))))
+ (gnus-pull (car val) gnus-message-style-insertions t)))))
;;; Allow redefinition of functions.
projects / elisp / gnus.git- / blobdiff