X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=1813232db85dff7191efc49bdfa0c9df2011f5e9;hp=43ce9795abf74a68b2d8d3c7a6732001de3c0c6f;hb=9b139a13c0650a18872ebd64849560a97554afa8;hpb=66d37a006e891928633ca9bf156c48466ce96c25 diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 43ce9795a..1813232db 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,7 +1,7 @@ ;;; gnus-msg.el --- mail and post interface for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -11,7 +11,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -289,6 +289,16 @@ If nil, the address field will always be empty after invoking :group 'gnus-message :type 'boolean) +(defcustom gnus-message-highlight-citation + t ;; gnus-treat-highlight-citation ;; gnus-cite dependency + "Enable highlighting of different citation levels in message-mode." + :version "23.0" ;; No Gnus + :group 'gnus-cite + :group 'gnus-message + :type 'boolean) + +(autoload 'gnus-message-citation-mode "gnus-cite" nil t) + ;;; Internal variables. (defvar gnus-inhibit-posting-styles nil @@ -369,7 +379,7 @@ Thank you for your help in stamping out bugs. (defun gnus-inews-make-draft (articles) `(lambda () (gnus-inews-make-draft-meta-information - ,gnus-newsgroup-name ',articles))) + ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles))) (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) @@ -390,6 +400,13 @@ Thank you for your help in stamping out bugs. (setq mml-buffer-list nil) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) + ;; message-newsreader and message-mailer were formerly set in + ;; gnus-inews-add-send-actions, but this is too late when + ;; message-generate-headers-first is used. --ansel + (add-hook 'message-mode-hook + (lambda nil + (setq message-newsreader + (setq message-mailer (gnus-extended-version))))) ;; #### FIXME: for a reason that I did not manage to identify yet, ;; the variable `gnus-newsgroup-name' does not honor a dynamically ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'. @@ -422,6 +439,9 @@ Thank you for your help in stamping out bugs. (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) (set (make-local-variable 'gnus-newsgroup-name) ,group) + ;; Enable highlighting of different citation levels + (when gnus-message-highlight-citation + (gnus-message-citation-mode 1)) (gnus-run-hooks 'gnus-message-setup-hook) (if (eq major-mode 'message-mode) (let ((mbl1 mml-buffer-list)) @@ -519,7 +539,6 @@ Gcc: header for archiving purposes." (setq message-post-method `(lambda (&optional arg) (gnus-post-method arg ,gnus-newsgroup-name))) - (setq message-newsreader (setq message-mailer (gnus-extended-version))) (message-add-action `(when (gnus-buffer-exists-p ,buffer) (set-window-configuration ,winconf)) @@ -561,9 +580,9 @@ If ARG is 1, prompt for a group name to find the posting style." (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-completing-read + "Use posting style of group: " + nil nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -592,9 +611,9 @@ network. The corresponding back end must have a 'request-post method." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -614,8 +633,8 @@ a news." (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; make sure last viewed article doesn't affect posting styles: @@ -640,9 +659,9 @@ posting style." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; #### see comment in gnus-setup-message -- drv @@ -671,9 +690,9 @@ network. The corresponding back end must have a 'request-post method." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; #### see comment in gnus-setup-message -- drv @@ -698,8 +717,8 @@ a news." (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; make sure last viewed article doesn't affect posting styles: @@ -770,6 +789,7 @@ active, the entire article will be yanked." (nnheader-narrow-to-headers) (nnheader-parse-naked-head))))) (message-yank-original) + (message-exchange-point-and-mark) (setq beg (or beg (mark t)))) (when articles (insert "\n"))) @@ -811,7 +831,10 @@ header line with the old Message-ID." (set-buffer ,gnus-summary-buffer) (gnus-cache-possibly-remove-article ,article nil nil nil t) (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) - message-send-actions)))) + message-send-actions) + ;; Add Gcc header. + (gnus-inews-insert-archive-gcc) + (gnus-inews-insert-gcc)))) @@ -847,6 +870,7 @@ header line with the old Message-ID." (delete-region (point) (point-max)) (insert yank-string)) (gnus-article-delete-text-of-type 'annotation) + (gnus-article-delete-text-of-type 'multipart) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) (gnus-remove-text-with-property 'gnus-decoration) @@ -1273,10 +1297,13 @@ composing a new message." (message-narrow-to-head-1) ;; Gnus will generate a new one when sending. (message-remove-header "Message-ID") - (message-remove-header message-ignored-resent-headers t) ;; Remove unwanted headers. + (message-remove-header message-ignored-resent-headers t) (goto-char (point-max)) (insert mail-header-separator) + ;; Add Gcc header. + (gnus-inews-insert-archive-gcc) + (gnus-inews-insert-gcc) (goto-char (point-min)) (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move) (forward-char 1)) @@ -1548,15 +1575,29 @@ If FETCH, try to fetch the article that this is a reply to, if indeed this is a reply." (interactive "P") (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) + (let (summary-buffer parent) + (if fetch + (progn + (setq summary-buffer (current-buffer)) + (set-buffer gnus-original-article-buffer) + (article-goto-body) + (when (re-search-forward "^References:\n?" nil t) + (while (memq (char-after) '(?\t ? )) + (forward-line 1)) + (skip-chars-backward "\t\n ") + (setq parent + (gnus-parent-id (buffer-substring (match-end 0) (point)))))) + (set-buffer gnus-original-article-buffer)) + (gnus-setup-message 'compose-bounce (message-bounce) + ;; Add Gcc header. + (gnus-inews-insert-archive-gcc) + (gnus-inews-insert-gcc) ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers))))) + (when parent + (with-current-buffer summary-buffer + (gnus-summary-refer-article parent) + (gnus-summary-show-all-headers)))))) ;;; Gcc handling. @@ -1682,8 +1723,13 @@ this is a reply." (defun gnus-inews-insert-archive-gcc (&optional group) "Insert the Gcc to say where the article is to be archived." + (setq group (cond (group + (gnus-group-decoded-name group)) + (gnus-newsgroup-name + (gnus-group-decoded-name gnus-newsgroup-name)) + (t + ""))) (let* ((var gnus-message-archive-group) - (group (or group gnus-newsgroup-name "")) (gcc-self-val (and gnus-newsgroup-name (not (equal gnus-newsgroup-name "")) @@ -1865,6 +1911,13 @@ this is a reply." ((eq element 'x-face-file) (setq element 'x-face filep t))) + ;; Post-processing for the signature posting-style: + (and (eq element 'signature) filep + message-signature-directory + ;; don't actually use the signature directory + ;; if message-signature-file contains a path. + (not (file-name-directory v)) + (setq v (nnheader-concat message-signature-directory v))) ;; Get the contents of file elems. (when (and filep v) (setq v (with-temp-buffer