+2006-01-31 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
+
+ * 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 <romain@orebokech.com>
+
+ * 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 <yamaoka@jpl.org>
+
+ * mm-uu.el (mm-uu-emacs-sources-extract): Say the part has been
+ decoded.
+ (mm-uu-diff-extract): Ditto.
+
+2006-01-31 Kevin Ryde <user42@zip.com.au>
+
+ * 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 <Reiner.Steib@gmx.de>
+
+ * nnweb.el (nnweb-google-parse-1): Clarify some comments.
+
+2006-01-30 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
+
+ * 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 <yamaoka@jpl.org>
+
+ * Makefile.in (clean): New rule.
+ (distclean): Use it.
+
2006-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
* 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 <user42@zip.com.au>
;;; 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 <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(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)))
(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)
(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
(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))
(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
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"))))
(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))))
(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
(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)
(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)
;;; 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 <larsi@gnus.org>
;; Keywords: news
;; 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:
(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)
(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)
(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)
(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"))
(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)
(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)
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."
(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 "</a>" nil t))
(mm-url-remove-markup)
(setq Subject (buffer-string))
(goto-char (point-max))
(widen)
- (forward-line 2)
- (when (looking-at "<br><font[^>]+>")
- (goto-char (match-end 0)))
- (if (not (looking-at "<a[^>]+>"))
- (skip-chars-forward " \t")
- (narrow-to-region (point)
- (search-forward "</a>" 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 "</td" nil t))
+
+ (mm-url-remove-markup)
+ (mm-url-decode-entities)
+ (search-backward " - ")
(when (looking-at
- "\\([0-9]+\\)[/ ]\\([A-Za-z]+\\)[/ ]\\([0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
+ " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?, [^\n]+by \\([^<\n]+\\)\n")
(setq From (match-string 4)
Date (format "%s %s 00:00:00 %s"
- (match-string 2) (match-string 1)
- (match-string 3))))
+ (match-string 1)
+ (match-string 2)
+ (or (match-string 3)
+ (substring (current-time-string) -4)))))
+
+ (widen)
(forward-line 1)
(incf i)
(unless (nnweb-get-hashtb url)
(goto-char (point-min))
(incf i 100)
(if (or (not (re-search-forward
- "<td nowrap><a href=\\([^>]+\\).*<span class=b>Next</span>" nil t))
+ "<td><a href=\"\n\\([^>\"]+\\)\"><img src=\"/img/nav_next" nil t))
(>= i nnweb-max-hits))
(setq more nil)
;; Yup, there are more articles
("hl" . "en")
("lr" . "")
("safe" . "off")
- ("sites" . "groups")))))
+ ("sites" . "groups")
+ ("filter" . "0")))))
t)
(defun nnweb-google-identity (url)
+2006-01-31 Romain Francoise <romain@orebokech.com>
+
+ * message.texi (Message Headers): Explain what
+ `message-alternative-emails' does in more detail.
+ Update copyright year.
+
2006-01-31 Richard M. Stallman <rms@gnu.org>
* display.texi (Scrolling, Horizontal Scrolling, Follow Mode):
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
@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
HCoop / bpt / emacs.git / commitdiff