;;; Internal variables.
+(defvar gnus-inhibit-posting-styles nil
+ "Inhibit the use of posting styles.")
+
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
(defvar gnus-last-posting-server nil)
(,article (and gnus-article-reply (gnus-summary-article-number)))
(,group gnus-newsgroup-name)
(message-header-setup-hook
- (copy-sequence message-header-setup-hook)))
+ (copy-sequence message-header-setup-hook))
+ (message-mode-hook (copy-sequence message-mode-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-setup-hook 'gnus-configure-posting-styles)
+ (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
(unwind-protect
(progn
,@forms)
(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)
(gnus-run-hooks 'gnus-message-setup-hook))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
;;; Post news commands of Gnus group mode and summary mode
-(defun gnus-group-mail ()
- "Start composing a mail."
- (interactive)
- (gnus-setup-message 'message
- (message-mail)))
+(defun gnus-group-mail (&optional arg)
+ "Start composing a mail.
+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")
+ ;; 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))
(let ((article-buffer (or article-buffer gnus-article-buffer))
- end beg contents)
+ end beg)
(if (not (and (get-buffer article-buffer)
(gnus-buffer-exists-p article-buffer)))
(error "Can't find any article buffer")
;; 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
(list gnus-post-method)))
gnus-secondary-select-methods
(mapcar 'cdr gnus-server-alist)
+ (mapcar 'car gnus-opened-servers)
(list gnus-select-method)
(list group-method)))
method-alist post-methods method)
;; Weed out all mail methods.
(while methods
(setq method (gnus-server-get-method "" (pop methods)))
- (when (or (gnus-method-option-p method 'post)
- (gnus-method-option-p method 'post-mail))
+ (when (and (or (gnus-method-option-p method 'post)
+ (gnus-method-option-p method 'post-mail))
+ (not (member method post-methods)))
(push method post-methods)))
;; Create a name-method alist.
(setq method-alist
((and (eq gnus-post-method 'current)
(not (eq (car group-method) 'nndraft))
(not arg))
- group-method)
- (gnus-post-method
+ group-method)
+ ((and gnus-post-method
+ (not (eq gnus-post-method 'current)))
gnus-post-method)
;; Use the normal select method.
(t gnus-select-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))))
+ (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))))
-;; 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)
-
\f
;;;
;;; Gnus Mail Functions
(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)))
- (message-forward post))))
+ (let (text)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (setq text (buffer-string)))
+ (set-buffer (gnus-get-buffer-create " *Gnus forward*"))
+ (erase-buffer)
+ (insert text)
+ (run-hooks 'gnus-article-decode-hook)
+ (let ((message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (message-forward post)))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(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")))
;; 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)
;;; Posting styles.
+(defvar gnus-message-style-insertions nil)
+
(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 (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
- (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)))
- (if (eq 'body attr)
- (save-excursion
- (goto-char (point-max))
- (insert value-value))
- (save-excursion
- (message-goto-eoh)
- (insert (if (stringp attr) attr (symbol-name attr))
- ": " value-value "\n"))))))))))))
+ (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)
+ ;; 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)))
+ ;; 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
+ (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)))))
;;; Allow redefinition of functions.
projects / elisp / gnus.git- / blobdiff