;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996-2012 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:
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
+;; Note: You need to have `w3' installed for some functions to work.
;;; Code:
(require 'gnus)
(require 'nnmail)
(require 'mm-util)
-(eval-when-compile
+(require 'mm-url)
+(eval-and-compile
(ignore-errors
- (require 'w3)
- (require 'url)
- (require 'w3-forms)))
-
-;; Report failure to find w3 at load time if appropriate.
-(unless noninteractive
- (eval '(progn
- (require 'w3)
- (require 'url)
- (require 'w3-forms))))
+ (require 'url)))
+(autoload 'w3-parse-buffer "w3-parse")
(nnoo-declare nnweb)
(defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
"Where nnweb will save its files.")
-(defvoo nnweb-type 'dejanews
+(defvoo nnweb-type 'google
"What search engine type is being used.
-Valid types include `dejanews', `dejanewsold', `reference',
-and `altavista'.")
+Valid types include `google', `dejanews', and `gmane'.")
(defvar nnweb-type-definition
- '((dejanews
- (article . ignore)
- (id . "http://search.dejanews.com/msgid.xp?MID=%s&fmt=text")
- (map . nnweb-dejanews-create-mapping)
- (search . nnweb-dejanews-search)
- (address . "http://www.deja.com/=dnc/qs.xp")
- (identifier . nnweb-dejanews-identity))
- (dejanewsold
- (article . ignore)
- (map . nnweb-dejanews-create-mapping)
- (search . nnweb-dejanewsold-search)
- (address . "http://www.deja.com/dnquery.xp")
- (identifier . nnweb-dejanews-identity))
- (reference
- (article . nnweb-reference-wash-article)
- (map . nnweb-reference-create-mapping)
- (search . nnweb-reference-search)
- (address . "http://www.reference.com/cgi-bin/pn/go")
- (identifier . identity))
- (altavista
- (article . nnweb-altavista-wash-article)
- (map . nnweb-altavista-create-mapping)
- (search . nnweb-altavista-search)
- (address . "http://www.altavista.digital.com/cgi-bin/query")
- (id . "/cgi-bin/news?id@%s")
- (identifier . identity)))
+ '((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)
+ (search . nnweb-google-search)
+ (address . "http://groups.google.com/groups")
+ (base . "http://groups.google.com")
+ (identifier . nnweb-google-identity))
+ (dejanews ;; alias of 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)
+ (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)
+ (id . "http://gmane.org/view.php?group=%s")
+ (reference . identity)
+ (map . nnweb-gmane-create-mapping)
+ (search . nnweb-gmane-search)
+ (address . "http://search.gmane.org/nov.php")
+ (identifier . nnweb-gmane-identity)))
"Type-definition alist.")
(defvoo nnweb-search nil
- "Search string to feed to DejaNews.")
+ "Search string to feed to Google.")
(defvoo nnweb-max-hits 999
"Maximum number of hits to display.")
(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))
+ (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))
- (let ((info (assoc group nnweb-group-alist)))
- (when info
- (setq nnweb-group group)
- (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
(mm-with-unibyte-current-buffer
- (nnweb-fetch-url url)))
+ (mm-url-insert url)))
(and (stringp article)
(nnweb-definition 'id t)
(let ((fetch (nnweb-definition 'id))
- art)
+ art active)
(when (string-match "^<\\(.*\\)>$" article)
(setq art (match-string 1 article)))
- (and fetch
- art
- (mm-with-unibyte-current-buffer
- (nnweb-fetch-url
- (format fetch article)))))))
+ (when (and 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)
+ (setq article
+ (funcall (nnweb-definition
+ 'reference) article)))))))
(unless nnheader-callback-function
- (funcall (nnweb-definition 'article))
- (nnweb-decode-entities))
+ (funcall (nnweb-definition 'article)))
(nnheader-report 'nnweb "Fetched article %s" article)
(cons group (and (numberp article) article))))))
(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 ()
- t)
+ 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)
- (not (equal group nnweb-group)))
- (setq nnweb-hashtb (gnus-make-hashtable 4095))
- (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))))))
-
-(defun nnweb-fetch-url (url)
- (let (buf)
- (save-excursion
- (if (not nnheader-callback-function)
- (progn
- (with-temp-buffer
- (mm-enable-multibyte)
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (default-process-coding-system 'binary))
- (nnweb-insert url))
- (setq buf (buffer-string)))
- (erase-buffer)
- (insert buf)
- t)
- (nnweb-url-retrieve-asynch
- url 'nnweb-callback (current-buffer) nnheader-callback-function)
- t))))
-
-(defun nnweb-callback (buffer callback)
- (when (gnus-buffer-live-p url-working-buffer)
- (save-excursion
- (set-buffer url-working-buffer)
- (funcall (nnweb-definition 'article))
- (nnweb-decode-entities)
- (set-buffer buffer)
- (goto-char (point-max))
- (insert-buffer-substring url-working-buffer))
- (funcall callback t)
- (gnus-kill-buffer url-working-buffer)))
-
-(defun nnweb-url-retrieve-asynch (url callback &rest data)
- (let ((url-request-method "GET")
- (old-a