From 46e8fe3d6ce114ae3ecd41f7add9ed7f0c13f4b6 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Wed, 1 Feb 2006 10:02:36 +0000 Subject: [PATCH] Revision: emacs@sv.gnu.org/emacs--devo--0--patch-33 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 8-13) - Merge from emacs--devo--0 - Update from CVS --- lisp/gnus/ChangeLog | 54 ++++++++++++++++++++++- lisp/gnus/mailcap.el | 51 +++++++++++----------- lisp/gnus/message.el | 23 +++++++--- lisp/gnus/mm-uu.el | 58 +++++++++++++++++-------- lisp/gnus/nnweb.el | 100 ++++++++++++++++++++----------------------- man/ChangeLog | 6 +++ man/message.texi | 21 +++++++-- 7 files changed, 207 insertions(+), 106 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index cd98afa3da5..87a3f1918d6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,8 +1,60 @@ +2006-01-31 Andreas Seltenreich + + * nnweb.el (nnweb-group-alist): Use defvar instead of defvoo, + there's only one active file for all servers. + (nnweb-request-scan): Make sure nnweb-articles is initialized on + solid groups. Gnus might have used a FAST request to select the + group. + (nnweb-request-group, nnweb-google-parse-1): Don't keep nnweb-type + and nnweb-search redundantly in the active file. + (nnweb-request-list): Don't list bogus groups. There can only be + one. + (nnweb-request-create-group): Don't use ARGS. + (nnweb-possibly-change-server, nnweb-request-group): Remove some + initialisations. Let nnoo do the work. + +2006-01-31 Romain Francoise + + * message.el (message-alternative-emails): Improve docstring. + (message-setup-1): Call `message-use-alternative-email-as-from' + after `message-setup-hook' to give it precedence over posting + styles, etc. + (message-use-alternative-email-as-from): Add docstring. Remove + the original From header if present. + +2006-01-31 Katsumi Yamaoka + + * mm-uu.el (mm-uu-emacs-sources-extract): Say the part has been + decoded. + (mm-uu-diff-extract): Ditto. + +2006-01-31 Kevin Ryde + + * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into + mailcap-viewer-test-cache when there's no 'test clause, since that + will invert the meaning of a "nil" test previously determined by + mailcap-mailcap-entry-passes-test. + +2006-01-30 Reiner Steib + + * nnweb.el (nnweb-google-parse-1): Clarify some comments. + +2006-01-30 Andreas Seltenreich + + * nnweb.el (nnweb-type-definition, nnweb-google-parse-1) + (nnweb-google-create-mapping, nnweb-google-search): Adapt to + current Google Groups. + +2006-01-26 Katsumi Yamaoka + + * Makefile.in (clean): New rule. + (distclean): Use it. + 2006-01-25 Katsumi Yamaoka * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part is dissected into a single part of which the type is the same as - the given one. + the given one; decode charset. 2006-01-21 Kevin Ryde diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 80153645819..f0d93f38655 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -1,7 +1,7 @@ ;;; mailcap.el --- MIME media types configuration ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -640,30 +640,31 @@ to supply to the test." (viewer (cdr (assoc 'viewer viewer-info))) (default-directory (expand-file-name "~/")) status parsed-test cache result) - (if (setq cache (assoc test mailcap-viewer-test-cache)) - (cadr cache) - (setq - result - (cond - ((not test-info) t) ; No test clause - ((not test) nil) ; Already failed test - ((eq test t) t) ; Already passed test - ((functionp test) ; Lisp function as test - (funcall test type-info)) - ((and (symbolp test) ; Lisp variable as test - (boundp test)) - (symbol-value test)) - ((and (listp test) ; List to be eval'd - (symbolp (car test))) - (eval test)) - (t - (setq test (mailcap-unescape-mime-test test type-info) - test (list shell-file-name nil nil nil - shell-command-switch test) - status (apply 'call-process test)) - (eq 0 status)))) - (push (list otest result) mailcap-viewer-test-cache) - result))) + (cond ((setq cache (assoc test mailcap-viewer-test-cache)) + (cadr cache)) + ((not test-info) t) ; No test clause + (t + (setq + result + (cond + ((not test) nil) ; Already failed test + ((eq test t) t) ; Already passed test + ((functionp test) ; Lisp function as test + (funcall test type-info)) + ((and (symbolp test) ; Lisp variable as test + (boundp test)) + (symbol-value test)) + ((and (listp test) ; List to be eval'd + (symbolp (car test))) + (eval test)) + (t + (setq test (mailcap-unescape-mime-test test type-info) + test (list shell-file-name nil nil nil + shell-command-switch test) + status (apply 'call-process test)) + (eq 0 status)))) + (push (list otest result) mailcap-viewer-test-cache) + result)))) (defun mailcap-add-mailcap-entry (major minor info) (let ((old-major (assoc major mailcap-mime-data))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 797d2233fe5..28325b73e26 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1388,8 +1388,13 @@ should be sent in several parts. If it is nil, the size is unlimited." (integer 1000000))) (defcustom message-alternative-emails nil - "A regexp to match the alternative email addresses. -The first matched address (not primary one) is used in the From field." + "*Regexp matching alternative email addresses. +The first address in the To, Cc or From headers of the original +article matching this variable is used as the From field of +outgoing messages. + +This variable has precedence over posting styles and anything that runs +off `message-setup-hook'." :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "Always use primary" nil) @@ -5546,10 +5551,6 @@ are not included." (when message-default-mail-headers (insert message-default-mail-headers) (or (bolp) (insert ?\n))) - (save-restriction - (message-narrow-to-headers) - (if message-alternative-emails - (message-use-alternative-email-as-from))) (when message-generate-headers-first (message-generate-headers (message-headers-to-generate @@ -5565,6 +5566,12 @@ are not included." (set-buffer-modified-p nil) (setq buffer-undo-list nil) (run-hooks 'message-setup-hook) + ;; Do this last to give it precedence over posting styles, etc. + (when (message-mail-p) + (save-restriction + (message-narrow-to-headers) + (if message-alternative-emails + (message-use-alternative-email-as-from)))) (message-position-point) (undo-boundary)) @@ -6848,6 +6855,9 @@ regexp VARSTR." (read-string prompt initial-contents)))) (defun message-use-alternative-email-as-from () + "Set From field of the outgoing message to the first matching +address in `message-alternative-emails', looking at To, Cc and +From headers in the original article." (require 'mail-utils) (let* ((fields '("To" "Cc")) (emails @@ -6862,6 +6872,7 @@ regexp VARSTR." emails nil)) (pop emails)) (unless (or (not email) (equal email user-mail-address)) + (message-remove-header "From") (goto-char (point-max)) (insert "From: " email "\n")))) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index fa36582af01..eb5afa794f5 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -266,7 +266,7 @@ Return that buffer." (defun mm-uu-emacs-sources-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("application/emacs-lisp") + '("application/emacs-lisp" (charset . gnus-decoded)) nil nil (list mm-dissect-disposition (cons 'filename file-name)))) @@ -282,7 +282,7 @@ Return that buffer." (defun mm-uu-diff-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("text/x-patch"))) + '("text/x-patch" (charset . gnus-decoded)))) (defun mm-uu-diff-test () (and gnus-newsgroup-name @@ -509,31 +509,53 @@ value of `mm-uu-text-plain-type'." (setq result (cons "multipart/mixed" (nreverse result)))) result))) -(defun mm-uu-dissect-text-parts (handle) - "Dissect text parts and put uu handles into HANDLE." +;;;###autoload +(defun mm-uu-dissect-text-parts (handle &optional decoded) + "Dissect text parts and put uu handles into HANDLE. +Assume text has been decoded if DECODED is non-nil." (let ((buffer (mm-handle-buffer handle))) (cond ((stringp buffer) (dolist (elem (cdr handle)) - (mm-uu-dissect-text-parts elem))) + (mm-uu-dissect-text-parts elem decoded))) ((bufferp buffer) (let ((type (mm-handle-media-type handle)) (case-fold-search t) ;; string-match - encoding children) + children charset encoding) (when (and (stringp type) ;; Mutt still uses application/pgp even though ;; it has already been withdrawn. (string-match "\\`text/\\|\\`application/pgp\\'" type) - (setq children - (with-current-buffer buffer - (if (setq encoding (mm-handle-encoding handle)) - ;; Inherit the multibyteness of the `buffer'. - (with-temp-buffer - (insert-buffer-substring buffer) - (mm-decode-content-transfer-encoding - encoding type) - (mm-uu-dissect t (mm-handle-type handle))) - (mm-uu-dissect t (mm-handle-type handle)))))) + (setq + children + (with-current-buffer buffer + (cond + ((or decoded + (eq (setq charset (mail-content-type-get + (mm-handle-type handle) + 'charset)) + 'gnus-decoded)) + (setq decoded t) + (mm-uu-dissect + t (cons type '((charset . gnus-decoded))))) + (charset + (setq decoded t) + (mm-with-multibyte-buffer + (insert (mm-decode-string (mm-get-part handle) + charset)) + (mm-uu-dissect + t (cons type '((charset . gnus-decoded)))))) + ((setq encoding (mm-handle-encoding handle)) + (setq decoded nil) + ;; Inherit the multibyteness of the `buffer'. + (with-temp-buffer + (insert-buffer-substring buffer) + (mm-decode-content-transfer-encoding + encoding type) + (mm-uu-dissect t (list type)))) + (t + (setq decoded nil) + (mm-uu-dissect t (list type))))))) ;; Ignore it if a given part is dissected into a single ;; part of which the type is the same as the given one. (if (and (<= (length children) 2) @@ -544,10 +566,10 @@ value of `mm-uu-text-plain-type'." (setcdr handle (cdr children)) (setcar handle (car children)) ;; "multipart/mixed" (dolist (elem (cdr children)) - (mm-uu-dissect-text-parts elem)))))) + (mm-uu-dissect-text-parts elem decoded)))))) (t (dolist (elem handle) - (mm-uu-dissect-text-parts elem)))))) + (mm-uu-dissect-text-parts elem decoded)))))) (provide 'mm-uu) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index d3737cd66fd..4723a694182 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -1,7 +1,7 @@ ;;; nnweb.el --- retrieving articles via web search engines ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -27,11 +27,8 @@ ;; Note: You need to have `w3' installed for some functions to work. -;; FIXME: Due to changes in the HTML output of Google Groups and Gmane, stuff -;; related to web groups (gnus-group-make-web-group) doesn't work anymore. - -;; Fetching an article by MID (cf. gnus-refer-article-method) over Google -;; Groups should work. +;; FIXME: Due to changes in the HTML output of Gmane, stuff related to Gmane +;; web groups (`gnus-group-make-web-group') doesn't work anymore. ;;; Code: @@ -61,6 +58,7 @@ Valid types include `google', `dejanews', and `gmane'.") (defvar nnweb-type-definition '((google (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) @@ -69,8 +67,9 @@ Valid types include `google', `dejanews', and `gmane'.") (base . "http://groups.google.com") (identifier . nnweb-google-identity)) (dejanews ;; alias of google - (article . ignore) - (id . "http://groups.google.com/groups?selm=%s&output=gplain") + (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") + (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) @@ -100,7 +99,7 @@ Valid types include `google', `dejanews', and `gmane'.") (defvoo nnweb-articles nil) (defvoo nnweb-buffer nil) -(defvoo nnweb-group-alist nil) +(defvar nnweb-group-alist nil) (defvoo nnweb-group nil) (defvoo nnweb-hashtb nil) @@ -123,25 +122,19 @@ Valid types include `google', `dejanews', and `gmane'.") (deffoo nnweb-request-scan (&optional group server) (nnweb-possibly-change-server group server) (if nnweb-ephemeral-p - (setq nnweb-hashtb (gnus-make-hashtable 4095))) + (setq nnweb-hashtb (gnus-make-hashtable 4095)) + (unless nnweb-articles + (nnweb-read-overview group))) (funcall (nnweb-definition 'map)) (unless nnweb-ephemeral-p (nnweb-write-active) (nnweb-write-overview group))) (deffoo nnweb-request-group (group &optional server dont-check) - (nnweb-possibly-change-server nil server) - (when (and group - (not (equal group nnweb-group)) - (not nnweb-ephemeral-p)) - (setq nnweb-group group - nnweb-articles nil) - (let ((info (assoc group nnweb-group-alist))) - (when info - (setq nnweb-type (nth 2 info)) - (setq nnweb-search (nth 3 info)) - (unless dont-check - (nnweb-read-overview group))))) + (nnweb-possibly-change-server group server) + (unless (or nnweb-ephemeral-p + dont-check) + (nnweb-read-overview group)) (cond ((not nnweb-articles) (nnheader-report 'nnweb "No matching articles")) @@ -205,7 +198,7 @@ Valid types include `google', `dejanews', and `gmane'.") (nnweb-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) - (nnmail-generate-active nnweb-group-alist) + (nnmail-generate-active (list (assoc server nnweb-group-alist))) t)) (deffoo nnweb-request-update-info (group info &optional server) @@ -217,7 +210,7 @@ Valid types include `google', `dejanews', and `gmane'.") (deffoo nnweb-request-create-group (group &optional server args) (nnweb-possibly-change-server nil server) (nnweb-request-delete-group group) - (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist) + (push `(,group ,(cons 1 0)) nnweb-group-alist) (nnweb-write-active) t) @@ -287,18 +280,16 @@ Valid types include `google', `dejanews', and `gmane'.") def)) (defun nnweb-possibly-change-server (&optional group server) - (nnweb-init server) (when server (unless (nnweb-server-opened server) - (nnweb-open-server server))) + (nnweb-open-server server)) + (nnweb-init server)) (unless nnweb-group-alist (nnweb-read-active)) (unless nnweb-hashtb (setq nnweb-hashtb (gnus-make-hashtable 4095))) (when group - (when (and (not nnweb-ephemeral-p) - (equal group nnweb-group)) - (nnweb-request-group group nil t)))) + (setq nnweb-group group))) (defun nnweb-init (server) "Initialize buffers and such." @@ -337,22 +328,27 @@ Valid types include `google', `dejanews', and `gmane'.") (mm-url-decode-entities)))) (defun nnweb-google-parse-1 (&optional Message-ID) + "Parse search result in current buffer." (let ((i 0) (case-fold-search t) (active (cadr (assoc nnweb-group nnweb-group-alist))) Subject Score Date Newsgroups From map url mid) (unless active - (push (list nnweb-group (setq active (cons 1 0)) - nnweb-type nnweb-search) + (push (list nnweb-group (setq active (cons 1 0))) nnweb-group-alist)) ;; Go through all the article hits on this page. (goto-char (point-min)) - (while (re-search-forward - "a href=/groups\\(\\?[^ \">]*selm=\\([^ &\">]+\\)\\)" nil t) - (setq mid (match-string 2) + (while + (re-search-forward + "a +href=\"/group/\\([^>\"]+\\)/browse_thread/[^>]+#\\([0-9a-f]+\\)" + nil t) + (setq Newsgroups (match-string-no-properties 1) + ;; Note: Starting with Google Groups 2, `mid' is a Google-internal + ;; ID, not a proper Message-ID. + mid (match-string-no-properties 2) url (format - (nnweb-definition 'id) mid)) + (nnweb-definition 'result) Newsgroups mid)) (narrow-to-region (search-forward ">" nil t) (search-forward "" nil t)) (mm-url-remove-markup) @@ -360,25 +356,22 @@ Valid types include `google', `dejanews', and `gmane'.") (setq Subject (buffer-string)) (goto-char (point-max)) (widen) - (forward-line 2) - (when (looking-at "
]+>") - (goto-char (match-end 0))) - (if (not (looking-at "]+>")) - (skip-chars-forward " \t") - (narrow-to-region (point) - (search-forward "" nil t)) - (mm-url-remove-markup) - (mm-url-decode-entities) - (setq Newsgroups (buffer-string)) - (goto-char (point-max)) - (widen) - (skip-chars-forward "- \t")) + (narrow-to-region (point) + (search-forward "]+\\).*Next" nil t)) + "\"]+\\)\">= i nnweb-max-hits)) (setq more nil) ;; Yup, there are more articles @@ -443,7 +436,8 @@ Valid types include `google', `dejanews', and `gmane'.") ("hl" . "en") ("lr" . "") ("safe" . "off") - ("sites" . "groups"))))) + ("sites" . "groups") + ("filter" . "0"))))) t) (defun nnweb-google-identity (url) diff --git a/man/ChangeLog b/man/ChangeLog index 8fc41f40f11..e7c90d400bc 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,9 @@ +2006-01-31 Romain Francoise + + * message.texi (Message Headers): Explain what + `message-alternative-emails' does in more detail. + Update copyright year. + 2006-01-31 Richard M. Stallman * display.texi (Scrolling, Horizontal Scrolling, Follow Mode): diff --git a/man/message.texi b/man/message.texi index b2cd3aa782d..2cb2de02a8b 100644 --- a/man/message.texi +++ b/man/message.texi @@ -9,7 +9,7 @@ This file documents Message, the Emacs message composition mode. Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -1386,8 +1386,23 @@ trailing old subject. In this case, @item message-alternative-emails @vindex message-alternative-emails -A regexp to match the alternative email addresses. The first matched -address (not primary one) is used in the @code{From} field. +Regexp matching alternative email addresses. The first address in the +To, Cc or From headers of the original article matching this variable is +used as the From field of outgoing messages, replacing the default From +value. + +For example, if you have two secondary email addresses john@@home.net +and john.doe@@work.com and want to use them in the From field when +composing a reply to a message addressed to one of them, you could set +this variable like this: + +@lisp +(setq message-alternative-emails + (regexp-opt '("john@@home.net" "john.doe@@work.com"))) +@end lisp + +This variable has precedence over posting styles and anything that runs +off @code{message-setup-hook}. @item message-allow-no-recipients @vindex message-allow-no-recipients -- 2.39.2