Split -request-update-info into -request-marks and -update-info.
[gnus] / lisp / nnweb.el
index 2f99d9d..1cfa7a4 100644 (file)
@@ -1,17 +1,17 @@
 ;;; nnweb.el --- retrieving articles via web search engines
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006 Free Software Foundation, Inc.
+;;   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
@@ -19,9 +19,7 @@
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -106,8 +104,7 @@ Valid types include `google', `dejanews', and `gmane'.")
 
 (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
@@ -127,7 +124,7 @@ Valid types include `google', `dejanews', and `gmane'.")
     (nnweb-write-active)
     (nnweb-write-overview group)))
 
-(deffoo nnweb-request-group (group &optional server dont-check)
+(deffoo nnweb-request-group (group &optional server dont-check info)
   (nnweb-possibly-change-server group server)
   (unless (or nnweb-ephemeral-p
              dont-check
@@ -149,16 +146,14 @@ Valid types include `google', `dejanews', and `gmane'.")
 (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
@@ -187,21 +182,18 @@ Valid types include `google', `dejanews', and `gmane'.")
 (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)
+  (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)
@@ -294,12 +286,12 @@ Valid types include `google', `dejanews', and `gmane'.")
   "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)))))
 
 ;;;
 ;;; groups.google.com
@@ -360,22 +352,24 @@ Valid types include `google', `dejanews', and `gmane'.")
       (goto-char (point-max))
       (widen)
       (narrow-to-region (point)
-                       (search-forward "</td" nil t))
+                       (search-forward "</table" nil t))
 
       (mm-url-remove-markup)
       (mm-url-decode-entities)
-      (search-backward " - ")
-      (when (looking-at
-            " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?[^\n]+by ?\n?\\([^<\n]+\\)\n")
-       (setq From (match-string 4)
-             Date (format "%s %s 00:00:00 %s"
-                          (match-string 1)
-                          (match-string 2)
-                          (or (match-string 3)
-                              (substring (current-time-string) -4)))))
-
+      (goto-char (point-max))
+      (when
+         (re-search-backward
+          "^\\(?:\\(\\w+\\) \\([0-9]+\\)\\|\\S-+\\)\\(?: \\([0-9]\\{4\\}\\)\\)? by ?\\(.*\\)"
+          nil t)
+       (setq Date (if (match-string 1)
+                      (format "%s %s 00:00:00 %s"
+                              (match-string 1)
+                              (match-string 2)
+                              (or (match-string 3)
+                                  (substring (current-time-string) -4)))
+                    (current-time-string)))
+       (setq From (match-string 4)))
       (widen)
-      (forward-line 1)
       (incf i)
       (unless (nnweb-get-hashtb url)
        (push
@@ -402,8 +396,7 @@ Valid types include `google', `dejanews', and `gmane'.")
 
 (defun nnweb-google-create-mapping ()
   "Perform the search and create a number-to-url alist."
-  (save-excursion
-    (set-buffer nnweb-buffer)
+  (with-current-buffer nnweb-buffer
     (erase-buffer)
     (nnheader-message 7 "Searching google...")
     (when (funcall (nnweb-definition 'search) nnweb-search)
@@ -416,7 +409,7 @@ Valid types include `google', `dejanews', and `gmane'.")
            (goto-char (point-min))
            (incf i 100)
            (if (or (not (re-search-forward
-                         "<a href=\"\n\\([^>\" \n\t]+\\)[^<]*<img src=[^>]+next"
+                         "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next"
                          nil t))
                    (>= i nnweb-max-hits))
                (setq more nil)
@@ -459,8 +452,7 @@ Valid types include `google', `dejanews', and `gmane'.")
 ;;;
 (defun nnweb-gmane-create-mapping ()
   "Perform the search and create a number-to-url alist."
-  (save-excursion
-    (set-buffer nnweb-buffer)
+  (with-current-buffer nnweb-buffer
     (let ((case-fold-search t)
          (active (or (cadr (assoc nnweb-group nnweb-group-alist))
                      (cons 1 0)))
@@ -479,7 +471,7 @@ Valid types include `google', `dejanews', and `gmane'.")
                    (from (mail-header-from header))
                    (subject (mail-header-subject header))
                    (rfc2047-encoding-type 'mime))
-               (when (string-match " \\([^:]+\\):\\([0-9]+\\)" xref)
+               (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
                  (mail-header-set-xref
                   header
                   (format "http://article.gmane.org/%s/%s/raw"
@@ -495,11 +487,8 @@ Valid types include `google', `dejanews', and `gmane'.")
                                         (rfc2047-encode-string subject))
 
                (unless (nnweb-get-hashtb (mail-header-xref header))
-                 (push
-                  (list
-                   (incf (cdr active))
-                   header)
-                  map)
+                 (mail-header-set-number header (incf (cdr active)))
+                 (push (list (mail-header-number header) header) map)
                  (nnweb-set-hashtb (cadar map) (car map))))))
          (forward-line 1)))
       (nnheader-message 7 "Searching Gmane...done")
@@ -524,9 +513,11 @@ Valid types include `google', `dejanews', and `gmane'.")
     "?"
     (mm-url-encode-www-form-urlencoded
      `(("query" . ,search)
-       ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))))))
+       ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))
+       ;;("TOPDOC" . "1000")
+       ))))
   (setq buffer-file-name nil)
-  (set-buffer-multibyte t)
+  (unless (featurep 'xemacs) (set-buffer-multibyte t))
   (mm-decode-coding-region (point-min) (point-max) 'utf-8)
   t)
 
@@ -543,7 +534,11 @@ Valid types include `google', `dejanews', and `gmane'.")
 (defun nnweb-insert-html (parse)
   "Insert HTML based on a w3 parse tree."
   (if (stringp parse)
-      (insert (nnheader-string-as-multibyte parse))
+      ;; We used to call nnheader-string-as-multibyte here, but it cannot
+      ;; be right, so I removed it.  If a bug shows up because of this change,
+      ;; please do not blindly revert the change, but help me find the real
+      ;; cause of the bug instead.  --Stef
+      (insert parse)
     (insert "<" (symbol-name (car parse)) " ")
     (insert (mapconcat
             (lambda (param)
@@ -609,5 +604,4 @@ Valid types include `google', `dejanews', and `gmane'.")
 
 (provide 'nnweb)
 
-;;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697
 ;;; nnweb.el ends here