2000-11-30 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / nnweb.el
index 611f8cc..e7aade1 100644 (file)
@@ -1,5 +1,6 @@
 ;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -59,16 +60,17 @@ and `altavista'.")
 
 (defvar nnweb-type-definition
   '((dejanews
-     (article . nnweb-dejanews-wash-article)
+     (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 . nnweb-dejanews-wash-article)
+     (article . ignore)
      (map . nnweb-dejanews-create-mapping)
      (search . nnweb-dejanewsold-search)
-     (address . "http://wwww.deja.com/dnquery.xp")
+     (address . "http://www.deja.com/dnquery.xp")
      (identifier . nnweb-dejanews-identity))
     (reference
      (article . nnweb-reference-wash-article)
@@ -112,14 +114,14 @@ and `altavista'.")
     (set-buffer nntp-server-buffer)
     (erase-buffer)
     (let (article header)
-      (while (setq article (pop articles))
-       (when (setq header (cadr (assq article nnweb-articles)))
-         (nnheader-insert-nov header)))
+      (mm-with-unibyte-current-buffer
+       (while (setq article (pop articles))
+         (when (setq header (cadr (assq article nnweb-articles)))
+           (nnheader-insert-nov header))))
       'nov)))
 
 (deffoo nnweb-request-scan (&optional group server)
   (nnweb-possibly-change-server group server)
-  (setq nnweb-hashtb (gnus-make-hashtable 4095))
   (funcall (nnweb-definition 'map))
   (unless nnweb-ephemeral-p
     (nnweb-write-active)
@@ -137,8 +139,6 @@ and `altavista'.")
        (setq nnweb-search (nth 3 info))
        (unless dont-check
          (nnweb-read-overview group)))))
-  (unless dont-check
-    (nnweb-request-scan group))
   (cond
    ((not nnweb-articles)
     (nnheader-report 'nnweb "No matching articles"))
@@ -168,7 +168,8 @@ and `altavista'.")
     (let* ((header (cadr (assq article nnweb-articles)))
           (url (and header (mail-header-xref header))))
       (when (or (and url
-                    (nnweb-fetch-url url))
+                    (mm-with-unibyte-current-buffer
+                      (nnweb-fetch-url url)))
                (and (stringp article)
                     (nnweb-definition 'id t)
                     (let ((fetch (nnweb-definition 'id))
@@ -177,13 +178,14 @@ and `altavista'.")
                         (setq art (match-string 1 article)))
                       (and fetch
                            art
-                           (nnweb-fetch-url
-                            (format fetch article))))))
+                           (mm-with-unibyte-current-buffer
+                             (nnweb-fetch-url
+                              (format fetch article)))))))
        (unless nnheader-callback-function
          (funcall (nnweb-definition 'article))
          (nnweb-decode-entities))
        (nnheader-report 'nnweb "Fetched article %s" article)
-       t))))
+       (cons group (and (numberp article) article))))))
 
 (deffoo nnweb-close-server (&optional server)
   (when (and (nnweb-server-opened server)
@@ -202,9 +204,7 @@ and `altavista'.")
     t))
 
 (deffoo nnweb-request-update-info (group info &optional server)
-  (nnweb-possibly-change-server group server)
-  ;;(setcar (cddr info) nil)
-  )
+  (nnweb-possibly-change-server group server))
 
 (deffoo nnweb-asynchronous-p ()
   t)
@@ -230,7 +230,7 @@ and `altavista'.")
 (defun nnweb-read-overview (group)
   "Read the overview of GROUP and build the map."
   (when (file-exists-p (nnweb-overview-file group))
-    (with-temp-buffer
+    (mm-with-unibyte-buffer
       (nnheader-insert-file-contents (nnweb-overview-file group))
       (goto-char (point-min))
       (let (header)
@@ -265,6 +265,7 @@ and `altavista'.")
 
 (defun nnweb-write-active ()
   "Save the active file."
+  (gnus-make-directory nnweb-directory)
   (with-temp-file (nnheader-concat nnweb-directory "active")
     (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
 
@@ -290,6 +291,7 @@ and `altavista'.")
   (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))))
 
 (defun nnweb-init (server)
@@ -297,22 +299,30 @@ and `altavista'.")
   (unless (gnus-buffer-live-p nnweb-buffer)
     (setq nnweb-buffer
          (save-excursion
-           (nnheader-set-temp-buffer
-            (format " *nnweb %s %s %s*" nnweb-type nnweb-search server))))))
+           (mm-with-unibyte
+             (nnheader-set-temp-buffer
+              (format " *nnweb %s %s %s*"
+                      nnweb-type nnweb-search server))
+             (current-buffer))))))
 
 (defun nnweb-fetch-url (url)
-  (save-excursion
-    (if (not nnheader-callback-function)
-       (let ((buf (current-buffer)))
-         (save-excursion
-           (set-buffer nnweb-buffer)
+  (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)
-           (url-insert-file-contents url)
-           (copy-to-buffer buf (point-min) (point-max))
-           t))
-      (nnweb-url-retrieve-asynch
-       url 'nnweb-callback (current-buffer) nnheader-callback-function)
-      t)))
+           (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)
@@ -338,9 +348,13 @@ and `altavista'.")
       (setq url-current-callback-data data
            url-be-asynchronous t
            url-current-callback-func callback)
-      (url-retrieve url))
+      (url-retrieve url nil))
     (setq-default url-be-asynchronous old-asynch)))
 
+(if (fboundp 'url-retrieve-synchronously)
+    (defun nnweb-url-retrieve-asynch (url callback &rest data)
+      (url-retrieve url callback data)))
+
 ;;;
 ;;; DejaNews functions.
 ;;;
@@ -356,51 +370,46 @@ and `altavista'.")
            (case-fold-search t)
            (active (or (cadr (assoc nnweb-group nnweb-group-alist))
                        (cons 1 0)))
-           Subject (Score "0") Date Newsgroup Author
-           map url)
+           subject date from
+           map url parse a table group text)
        (while more
          ;; Go through all the article hits on this page.
          (goto-char (point-min))
-         (nnweb-decode-entities)
-         (goto-char (point-min))
-         (while (re-search-forward "^ <P>\n" nil t)
-           (narrow-to-region
-            (point)
-            (cond ((re-search-forward "^ <P>\n" nil t)
-                   (match-beginning 0))
-                  ((search-forward "\n\n" nil t)
-                   (point))
-                  (t
-                   (point-max))))
-           (goto-char (point-min))
-           (looking-at ".*HREF=\"\\([^\"]+\\)\"\\(.*\\)")
-           (setq url (match-string 1))
-           (let ((begin (point)))
-             (nnweb-remove-markup)
-             (goto-char begin)
-             (while (search-forward "\t" nil t)
-               (replace-match " "))
-             (goto-char begin)
-             (end-of-line)
-             (setq Subject (buffer-substring begin (point)))
-             (if (re-search-forward
-                  "^ Newsgroup: \\(.*\\)\n Posted on \\([0-9/]+\\) by \\(.*\\)$" nil t)
-                 (setq Newsgroup (match-string 1)
-                       Date (match-string 2)
-                       Author (match-string 3))))
-           (widen)
-           (incf i)
-           (unless (nnweb-get-hashtb url)
-             (push
-              (list
-               (incf (cdr active))
-               (make-full-mail-header
-                (cdr active) Subject Author Date
-                (concat "<" (nnweb-identifier url) "@dejanews>")
-                nil 0 (string-to-int Score) url))
-              map)
-             (nnweb-set-hashtb (cadar map) (car map))))
+         (setq parse (w3-parse-buffer (current-buffer))
+               table (nth 1 (nnweb-parse-find-all 'table parse)))
+         (dolist (row (nth 2 (car (nth 2 table))))
+           (setq a (nnweb-parse-find 'a row)
+                 url (cdr (assq 'href (nth 1 a)))
+                 text (nreverse (nnweb-text row)))
+           (when a
+             (setq subject (nth 4 text)
+                   group (nth 2 text)
+                   date (nth 1 text)
+                   from (nth 0 text))
+             (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
+                 (setq date (format "%s %s 00:00:00 %s"
+                                    (car (rassq (string-to-number
+                                                 (match-string 2 date))
+                                                parse-time-months))
+                                    (match-string 3 date) 
+                                    (match-string 1 date)))
+               (setq date "Jan 1 00:00:00 0000"))
+             (incf i)
+             (setq url (concat url "&fmt=text"))
+             (when (string-match "&context=[^&]+" url)
+               (setq url (replace-match "" t t url)))
+             (unless (nnweb-get-hashtb url)
+               (push
+                (list
+                 (incf (cdr active))
+                 (make-full-mail-header
+                  (cdr active) (concat subject " (" group ")") from date
+                  (concat "<" (nnweb-identifier url) "@dejanews>")
+                  nil 0 0 url))
+                map)
+               (nnweb-set-hashtb (cadar map) (car map)))))
          ;; See whether there is a "Get next 20 hits" button here.
+         (goto-char (point-min))
          (if (or (not (re-search-forward
                        "HREF=\"\\([^\"]+\\)\"[<>b]+Next result" nil t))
                  (>= i nnweb-max-hits))
@@ -413,27 +422,6 @@ and `altavista'.")
        (setq nnweb-articles
              (sort (nconc nnweb-articles map) 'car-less-than-car))))))
 
-(defun nnweb-dejanews-wash-article ()
-  (let ((case-fold-search t))
-    (goto-char (point-min))
-    (re-search-forward "<PRE>" nil t)
-    (delete-region (point-min) (point))
-    (re-search-forward "</PRE>" nil t)
-    (delete-region (point) (point-max))
-    (nnweb-remove-markup)
-    (goto-char (point-min))
-    (while (and (looking-at " *$")
-               (not (eobp)))
-      (gnus-delete-line))
-    (while (looking-at "\\(^[^ ]+:\\) *")
-      (replace-match "\\1 " t)
-      (forward-line 1))
-    (when (re-search-forward "\n\n+" nil t)
-      (replace-match "\n" t t))
-    (goto-char (point-min))
-    (when (search-forward "[More Headers]" nil t)
-      (replace-match "" t t))))
-
 (defun nnweb-dejanews-search (search)
   (nnweb-insert
    (concat
@@ -471,7 +459,7 @@ and `altavista'.")
 
 (defun nnweb-dejanews-identity (url)
   "Return an unique identifier based on URL."
-  (if (string-match "recnum=\\([0-9]+\\)" url)
+  (if (string-match "AN=\\([0-9]+\\)" url)
       (match-string 1 url)
     url))
 
@@ -497,7 +485,6 @@ and `altavista'.")
          (goto-char (point-min))
          (search-forward "</pre><hr>" nil t)
          (delete-region (point-min) (point))
-                                       ;(nnweb-decode-entities)
          (goto-char (point-min))
          (while (re-search-forward "^ +[0-9]+\\." nil t)
            (narrow-to-region
@@ -725,7 +712,7 @@ and `altavista'.")
    pairs "&"))
 
 (defun nnweb-fetch-form (url pairs)
-  "Fetch a form from URL with PAIRS as the data."
+  "Fetch a form from URL with PAIRS as the data using the POST method."
   (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
        (url-request-method "POST")
        (url-request-extra-headers
@@ -737,11 +724,24 @@ and `altavista'.")
 (defun nnweb-decode-entities ()
   "Decode all HTML entities."
   (goto-char (point-min))
-  (while (re-search-forward "&\\([a-z]+\\);" nil t)
-    (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
-                                                 w3-html-entities))
-                                      ?#))
-                  t t)))
+  (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
+    (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
+                       (let ((c
+                              (string-to-number (substring 
+                                                 (match-string 1) 1))))
+                         (if (mm-char-or-char-int-p c) c 32))
+                     (or (cdr (assq (intern (match-string 1))
+                                    w3-html-entities))
+                         ?#))))
+      (unless (stringp elem)
+       (setq elem (char-to-string elem)))
+      (replace-match elem t t))))
+
+(defun nnweb-decode-entities-string (string)
+  (with-temp-buffer
+    (insert string)
+    (nnweb-decode-entities)
+    (buffer-substring (point-min) (point-max))))
 
 (defun nnweb-remove-markup ()
   "Remove all HTML markup, leaving just plain text."
@@ -754,10 +754,21 @@ and `altavista'.")
   (while (re-search-forward "<[^>]+>" nil t)
     (replace-match "" t t)))
 
-(defun nnweb-insert (url)
-  "Insert the contents from an URL in the current buffer."
+(defun nnweb-insert (url &optional follow-refresh)
+  "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))
-    (url-insert-file-contents url)
+    (if follow-refresh
+       (save-restriction
+         (narrow-to-region (point) (point))
+         (url-insert-file-contents url)
+         (goto-char (point-min))
+         (when (re-search-forward 
+                "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t)
+           (let ((url (match-string 1)))
+             (delete-region (point-min) (point-max))
+             (nnweb-insert url t))))
+      (url-insert-file-contents url))
     (setq buffer-file-name name)))
 
 (defun nnweb-parse-find (type parse &optional maxdepth)
@@ -809,6 +820,11 @@ and `altavista'.")
                 (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