;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar nnweb-type-definition
'((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)
(address . "http://groups.google.com/groups")
+ (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)
(address . "http://groups.google.com/groups")
+ (base . "http://groups.google.com")
(identifier . nnweb-google-identity))
(gmane
(article . nnweb-gmane-wash-article)
(reference . identity)
(map . nnweb-gmane-create-mapping)
(search . nnweb-gmane-search)
- (address . "http://gmane.org/")
+ (address . "http://search.gmane.org/nov.php")
(identifier . nnweb-gmane-identity)))
"Type-definition alist.")
(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
(nnweb-possibly-change-server group server)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(let (article header)
(mm-with-unibyte-current-buffer
(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)))))
+(deffoo nnweb-request-group (group &optional server dont-check info)
+ (nnweb-possibly-change-server group server)
+ (unless (or nnweb-ephemeral-p
+ dont-check
+ nnweb-articles)
+ (nnweb-read-overview group))
(cond
((not nnweb-articles)
(nnheader-report 'nnweb "No matching articles"))
(deffoo nnweb-close-group (group &optional server)
(nnweb-possibly-change-server group server)
(when (gnus-buffer-live-p nnweb-buffer)
- (save-excursion
- (set-buffer nnweb-buffer)
+ (with-current-buffer nnweb-buffer
(set-buffer-modified-p nil)
(kill-buffer nnweb-buffer)))
t)
(deffoo nnweb-request-article (article &optional group server buffer)
(nnweb-possibly-change-server group server)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
+ (with-current-buffer (or buffer nntp-server-buffer)
(let* ((header (cadr (assq article nnweb-articles)))
(url (and header (mail-header-xref header))))
(when (or (and url
(when (string-match "^<\\(.*\\)>$" article)
(setq art (match-string 1 article)))
(when (and fetch art)
- (setq url (format fetch art))
+ (setq url (format fetch
+ (mm-url-form-encode-xwfu art)))
(mm-with-unibyte-current-buffer
(mm-url-insert url))
(if (nnweb-definition 'reference t)
(deffoo nnweb-close-server (&optional server)
(when (and (nnweb-server-opened server)
(gnus-buffer-live-p nnweb-buffer))
- (save-excursion
- (set-buffer nnweb-buffer)
+ (with-current-buffer nnweb-buffer
(set-buffer-modified-p nil)
(kill-buffer nnweb-buffer)))
(nnoo-close-server 'nnweb server))
(deffoo nnweb-request-list (&optional server)
(nnweb-possibly-change-server nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (nnmail-generate-active nnweb-group-alist)
+ (with-current-buffer nntp-server-buffer
+ (nnmail-generate-active (list (assoc server nnweb-group-alist)))
t))
-(deffoo nnweb-request-update-info (group info &optional server)
- (nnweb-possibly-change-server group server))
+(deffoo nnweb-request-update-info (group info &optional server))
(deffoo nnweb-asynchronous-p ()
nil)
(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)
(deffoo nnweb-request-delete-group (group &optional force server)
(nnweb-possibly-change-server group server)
- (gnus-pull group nnweb-group-alist t)
+ (gnus-alist-pull group nnweb-group-alist t)
(nnweb-write-active)
(gnus-delete-file (nnweb-overview-file group))
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."
(unless (gnus-buffer-live-p nnweb-buffer)
(setq nnweb-buffer
- (save-excursion
- (mm-with-unibyte
- (nnheader-set-temp-buffer
- (format " *nnweb %s %s %s*"
- nnweb-type nnweb-search server))
- (current-buffer))))))
+ (save-current-buffer
+ (nnheader-set-temp-buffer
+ (format " *nnweb %s %s %s*"
+ nnweb-type nnweb-search server))
+ (mm-disable-multibyte)
+ (current-buffer)))))
;;;
-;;; Deja bought by google.com
+;;; groups.google.com
;;;
(defun nnweb-google-wash-article ()
- (let ((case-fold-search t) url)
- (goto-char (point-min))
- (re-search-forward "^<pre>" nil t)
- (narrow-to-region (point-min) (point))
- (search-backward "<table " nil t 2)
- (delete-region (point-min) (point))
- (if (re-search-forward "Search Result [0-9]+" nil t)
- (replace-match ""))
- (if (re-search-forward "View complete thread ([0-9]+ articles?)" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (search-forward "<br>" nil t)
- (replace-match "\n"))
- (mm-url-remove-markup)
+ ;; We have Google's masked e-mail addresses here. :-/
+ (let ((case-fold-search t)
+ (start-re "<pre>[\r\n ]*")
+ (end-re "[\r\n ]*</pre>"))
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*\n" nil t)
- (replace-match ""))
- (goto-char (point-max))
- (insert "\n")
- (widen)
- (narrow-to-region (point) (point-max))
- (search-forward "</pre>" nil t)
- (delete-region (point) (point-max))
- (mm-url-remove-markup)
- (widen)))
+ (if (save-excursion
+ (or (re-search-forward "The requested message.*could not be found."
+ nil t)
+ (not (and (re-search-forward start-re nil t)
+ (re-search-forward end-re nil t)))))
+ ;; FIXME: Don't know how to indicate "not found".
+ ;; Should this function throw an error? --rsteib
+ (progn
+ (gnus-message 3 "Requested article not found")
+ (erase-buffer))
+ (delete-region (point-min)
+ (re-search-forward start-re))
+ (goto-char (point-min))
+ (delete-region (progn
+ (re-search-forward end-re)
+ (match-beginning 0))
+ (point-max))
+ (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
- "http
projects / gnus / blobdiff