X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=89d4c3e98d4d4531256190e263f2f38ceea12540;hb=a4ee595da5c3b757f5c718cb1d336439745cf0b7;hp=11e84a88dd180e370335da2dee4488c5e8f08de4;hpb=62784c82aa7f41fa78a463b56f469c80ebe69277;p=gnus diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 11e84a88d..89d4c3e98 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -28,11 +28,15 @@ (require 'gnus) (require 'sendmail) (require 'gnus-ems) -(require 'rmail) (defvar gnus-organization-file "/usr/lib/news/organization" "*Local news organization file.") +(defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature) + "*A hook called after preparing body, but before preparing header headers. +The default hook (`gnus-inews-insert-signature') inserts a signature +file specified by the variable `gnus-signature-file'.") + (defvar gnus-post-prepare-function nil "*Function that is run after a post buffer has been prepared. It is called with the name of the newsgroup that is posted to. It @@ -45,11 +49,11 @@ newsgroup name. (In that case, `gnus-signature-file' and If you want to insert the signature, you might put `gnus-inews-insert-signature' in this hook.") -(defvar gnus-use-followup-to 'use +(defvar gnus-use-followup-to t "*Specifies what to do with Followup-To header. If nil, ignore the header. If it is t, use its value, but ignore -`poster'. If it is neither nil nor t, which is the default, always use -the value.") +`poster'. If it is the symbol `ask', query the user before posting. +If it is the symbol `use', always use the value.") (defvar gnus-followup-to-function nil "*A variable that contains a function that returns a followup address. @@ -151,7 +155,10 @@ Message-ID. Organization, Lines and X-Newsreader are optional. If you want Gnus not to insert some header, remove it from this list.") (defvar gnus-deletable-headers '(Message-ID Date) - "*Headers to be deleted if they already exists.") + "*Headers to be deleted if they already exists and were generated by Gnus previously.") + +(defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref) + "*Headers to be removed unconditionally before posting.") (defvar gnus-check-before-posting '(subject-cmsg multiple-headers sendsys message-id from @@ -161,9 +168,10 @@ you want Gnus not to insert some header, remove it from this list.") If this variable is t, Gnus will check everything it can. If it is a list, then those elements in that list will be checked.") -(defvar gnus-delete-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:" +(defvar gnus-delete-supersedes-headers + "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:" "*Header lines matching this regexp will be deleted before posting. -It's best to delete old Path and Date headers before psoting to avoid +It's best to delete old Path and Date headers before posting to avoid any confusion.") (defvar gnus-auto-mail-to-author nil @@ -226,6 +234,10 @@ headers.") (defvar gnus-article-copy nil) (defvar gnus-reply-subject nil) +(eval-and-compile + (autoload 'gnus-uu-post-news "gnus-uu" nil t) + (autoload 'rmail-output "rmailout")) + ;;; ;;; Gnus Posting Functions @@ -291,7 +303,7 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (set-buffer gnus-article-buffer) (if (and gnus-use-followup-to (string-equal "poster" (gnus-fetch-field "followup-to")) - (or (not (eq gnus-use-followup-to t)) + (or (not (memq gnus-use-followup-to '(t ask))) (not (gnus-y-or-n-p "Do you want to ignore `Followup-To: poster'? ")))) ;; Mail to the poster. @@ -341,7 +353,7 @@ header line with the old Message-ID." (if (not (string-equal (downcase (mail-strip-quoted-names - (header-from gnus-current-headers))) + (mail-header-from gnus-current-headers))) (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) (error "This article is not yours.")) (save-excursion @@ -355,21 +367,21 @@ header line with the old Message-ID." (progn (erase-buffer) (insert-buffer gnus-article-buffer) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (if (not (re-search-backward "^Message-ID: " nil t)) - (error "No Message-ID in this article") - (replace-match "Supersedes: " t t)) - (search-forward "\n\n") - (forward-line -1) - (insert mail-header-separator) - - (forward-line -1) + (if (search-forward "\n\n" nil t) + (forward-char -1) + (goto-char (point-max))) (narrow-to-region (point-min) (point)) (goto-char (point-min)) (and gnus-delete-supersedes-headers (delete-matching-lines gnus-delete-supersedes-headers)) - (widen)))) + (goto-char (point-min)) + (if (not (re-search-forward "^Message-ID: " nil t)) + (error "No Message-ID in this article") + (replace-match "Supersedes: " t t)) + (goto-char (point-max)) + (insert mail-header-separator) + (widen) + (forward-line 1)))) ;;;###autoload @@ -417,15 +429,16 @@ Type \\[describe-mode] in the buffer to get a list of commands." (save-excursion (set-buffer gnus-summary-buffer) (cons (current-buffer) gnus-current-article)))) - (from (and header (header-from header))) + (from (and header (mail-header-from header))) (winconf (current-window-configuration)) real-group) (and gnus-interactive-post (not gnus-expert-user) post (not group) (progn - (setq group - (completing-read "Group: " gnus-active-hashtb)) + (setq gnus-newsgroup-name + (setq group + (completing-read "Group: " gnus-active-hashtb))) (or subject (setq subject (read-string "Subject: "))))) (setq mail-reply-buffer gnus-article-copy) @@ -456,22 +469,26 @@ Type \\[describe-mode] in the buffer to get a list of commands." (make-local-variable 'gnus-article-reply) (make-local-variable 'gnus-article-check-size) (make-local-variable 'gnus-reply-subject) - (setq gnus-reply-subject (and header (header-subject header))) + (setq gnus-reply-subject (and header (mail-header-subject header))) (setq gnus-article-reply sumart) ;; Handle `gnus-auto-mail-to-author'. ;; Suggested by Daniel Quinlan . - (let ((to (and (not post) - (if (eq gnus-auto-mail-to-author 'ask) - (and (y-or-n-p "Also send mail to author? ") from) - (and gnus-auto-mail-to-author from))))) + ;; Revised to respect Reply-To by Ulrik Dickow . + (let ((to (and (not post) + (if (if (eq gnus-auto-mail-to-author 'ask) + (y-or-n-p "Also send mail to author? ") + gnus-auto-mail-to-author) + (or (save-excursion + (set-buffer gnus-article-copy) + (gnus-fetch-field "reply-to")) + from))))) (if to - (progn - (if (mail-fetch-field "To") - (progn - (beginning-of-line) - (insert "Cc: " to "\n")) - (mail-position-on-field "To") - (insert to))))) + (if (mail-fetch-field "To") + (progn + (beginning-of-line) + (insert "Cc: " to "\n")) + (mail-position-on-field "To") + (insert to)))) ;; Handle author copy using BCC field. (if (and gnus-mail-self-blind (not (mail-fetch-field "bcc"))) @@ -538,8 +555,10 @@ Type \\[describe-mode] in the buffer to get a list of commands." If given a prefix, and the group is a foreign group, this function will attempt to use the foreign server to post the article." (interactive "P") + (or gnus-current-select-method + (setq gnus-current-select-method gnus-select-method)) (let* ((case-fold-search nil) - (server-running (gnus-server-opened gnus-select-method)) + (server-running (gnus-server-opened gnus-current-select-method)) (reply gnus-article-reply) error post-result) (save-excursion @@ -562,17 +581,24 @@ will attempt to use the foreign server to post the article." ;; Correct newsgroups field: change sequence of spaces to comma and ;; eliminate spaces around commas. Eliminate imbedded line breaks. (goto-char (point-min)) - (if (search-forward-regexp "^Newsgroups: +" nil t) + (if (re-search-forward "^Newsgroups: +" nil t) (save-restriction (narrow-to-region (point) - (if (re-search-forward "^[^ \t]" nil 'end) + (if (re-search-forward "^[^ \t]" nil t) (match-beginning 0) - (point-max))) + (forward-line 1) + (point))) (goto-char (point-min)) - (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) + (while (re-search-forward "\n[ \t]+" nil t) + (replace-match " " t t)) ;No line breaks (too confusing) (goto-char (point-min)) - (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))) + (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) + (replace-match "," t t)) + (goto-char (point-min)) + ;; Remove a trailing comma. + (if (re-search-forward ",$" nil t) + (replace-match "" t t)))) ;; Added by Per Abrahamsen . ;; Help save the the world! @@ -581,7 +607,8 @@ will attempt to use the foreign server to post the article." (let ((newsgroups (mail-fetch-field "newsgroups")) (followup-to (mail-fetch-field "followup-to")) groups to) - (if (and (string-match "," newsgroups) (not followup-to)) + (if (and newsgroups + (string-match "," newsgroups) (not followup-to)) (progn (while (string-match "," newsgroups) (setq groups @@ -648,6 +675,7 @@ will attempt to use the foreign server to post the article." ;; We generate a Message-ID so that the mail and the ;; news copy of the message both get the same ID. (or (mail-fetch-field "message-id") + (not (memq 'Message-ID gnus-required-headers)) (progn (goto-char (point-max)) (insert "Message-ID: " (gnus-inews-message-id) "\n"))) @@ -685,7 +713,14 @@ will attempt to use the foreign server to post the article." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))) (goto-char (point-min)) - (delete-matching-lines "^BCC:")) + (while (re-search-forward "^BCC:" nil t) + (delete-region (match-beginning 0) + ;; There might be continuation headers. + (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + ;; Uhm... or something like this. + (forward-line 1) + (point))))) (if fcc-line (progn (goto-char (point-max)) @@ -850,7 +885,7 @@ will attempt to use the foreign server to post the article." (goto-char (point-max)) (if (not (re-search-backward gnus-signature-separator nil t)) t - (if (> (count-lines (point) (point-max)) 4) + (if (> (count-lines (point) (point-max)) 5) (gnus-y-or-n-p (format "Your .sig is %d lines; it should be max 4. Really post? " @@ -954,7 +989,7 @@ will attempt to use the foreign server to post the article." (match-beginning 0))) (gnus-inews-remove-headers) (gnus-inews-insert-headers) - (run-hooks gnus-inews-article-header-hook) + (run-hooks 'gnus-inews-article-header-hook) (widen)) ;; Check whether the article is a good Net Citizen. (if (and gnus-article-check-size @@ -973,7 +1008,11 @@ will attempt to use the foreign server to post the article." (concat "^" (regexp-quote mail-header-separator) "$")) (replace-match "" t t) ;; This hook may insert a signature. - (run-hooks 'gnus-prepare-article-hook) + (save-excursion + (goto-char (point-min)) + (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups") + gnus-newsgroup-name))) + (run-hooks 'gnus-prepare-article-hook))) ;; Run final inews hooks. This hook may do FCC. ;; The article must be saved before being posted because ;; `gnus-request-post' modifies the buffer. @@ -988,17 +1027,17 @@ will attempt to use the foreign server to post the article." (kill-buffer (current-buffer))))))) (defun gnus-inews-remove-headers () - (let ((case-fold-search t)) - ;; Remove NNTP-posting-host. - (goto-char (point-min)) - (and (re-search-forward "^nntp-posting-host:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Remove Bcc. - (goto-char (point-min)) - (and (re-search-forward "^bcc:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))))) + (let ((case-fold-search t) + (headers gnus-removable-headers)) + ;; Remove toxic headers. + (while headers + (goto-char (point-min)) + (and (re-search-forward + (concat "^" (downcase (format "%s" (car headers)))) + nil t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) + (setq headers (cdr headers))))) (defun gnus-inews-insert-headers () "Prepare article headers. @@ -1054,8 +1093,12 @@ Headers in `gnus-required-headers' will be generated." (if (or (not (re-search-forward (concat "^" (downcase (symbol-name header)) ":") nil t)) (progn - (if (= (following-char) ? ) (forward-char 1) (insert " ")) + ;; The header was found. We insert a space after the + ;; colon, if there is none. + (if (/= (following-char) ? ) (insert " ")) + ;; Find out whether the header is empty... (looking-at "[ \t]*$"))) + ;; So we find out what value we should insert. (progn (setq value (or (if (consp elem) @@ -1088,16 +1131,24 @@ Headers in `gnus-required-headers' will be generated." '(gnus-deletable t face italic) (current-buffer)))))) (setq headers (cdr headers))) ;; Insert new Sender if the From is strange. - (let ((from (mail-fetch-field "from"))) - (if (and from (not (string= - (downcase (car (gnus-extract-address-components - from))) - (downcase (gnus-inews-real-user-address))))) + (let ((from (mail-fetch-field "from")) + (sender (mail-fetch-field "sender"))) + (if (and from + (not (string= + (downcase (car (gnus-extract-address-components from))) + (downcase (gnus-inews-real-user-address)))) + (or (null sender) + (not + (string= + (downcase (car (gnus-extract-address-components sender))) + (downcase (gnus-inews-real-user-address)))))) (progn (goto-char (point-min)) (and (re-search-forward "^Sender:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (progn + (beginning-of-line) + (insert "Original-") + (beginning-of-line))) (insert "Sender: " (gnus-inews-real-user-address) "\n")))))) @@ -1108,7 +1159,8 @@ string is used instead of the variable `gnus-signature-file'. In either case, if the string is a file name, this file is inserted. If the string is not a file name, the string itself is inserted. -If you never want any signature inserted, set both those variables to + +If you never want any signature inserted, set both of these variables to nil." (save-excursion (let ((signature @@ -1199,7 +1251,8 @@ a program specified by the rest of the value." (if (and gnus-author-copy-saver (not (eq gnus-author-copy-saver 'rmail-output))) (funcall gnus-author-copy-saver fcc-file) - (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file)) + (if (and (file-readable-p fcc-file) + (mail-file-babyl-p fcc-file)) (gnus-output-to-rmail fcc-file) (rmail-output fcc-file 1 t t)))))))))) @@ -1215,17 +1268,19 @@ a program specified by the rest of the value." (defun gnus-inews-user-name () "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"." - (let ((full-name (gnus-inews-full-name))) + (let ((full-name (gnus-inews-full-name)) + (address (if (or gnus-user-login-name gnus-use-generic-from + gnus-local-domain (getenv "DOMAINNAME")) + (concat (gnus-inews-login-name) "@" + (gnus-inews-domain-name gnus-use-generic-from)) + user-mail-address))) (or gnus-user-from-line - (concat (if (or gnus-user-login-name gnus-use-generic-from - gnus-local-domain (getenv "DOMAINNAME")) - (concat (gnus-inews-login-name) "@" - (gnus-inews-domain-name gnus-use-generic-from)) - user-mail-address) + (concat address ;; User's full name. - (cond ((string-equal full-name "") "") - ((string-equal full-name "&") ;Unix hack. + (cond ((string-equal full-name "&") ;Unix hack. (concat " (" (user-login-name) ")")) + ((string-match "[^ ]+@[^ ]+ +(.*)" address) + "") (t (concat " (" full-name ")"))))))) @@ -1469,7 +1524,7 @@ mailer." (setq follow-to (funcall gnus-reply-to-function group))) (setq from (mail-fetch-field "from")) (setq date (or (mail-fetch-field "date") - (header-date gnus-current-headers))) + (mail-header-date gnus-current-headers))) (and from (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) @@ -1501,6 +1556,7 @@ mailer." (or follow-to reply-to from sender ""))) subject message-of nil gnus-article-copy nil) + (auto-save-mode auto-save-default) (use-local-map (copy-keymap mail-mode-map)) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) @@ -1513,17 +1569,7 @@ mailer." (while follow-to (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") (setq follow-to (cdr follow-to))))) - ;; Fold long references line to follow RFC1036. - (mail-position-on-field "References") - (let ((begin (- (point) (length "References: "))) - (fill-column 78) - (fill-prefix "\t")) - (if references (insert references)) - (if (and references message-id) (insert " ")) - (if message-id (insert message-id)) - ;; The region must end with a newline to fill the region - ;; without inserting extra newline. - (fill-region-as-paragraph begin (1+ (point)))) + (nnheader-insert-references references message-id) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) @@ -1558,7 +1604,7 @@ mailer." (defun gnus-mail-yank-original () (interactive) (save-excursion - (mail-yank-original nil)) + (mail-yank-original nil)) (or mail-yank-hooks mail-citation-hook (run-hooks 'news-reply-header-hook))) @@ -1585,7 +1631,7 @@ mailer." gnus-newsgroup-name))) gnus-valid-select-methods)) (gnus-fetch-field "From") - gnus-newsgroup-name) + gnus-newsgroup-name) "] " (or (gnus-fetch-field "Subject") "")))) (defun gnus-forward-insert-buffer (buffer) @@ -1657,11 +1703,6 @@ If YANK is non-nil, include the original article." (switch-to-buffer gnus-summary-buffer) (funcall gnus-mail-reply-method yank address))))) -(defun gnus-article-mail-with-original () - "Send a reply to the address near point and include the original article." - (interactive) - (gnus-article-mail 'yank)) - (defun gnus-bug () "Send a bug report to the Gnus maintainers." (interactive) @@ -1675,6 +1716,7 @@ If YANK is non-nil, include the original article." (erase-buffer) (mail-mode) (mail-setup gnus-maintainer nil nil nil nil nil) + (auto-save-mode auto-save-default) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (use-local-map (copy-keymap mail-mode-map)) @@ -1683,9 +1725,9 @@ If YANK is non-nil, include the original article." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version))) - (let ((b (point))) - (gnus-debug) - (goto-char (- b 3))) + (gnus-debug) + (goto-char (point-min)) + (search-forward "Subject: " nil t) (message ""))) (defun gnus-bug-mail-send-and-exit () @@ -1700,7 +1742,7 @@ If YANK is non-nil, include the original article." The source file has to be in the Emacs load path." (interactive) (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el")) - file dirs expr olist) + file dirs expr olist sym) (message "Please wait while we snoop your variables...") (sit-for 0) (save-excursion @@ -1739,8 +1781,10 @@ The source file has to be in the Emacs load path." (while olist (if (boundp (car olist)) (insert "(setq " (symbol-name (car olist)) - (if (or (consp (symbol-value (car olist))) - (symbolp (symbol-value (car olist)))) + (if (or (consp (setq sym (symbol-value (car olist)))) + (and (symbolp sym) + (not (or (eq sym nil) + (eq sym t))))) " '" " ") (prin1-to-string (symbol-value (car olist))) ")\n") (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))