2001-12-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / nnweb.el
index c79f9f5..277e24e 100644 (file)
 (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',
+Valid types include `google', `dejanews', `dejanewsold', `reference',
 and `altavista'.")
 
 (defvar nnweb-type-definition
   '(
-    (dejanews ;; bought by google.com
-     (article . nnweb-google-wash-article)
-     (id . "http://groups.google.com/groups?as_umsgid=%s")
+    (google
+     ;;(article . nnweb-google-wash-article)
+     ;;(id . "http://groups.google.com/groups?as_umsgid=%s")
+     (article . ignore)
+     (id . "http://groups.google.com/groups?selm=%s&output=gplain")
+     ;;(reference . nnweb-google-reference)
+     (reference . identity)
+     (map . nnweb-google-create-mapping)
+     (search . nnweb-google-search)
+     (address . "http://groups.google.com/groups")
+     (identifier . nnweb-google-identity))
+    (dejanews ;; alias of google
+     ;;(article . nnweb-google-wash-article)
+     ;;(id . "http://groups.google.com/groups?as_umsgid=%s")
+     (article . ignore)
+     (id . "http://groups.google.com/groups?selm=%s&output=gplain")
+     ;;(reference . nnweb-google-reference)
+     (reference . identity)
      (map . nnweb-google-create-mapping)
      (search . nnweb-google-search)
      (address . "http://groups.google.com/groups")
@@ -132,6 +147,8 @@ and `altavista'.")
 
 (deffoo nnweb-request-scan (&optional group server)
   (nnweb-possibly-change-server group server)
+  (if nnweb-ephemeral-p
+      (setq nnweb-hashtb (gnus-make-hashtable 4095)))
   (funcall (nnweb-definition 'map))
   (unless nnweb-ephemeral-p
     (nnweb-write-active)
@@ -142,9 +159,10 @@ and `altavista'.")
   (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-group group)
        (setq nnweb-type (nth 2 info))
        (setq nnweb-search (nth 3 info))
        (unless dont-check
@@ -183,17 +201,19 @@ and `altavista'.")
                (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 art))
+                        (mm-with-unibyte-current-buffer
+                          (nnweb-fetch-url 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))))))
 
@@ -298,10 +318,11 @@ and `altavista'.")
       (nnweb-open-server 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))
+              (equal group nnweb-group))
       (nnweb-request-group group nil t))))
 
 (defun nnweb-init (server)
@@ -567,6 +588,7 @@ and `altavista'.")
        (while (search-forward "," nil t)
          (replace-match " " t t)))
       (widen)
+      (nnweb-decode-entities)
       (set-marker body nil))))
 
 (defun nnweb-reference-search (search)
@@ -671,7 +693,8 @@ and `altavista'.")
       (while (re-search-forward "<A.*\\?id@\\([^\"]+\\)\">[0-9]+</A>" nil t)
        (replace-match "&lt;\\1&gt; " t)))
     (widen)
-    (nnweb-remove-markup)))
+    (nnweb-remove-markup)
+    (nnweb-decode-entities)))
 
 (defun nnweb-altavista-search (search &optional part)
   (url-insert-file-contents
@@ -695,19 +718,21 @@ and `altavista'.")
 ;;;
 
 (defun nnweb-google-wash-article ()
(let ((case-fold-search t))
 (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)
+    (search-backward "<table " nil t 2)
     (delete-region (point-min) (point))
-    (if (search-forward "[view thread]" nil t)
+    (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"))
     (nnweb-remove-markup)
-    (nnweb-decode-entities)
+    (goto-char (point-min))
     (while (re-search-forward "^[ \t]*\n" nil t)
       (replace-match ""))
     (goto-char (point-max))
@@ -717,73 +742,89 @@ and `altavista'.")
     (search-forward "</pre>" nil t)
     (delete-region (point) (point-max))
     (nnweb-remove-markup)
-    (nnweb-decode-entities)
     (widen)))
 
+(defun nnweb-google-parse-1 (&optional Message-ID)
+  (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)
+           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)
+           url (format 
+                "http://groups.google.com/groups?selm=%s&output=gplain" mid))
+      (narrow-to-region (search-forward ">" nil t)
+                       (search-forward "</a>" nil t))
+      (nnweb-remove-markup)
+      (nnweb-decode-entities)
+      (setq Subject (buffer-string))
+      (goto-char (point-max))
+      (widen)
+      (forward-line 1)
+      (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))
+       (nnweb-remove-markup)
+       (nnweb-decode-entities)
+       (setq Newsgroups (buffer-string))
+       (goto-char (point-max))
+       (widen)
+       (skip-chars-forward "- \t"))
+      (when (looking-at
+            "\\([0-9]+[/ ][A-Za-z]+[/ ][0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
+       (setq From (match-string 2)
+             Date (match-string 1)))
+      (forward-line 1)
+      (incf i)
+      (unless (nnweb-get-hashtb url)
+       (push
+        (list
+         (incf (cdr active))
+         (make-full-mail-header
+          (cdr active) (if Newsgroups
+                           (concat  "(" Newsgroups ") " Subject)
+                         Subject)
+          From Date (or Message-ID mid)
+          nil 0 0 url))
+        map)
+       (nnweb-set-hashtb (cadar map) (car map))))
+    map))
+
+(defun nnweb-google-reference (id)
+  (let ((map (nnweb-google-parse-1 id)) header)
+    (setq nnweb-articles
+         (nconc nnweb-articles map))
+    (when (setq header (cadar map))
+      (mm-with-unibyte-current-buffer
+       (nnweb-fetch-url (mail-header-xref header)))
+      (caar map))))
+
 (defun nnweb-google-create-mapping ()
   "Perform the search and create an number-to-url alist."
   (save-excursion
     (set-buffer nnweb-buffer)
     (erase-buffer)
     (when (funcall (nnweb-definition 'search) nnweb-search)
-      (let ((i 0)
-           (more t)
-           (case-fold-search t)
-           (active (or (cadr (assoc nnweb-group nnweb-group-alist))
-                       (cons 1 0)))
-           Subject Score Date Newsgroups From Message-ID
-           map url)
-       (while more
-         ;; Go through all the article hits on this page.
-         (goto-char (point-min))
-         (while (re-search-forward
-                 "a href=/groups\\(\\?[^ \">]*seld=[0-9]+[^ \">]*\\)" nil t)
-           (setq url
-                 (concat (nnweb-definition 'address)
-                         (match-string 1)))
-           (narrow-to-region (search-forward ">" nil t)
-                             (search-forward "</a>" nil t))
-           (nnweb-remove-markup)
-           (nnweb-decode-entities)
-           (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))
-             (nnweb-remove-markup)
-             (nnweb-decode-entities)
-             (setq Newsgroups (buffer-string))
-             (goto-char (point-max))
-             (widen)
-             (skip-chars-forward "- \t"))
-           (when (looking-at 
-                  "\\([0-9]+/[A-Za-z]+/[0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
-             (setq From (match-string 2)
-                   Date (match-string 1)))
-           (forward-line 1)
-           (incf i)
-           (unless (nnweb-get-hashtb url)
-             (push
-              (list
-               (incf (cdr active))
-               (make-full-mail-header
-                (cdr active) (if Newsgroups
-                                 (concat  "(" Newsgroups ") " Subject) 
-                               Subject)
-                From Date Message-ID
-                nil 0 0 url))
-              map)
-             (nnweb-set-hashtb (cadar map) (car map))))
-         ;; FIXME: There is more.
-         (setq more nil))
-       ;; Return the articles in the right order.
-       (setq nnweb-articles
-             (sort (nconc nnweb-articles map) 'car-less-than-car))))))
+       (let ((more t))
+         (while more
+           (setq nnweb-articles
+                 (nconc nnweb-articles (nnweb-google-parse-1)))
+           ;; FIXME: There is more.
+           (setq more nil))
+         ;; Return the articles in the right order.
+         (setq nnweb-articles
+               (sort nnweb-articles 'car-less-than-car))))))
 
 (defun nnweb-google-search (search)
   (nnweb-insert
@@ -802,7 +843,7 @@ and `altavista'.")
 
 (defun nnweb-google-identity (url)
   "Return an unique identifier based on URL."
-  (if (string-match "seld=\\([0-9]+\\)" url)
+  (if (string-match "selm=\\([^ &>]+\\)" url)
       (match-string 1 url)
     url))
 
@@ -884,7 +925,7 @@ and `altavista'.")
   "Insert the contents from an URL in the current buffer.
 If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
   (let ((name buffer-file-name))
-    (if follow-refresh
+    (if follow-refresh 
        (save-restriction
          (narrow-to-region (point) (point))
          (url-insert-file-contents url)
@@ -946,11 +987,6 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
                 (listp (cdr element)))
        (nnweb-text-1 element)))))
 
-(defun nnweb-replace-in-string (string match newtext)
-  (while (string-match match string)
-    (setq string (replace-match newtext t t string)))
-  string)
-
 (provide 'nnweb)
 
 ;;; nnweb.el ends here