-;;; gnus-msg.el --- mail and post interface for Gnus
+;;; gnus-msg.el --- mail and post interface for Semi-gnus
;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(defvar gnus-bug-create-help-buffer t
"*Should we create the *Gnus Help Bug* buffer?")
-(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.")
-
;;; Internal variables.
(defvar gnus-message-buffer "*Mail Gnus*")
(copy-sequence message-header-setup-hook)))
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
- (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
(unwind-protect
(progn
,@forms)
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
- (when (gnus-eval-in-buffer-window gnus-original-article-buffer
- (message-cancel-news))
+ (when (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (message-cancel-news)))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(gnus-cache-remove-article 1))
(gnus-article-hide-headers-if-wanted))
;;; 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."
+ "Stringified gnus version."
(interactive)
- (concat
- 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 "\\([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)
- (if (match-beginning 3)
- (substring emacs-version
- (match-beginning 3)
- (match-end 3))
- "")
- (if (boundp 'xemacs-codename)
- (concat " - \"" xemacs-codename "\""))))
- (t emacs-version))))
-
-;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
-(defun gnus-inews-insert-mime-headers ()
- "Insert MIME headers.
-Assumes ISO-Latin-1 is used iff 8-bit characters are present."
- (goto-char (point-min))
- (let ((mail-header-separator
- (progn
- (goto-char (point-min))
- (if (and (search-forward (concat "\n" mail-header-separator "\n")
- nil t)
- (not (search-backward "\n\n" nil t)))
- mail-header-separator
- ""))))
- (or (mail-position-on-field "Mime-Version")
- (insert "1.0")
- (cond ((save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward "[^\000-\177]" nil t))
- (or (mail-position-on-field "Content-Type")
- (insert "text/plain; charset=ISO-8859-1"))
- (or (mail-position-on-field "Content-Transfer-Encoding")
- (insert "8bit")))
- (t (or (mail-position-on-field "Content-Type")
- (insert "text/plain; charset=US-ASCII"))
- (or (mail-position-on-field "Content-Transfer-Encoding")
- (insert "7bit")))))))
-
-(custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers)
+ gnus-version)
\f
;;;
(interactive "P")
(gnus-setup-message 'forward
(gnus-summary-select-article)
- (set-buffer gnus-original-article-buffer)
+ (let ((charset default-mime-charset))
+ (set-buffer gnus-original-article-buffer)
+ (make-local-variable 'default-mime-charset)
+ (setq default-mime-charset charset)
+ )
(let ((message-included-forward-headers
(if full-headers "" message-included-forward-headers)))
(message-forward post))))
(save-restriction
(message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
+ (coding-system-for-write 'raw-text)
groups group method)
(when gcc
(message-remove-header "gcc")
(gnus-request-create-group group method))
(save-excursion
(nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
+ (insert-buffer-substring message-encoding-buffer)
+ (gnus-run-hooks 'gnus-before-do-gcc-hook)
(goto-char (point-min))
(when (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")
(insert " ")))
(insert "\n")))))))
-;;; Posting styles.
-
-(defun gnus-configure-posting-styles ()
- "Configure posting styles according to `gnus-posting-styles'."
- (let ((styles gnus-posting-styles)
- (gnus-newsgroup-name (or gnus-newsgroup-name ""))
- style match variable attribute value value-value)
- ;; 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)))
- ;; 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 (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
- (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
- (progn
- ;; This is an ordinary variable.
- (make-local-variable variable)
- (set variable value-value))
- ;; This is a header to be added to the headers when
- ;; posting.
- (when value-value
- (make-local-variable message-required-mail-headers)
- (make-local-variable message-required-news-headers)
- (push (cons (car attribute) value-value)
- message-required-mail-headers)
- (push (cons (car attribute) value-value)
- message-required-news-headers)))))))))
-
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff