/[emacs]/emacs/lisp/gnus/nnweb.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nnweb.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9.4.2 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.9.4.3 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; nnweb.el --- retrieving articles via web search engines  ;;; nnweb.el --- retrieving articles via web search engines
2  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
3  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 24  Line 24 
24    
25  ;;; Commentary:  ;;; Commentary:
26    
27  ;; Note: You need to have `url' and `w3' installed for this  ;; Note: You need to have `w3' installed for some functions to work.
 ;; backend to work.  
28    
29  ;;; Code:  ;;; Code:
30    
# Line 37  Line 36 
36  (require 'gnus)  (require 'gnus)
37  (require 'nnmail)  (require 'nnmail)
38  (require 'mm-util)  (require 'mm-util)
39  (eval-when-compile  (require 'mm-url)
40    (eval-and-compile
41    (ignore-errors    (ignore-errors
42      (require 'w3)      (require 'url)))
43      (require 'url)  (autoload 'w3-parse-buffer "w3-parse")
     (require 'w3-forms)))  
   
 ;; Report failure to find w3 at load time if appropriate.  
 (unless noninteractive  
   (eval '(progn  
            (require 'w3)  
            (require 'url)  
            (require 'w3-forms))))  
44    
45  (nnoo-declare nnweb)  (nnoo-declare nnweb)
46    
# Line 57  Line 49 
49    
50  (defvoo nnweb-type 'google  (defvoo nnweb-type 'google
51    "What search engine type is being used.    "What search engine type is being used.
52  Valid types include `google', `dejanews', `dejanewsold', `reference',  Valid types include `google', `dejanews', and `gmane'.")
 and `altavista'.")  
53    
54  (defvar nnweb-type-definition  (defvar nnweb-type-definition
55    '(    '((google
     (google  
      ;;(article . nnweb-google-wash-article)  
      ;;(id . "http://groups.google.com/groups?as_umsgid=%s")  
56       (article . ignore)       (article . ignore)
57       (id . "http://groups.google.com/groups?selm=%s&output=gplain")       (id . "http://groups.google.com/groups?selm=%s&output=gplain")
      ;;(reference . nnweb-google-reference)  
58       (reference . identity)       (reference . identity)
59       (map . nnweb-google-create-mapping)       (map . nnweb-google-create-mapping)
60       (search . nnweb-google-search)       (search . nnweb-google-search)
61       (address . "http://groups.google.com/groups")       (address . "http://groups.google.com/groups")
62       (identifier . nnweb-google-identity))       (identifier . nnweb-google-identity))
63      (dejanews ;; alias of google      (dejanews ;; alias of google
      ;;(article . nnweb-google-wash-article)  
      ;;(id . "http://groups.google.com/groups?as_umsgid=%s")  
64       (article . ignore)       (article . ignore)
65       (id . "http://groups.google.com/groups?selm=%s&output=gplain")       (id . "http://groups.google.com/groups?selm=%s&output=gplain")
      ;;(reference . nnweb-google-reference)  
66       (reference . identity)       (reference . identity)
67       (map . nnweb-google-create-mapping)       (map . nnweb-google-create-mapping)
68       (search . nnweb-google-search)       (search . nnweb-google-search)
69       (address . "http://groups.google.com/groups")       (address . "http://groups.google.com/groups")
70       (identifier . nnweb-google-identity))       (identifier . nnweb-google-identity))
71  ;;;     (dejanews      (gmane
72  ;;;      (article . ignore)       (article . nnweb-gmane-wash-article)
73  ;;;      (id . "http://search.dejanews.com/msgid.xp?MID=%s&fmt=text")       (id . "http://gmane.org/view.php?group=%s")
74  ;;;      (map . nnweb-dejanews-create-mapping)       (reference . identity)
75  ;;;      (search . nnweb-dejanews-search)       (map . nnweb-gmane-create-mapping)
76  ;;;      (address . "http://www.deja.com/=dnc/qs.xp")       (search . nnweb-gmane-search)
77  ;;;      (identifier . nnweb-dejanews-identity))       (address . "http://gmane.org/")
78  ;;;     (dejanewsold       (identifier . nnweb-gmane-identity)))
 ;;;      (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)))  
79    "Type-definition alist.")    "Type-definition alist.")
80    
81  (defvoo nnweb-search nil  (defvoo nnweb-search nil
82    "Search string to feed to DejaNews.")    "Search string to feed to Google.")
83    
84  (defvoo nnweb-max-hits 999  (defvoo nnweb-max-hits 999
85    "Maximum number of hits to display.")    "Maximum number of hits to display.")
# Line 197  and `altavista'.") Line 163  and `altavista'.")
163             (url (and header (mail-header-xref header))))             (url (and header (mail-header-xref header))))
164        (when (or (and url        (when (or (and url
165                       (mm-with-unibyte-current-buffer                       (mm-with-unibyte-current-buffer
166                         (nnweb-fetch-url url)))                         (mm-url-insert url)))
167                  (and (stringp article)                  (and (stringp article)
168                       (nnweb-definition 'id t)                       (nnweb-definition 'id t)
169                       (let ((fetch (nnweb-definition 'id))                       (let ((fetch (nnweb-definition 'id))
# Line 207  and `altavista'.") Line 173  and `altavista'.")
173                         (when (and fetch art)                         (when (and fetch art)
174                           (setq url (format fetch art))                           (setq url (format fetch art))
175                           (mm-with-unibyte-current-buffer                           (mm-with-unibyte-current-buffer
176                             (nnweb-fetch-url url))                             (mm-url-insert url))
177                           (if (nnweb-definition 'reference t)                           (if (nnweb-definition 'reference t)
178                               (setq article                               (setq article
179                                     (funcall (nnweb-definition                                     (funcall (nnweb-definition
# Line 237  and `altavista'.") Line 203  and `altavista'.")
203    (nnweb-possibly-change-server group server))    (nnweb-possibly-change-server group server))
204    
205  (deffoo nnweb-asynchronous-p ()  (deffoo nnweb-asynchronous-p ()
206    t)    nil)
207    
208  (deffoo nnweb-request-create-group (group &optional server args)  (deffoo nnweb-request-create-group (group &optional server args)
209    (nnweb-possibly-change-server nil server)    (nnweb-possibly-change-server nil server)
# Line 336  and `altavista'.") Line 302  and `altavista'.")
302                         nnweb-type nnweb-search server))                         nnweb-type nnweb-search server))
303                (current-buffer))))))                (current-buffer))))))
304    
 (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-asynch url-be-asynchronous)  
         (url-request-data nil)  
         (url-request-extra-headers nil)  
         (url-working-buffer (generate-new-buffer-name " *nnweb*")))  
     (setq-default url-be-asynchronous t)  
     (save-excursion  
       (set-buffer (get-buffer-create url-working-buffer))  
       (setq url-current-callback-data data  
             url-be-asynchronous t  
             url-current-callback-func callback)  
       (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.  
 ;;;  
   
 (defun nnweb-dejanews-create-mapping ()  
   "Perform the search and create a 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 date from  
             map url parse a table group text)  
         (while more  
           ;; Go through all the article hits on this page.  
           (goto-char (point-min))  
           (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))  
               (setq more nil)  
             ;; Yup -- fetch it.  
             (setq more (match-string 1))  
             (erase-buffer)  
             (url-insert-file-contents more)))  
         ;; Return the articles in the right order.  
         (setq nnweb-articles  
               (sort (nconc nnweb-articles map) 'car-less-than-car))))))  
   
 (defun nnweb-dejanews-search (search)  
   (nnweb-insert  
    (concat  
     (nnweb-definition 'address)  
     "?"  
     (nnweb-encode-www-form-urlencoded  
      `(("ST" . "PS")  
        ("svcclass" . "dnyr")  
        ("QRY" . ,search)  
        ("defaultOp" . "AND")  
        ("DBS" . "1")  
        ("OP" . "dnquery.xp")  
        ("LNG" . "ALL")  
        ("maxhits" . "100")  
        ("threaded" . "0")  
        ("format" . "verbose2")  
        ("showsort" . "date")  
        ("agesign" . "1")  
        ("ageweight" . "1")))))  
   t)  
   
 (defun nnweb-dejanewsold-search (search)  
   (nnweb-fetch-form  
    (nnweb-definition 'address)  
    `(("query" . ,search)  
      ("defaultOp" . "AND")  
      ("svcclass" . "dnold")  
      ("maxhits" . "100")  
      ("format" . "verbose2")  
      ("threaded" . "0")  
      ("showsort" . "date")  
      ("agesign" . "1")  
      ("ageweight" . "1")))  
   t)  
   
 (defun nnweb-dejanews-identity (url)  
   "Return an unique identifier based on URL."  
   (if (string-match "AN=\\([0-9]+\\)" url)  
       (match-string 1 url)  
     url))  
   
 ;;;  
 ;;; InReference  
 ;;;  
   
 (defun nnweb-reference-create-mapping ()  
   "Perform the search and create a 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))  
           (search-forward "</pre><hr>" nil t)  
           (delete-region (point-min) (point))  
           (goto-char (point-min))  
           (while (re-search-forward "^ +[0-9]+\\." nil t)  
             (narrow-to-region  
              (point)  
              (if (re-search-forward "^$" nil t)  
                  (match-beginning 0)  
                (point-max)))  
             (goto-char (point-min))  
             (when (looking-at ".*href=\"\\([^\"]+\\)\"")  
               (setq url (match-string 1)))  
             (nnweb-remove-markup)  
             (goto-char (point-min))  
             (while (search-forward "\t" nil t)  
               (replace-match " "))  
             (goto-char (point-min))  
             (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t)  
               (set (intern (match-string 1)) (match-string 2)))  
             (widen)  
             (search-forward "</pre>" nil t)  
             (incf i)  
             (unless (nnweb-get-hashtb url)  
               (push  
                (list  
                 (incf (cdr active))  
                 (make-full-mail-header  
                  (cdr active) (concat  "(" Newsgroups ") " Subject) From Date  
                  Message-ID  
                  nil 0 (string-to-int Score) url))  
                map)  
               (nnweb-set-hashtb (cadar map) (car map))))  
           (setq more nil))  
         ;; Return the articles in the right order.  
         (setq nnweb-articles  
               (sort (nconc nnweb-articles map) 'car-less-than-car))))))  
   
 (defun nnweb-reference-wash-article ()  
   (let ((case-fold-search t))  
     (goto-char (point-min))  
     (re-search-forward "^</center><hr>" nil t)  
     (delete-region (point-min) (point))  
     (search-forward "<pre>" nil t)  
     (forward-line -1)  
     (let ((body (point-marker)))  
       (search-forward "</pre>" nil t)  
       (delete-region (point) (point-max))  
       (nnweb-remove-markup)  
       (goto-char (point-min))  
       (while (looking-at " *$")  
         (gnus-delete-line))  
       (narrow-to-region (point-min) body)  
       (while (and (re-search-forward "^$" nil t)  
                   (not (eobp)))  
         (gnus-delete-line))  
       (goto-char (point-min))  
       (while (looking-at "\\(^[^ ]+:\\) *")  
         (replace-match "\\1 " t)  
         (forward-line 1))  
       (goto-char (point-min))  
       (when (re-search-forward "^References:" nil t)  
         (narrow-to-region  
          (point) (if (re-search-forward "^$\\|^[^:]+:" nil t)  
                      (match-beginning 0)  
                    (point-max)))  
         (goto-char (point-min))  
         (while (not (eobp))  
           (unless (looking-at "References")  
             (insert "\t")  
             (forward-line 1)))  
         (goto-char (point-min))  
         (while (search-forward "," nil t)  
           (replace-match " " t t)))  
       (widen)  
       (nnweb-decode-entities)  
       (set-marker body nil))))  
   
 (defun nnweb-reference-search (search)  
   (url-insert-file-contents  
    (concat  
     (nnweb-definition 'address)  
     "?"  
     (nnweb-encode-www-form-urlencoded  
      `(("search" . "advanced")  
        ("querytext" . ,search)  
        ("subj" . "")  
        ("name" . "")  
        ("login" . "")  
        ("host" . "")  
        ("organization" . "")  
        ("groups" . "")  
        ("keywords" . "")  
        ("choice" . "Search")  
        ("startmonth" . "Jul")  
        ("startday" . "25")  
        ("startyear" . "1996")  
        ("endmonth" . "Aug")  
        ("endday" . "24")  
        ("endyear" . "1996")  
        ("mode" . "Quick")  
        ("verbosity" . "Verbose")  
        ("ranking" . "Relevance")  
        ("first" . "1")  
        ("last" . "25")  
        ("score" . "50")))))  
   (setq buffer-file-name nil)  
   t)  
   
 ;;;  
 ;;; Alta Vista  
 ;;;  
   
 (defun nnweb-altavista-create-mapping ()  
   "Perform the search and create a number-to-url alist."  
   (save-excursion  
     (set-buffer nnweb-buffer)  
     (erase-buffer)  
     (let ((part 0))  
       (when (funcall (nnweb-definition 'search) nnweb-search part)  
         (let ((i 0)  
               (more t)  
               (case-fold-search t)  
               (active (or (cadr (assoc nnweb-group nnweb-group-alist))  
                           (cons 1 0)))  
               subject date from id group  
               map url)  
           (while more  
             ;; Go through all the article hits on this page.  
             (goto-char (point-min))  
             (search-forward "<dt>" nil t)  
             (delete-region (point-min) (match-beginning 0))  
             (goto-char (point-min))  
             (while (search-forward "<dt>" nil t)  
               (replace-match "\n<blubb>"))  
             (nnweb-decode-entities)  
             (goto-char (point-min))  
             (while (re-search-forward "<blubb>.*href=\"\\([^\"]+\\)\"><strong>\\([^>]*\\)</strong></a><dd>\\([^-]+\\)- <b>\\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)</a><P>"  
                                       nil t)  
               (setq url (match-string 1)  
                     subject (match-string 2)  
                     date (match-string 3)  
                     group (match-string 4)  
                     id (concat "<" (match-string 5) ">")  
                     from (match-string 6))  
               (incf i)  
               (unless (nnweb-get-hashtb url)  
                 (push  
                  (list  
                   (incf (cdr active))  
                   (make-full-mail-header  
                    (cdr active) (concat  "(" group ") " subject) from date  
                    id nil 0 0 url))  
                  map)  
                 (nnweb-set-hashtb (cadar map) (car map))))  
             ;; See if we want more.  
             (when (or (not nnweb-articles)  
                       (>= i nnweb-max-hits)  
                       (not (funcall (nnweb-definition 'search)  
                                     nnweb-search (incf part))))  
               (setq more nil)))  
           ;; Return the articles in the right order.  
           (setq nnweb-articles  
                 (sort (nconc nnweb-articles map) 'car-less-than-car)))))))  
   
 (defun nnweb-altavista-wash-article ()  
   (goto-char (point-min))  
   (let ((case-fold-search t))  
     (when (re-search-forward "^<strong>" nil t)  
       (delete-region (point-min) (match-beginning 0)))  
     (goto-char (point-min))  
     (while (looking-at "<strong>\\([^ ]+\\) +</strong> +\\(.*\\)$")  
       (replace-match "\\1: \\2" t)  
       (forward-line 1))  
     (when (re-search-backward "^References:" nil t)  
       (narrow-to-region (point) (progn (forward-line 1) (point)))  
       (goto-char (point-min))  
       (while (re-search-forward "<A.*\\?id@\\([^\"]+\\)\">[0-9]+</A>" nil t)  
         (replace-match "&lt;\\1&gt; " t)))  
     (widen)  
     (nnweb-remove-markup)  
     (nnweb-decode-entities)))  
   
 (defun nnweb-altavista-search (search &optional part)  
   (url-insert-file-contents  
    (concat  
     (nnweb-definition 'address)  
     "?"  
     (nnweb-encode-www-form-urlencoded  
      `(("pg" . "aq")  
        ("what" . "news")  
        ,@(when part `(("stq" . ,(int-to-string (* part 30)))))  
        ("fmt" . "d")  
        ("q" . ,search)  
        ("r" . "")  
        ("d0" . "")  
        ("d1" . "")))))  
   (setq buffer-file-name nil)  
   t)  
   
305  ;;;  ;;;
306  ;;; Deja bought by google.com  ;;; Deja bought by google.com
307  ;;;  ;;;
# Line 731  and `altavista'.") Line 320  and `altavista'.")
320      (goto-char (point-min))      (goto-char (point-min))
321      (while (search-forward "<br>" nil t)      (while (search-forward "<br>" nil t)
322        (replace-match "\n"))        (replace-match "\n"))
323      (nnweb-remove-markup)      (mm-url-remove-markup)
324      (goto-char (point-min))      (goto-char (point-min))
325      (while (re-search-forward "^[ \t]*\n" nil t)      (while (re-search-forward "^[ \t]*\n" nil t)
326        (replace-match ""))        (replace-match ""))
# Line 741  and `altavista'.") Line 330  and `altavista'.")
330      (narrow-to-region (point) (point-max))      (narrow-to-region (point) (point-max))
331      (search-forward "</pre>" nil t)      (search-forward "</pre>" nil t)
332      (delete-region (point) (point-max))      (delete-region (point) (point-max))
333      (nnweb-remove-markup)      (mm-url-remove-markup)
334      (widen)))      (widen)))
335    
336  (defun nnweb-google-parse-1 (&optional Message-ID)  (defun nnweb-google-parse-1 (&optional Message-ID)
# Line 763  and `altavista'.") Line 352  and `altavista'.")
352                   "http://groups.google.com/groups?selm=%s&output=gplain" mid))                   "http://groups.google.com/groups?selm=%s&output=gplain" mid))
353        (narrow-to-region (search-forward ">" nil t)        (narrow-to-region (search-forward ">" nil t)
354                          (search-forward "</a>" nil t))                          (search-forward "</a>" nil t))
355        (nnweb-remove-markup)        (mm-url-remove-markup)
356        (nnweb-decode-entities)        (mm-url-decode-entities)
357        (setq Subject (buffer-string))        (setq Subject (buffer-string))
358        (goto-char (point-max))        (goto-char (point-max))
359        (widen)        (widen)
360        (forward-line 1)        (forward-line 2)
361        (when (looking-at "<br><font[^>]+>")        (when (looking-at "<br><font[^>]+>")
362          (goto-char (match-end 0)))          (goto-char (match-end 0)))
363        (if (not (looking-at "<a[^>]+>"))        (if (not (looking-at "<a[^>]+>"))
364            (skip-chars-forward " \t")            (skip-chars-forward " \t")
365          (narrow-to-region (point)          (narrow-to-region (point)
366                            (search-forward "</a>" nil t))                            (search-forward "</a>" nil t))
367          (nnweb-remove-markup)          (mm-url-remove-markup)
368          (nnweb-decode-entities)          (mm-url-decode-entities)
369          (setq Newsgroups (buffer-string))          (setq Newsgroups (buffer-string))
370          (goto-char (point-max))          (goto-char (point-max))
371          (widen)          (widen)
372          (skip-chars-forward "- \t"))          (skip-chars-forward "- \t"))
373        (when (looking-at        (when (looking-at
374               "\\([0-9]+[/ ][A-Za-z]+[/ ][0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")               "\\([0-9]+\\)[/ ]\\([A-Za-z]+\\)[/ ]\\([0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
375          (setq From (match-string 2)          (setq From (match-string 4)
376                Date (match-string 1)))                Date (format "%s %s 00:00:00 %s"
377                               (match-string 2) (match-string 1)
378                               (match-string 3))))
379        (forward-line 1)        (forward-line 1)
380        (incf i)        (incf i)
381        (unless (nnweb-get-hashtb url)        (unless (nnweb-get-hashtb url)
# Line 807  and `altavista'.") Line 398  and `altavista'.")
398            (nconc nnweb-articles map))            (nconc nnweb-articles map))
399      (when (setq header (cadar map))      (when (setq header (cadar map))
400        (mm-with-unibyte-current-buffer        (mm-with-unibyte-current-buffer
401          (nnweb-fetch-url (mail-header-xref header)))          (mm-url-insert (mail-header-xref header)))
402        (caar map))))        (caar map))))
403    
404  (defun nnweb-google-create-mapping ()  (defun nnweb-google-create-mapping ()
# Line 816  and `altavista'.") Line 407  and `altavista'.")
407      (set-buffer nnweb-buffer)      (set-buffer nnweb-buffer)
408      (erase-buffer)      (erase-buffer)
409      (when (funcall (nnweb-definition 'search) nnweb-search)      (when (funcall (nnweb-definition 'search) nnweb-search)
410          (let ((more t))          (let ((more t)
411                  (i 0))
412            (while more            (while more
413              (setq nnweb-articles              (setq nnweb-articles
414                    (nconc nnweb-articles (nnweb-google-parse-1)))                    (nconc nnweb-articles (nnweb-google-parse-1)))
415              ;; FIXME: There is more.              ;; Check if there are more articles to fetch
416              (setq more nil))              (goto-char (point-min))
417                (incf i 100)
418                (if (or (not (re-search-forward
419                              "<td nowrap><a href=\\([^>]+\\).*<span class=b>Next</span>" nil t))
420                        (>= i nnweb-max-hits))
421                    (setq more nil)
422                  ;; Yup, there are more articles
423                  (setq more (concat "http://groups.google.com" (match-string 1)))
424                (when more
425                  (erase-buffer)
426                  (mm-url-insert more))))
427            ;; Return the articles in the right order.            ;; Return the articles in the right order.
428            (setq nnweb-articles            (setq nnweb-articles
429                  (sort nnweb-articles 'car-less-than-car))))))                  (sort nnweb-articles 'car-less-than-car))))))
430    
431  (defun nnweb-google-search (search)  (defun nnweb-google-search (search)
432    (nnweb-insert    (mm-url-insert
433     (concat     (concat
434      (nnweb-definition 'address)      (nnweb-definition 'address)
435      "?"      "?"
436      (nnweb-encode-www-form-urlencoded      (mm-url-encode-www-form-urlencoded
437       `(("q" . ,search)       `(("q" . ,search)
438         ("num". "100")         ("num". "100")
439         ("hq" . "")         ("hq" . "")
# Line 848  and `altavista'.") Line 450  and `altavista'.")
450      url))      url))
451    
452  ;;;  ;;;
453    ;;; gmane.org
454    ;;;
455    (defun nnweb-gmane-create-mapping ()
456      "Perform the search and create a number-to-url alist."
457      (save-excursion
458        (set-buffer nnweb-buffer)
459        (erase-buffer)
460        (when (funcall (nnweb-definition 'search) nnweb-search)
461          (let ((more t)
462                (case-fold-search t)
463                (active (or (cadr (assoc nnweb-group nnweb-group-alist))
464                            (cons 1 0)))
465                subject group url
466                map)
467              ;; Remove stuff from the beginning of results
468            (goto-char (point-min))
469            (search-forward "Search Results</h1><ul>" nil t)
470            (delete-region (point-min) (point))
471            (goto-char (point-min))
472            ;; Iterate over the actual hits
473            (while (re-search-forward ".*href=\"\\([^\"]+\\)\">\\(.*\\)" nil t)
474                (setq url (concat "http://gmane.org/" (match-string 1)))
475                (setq subject (match-string 2))
476              (unless (nnweb-get-hashtb url)
477                (push
478                 (list
479                  (incf (cdr active))
480                  (make-full-mail-header
481                   (cdr active) (concat  "(" group ") " subject) nil nil
482                   nil nil 0 0 url))
483                 map)
484                (nnweb-set-hashtb (cadar map) (car map))))
485            ;; Return the articles in the right order.
486            (setq nnweb-articles
487                  (sort (nconc nnweb-articles map) 'car-less-than-car))))))
488    
489    (defun nnweb-gmane-wash-article ()
490      (let ((case-fold-search t))
491        (goto-char (point-min))
492        (re-search-forward "<!--X-Head-of-Message-->" nil t)
493        (delete-region (point-min) (point))
494        (goto-char (point-min))
495        (while (looking-at "^<li><em>\\([^ ]+\\)</em>.*</li>")
496          (replace-match "\\1\\2" t)
497          (forward-line 1))
498        (mm-url-remove-markup)))
499    
500    (defun nnweb-gmane-search (search)
501      (mm-url-insert
502       (concat
503        (nnweb-definition 'address)
504        "?"
505        (mm-url-encode-www-form-urlencoded
506         `(("query" . ,search)))))
507      (setq buffer-file-name nil)
508      t)
509    
510    
511    (defun nnweb-gmane-identity (url)
512      "Return a unique identifier based on URL."
513      (if (string-match "group=\\(.+\\)" url)
514          (match-string 1 url)
515        url))
516    
517    ;;;
518  ;;; General web/w3 interface utility functions  ;;; General web/w3 interface utility functions
519  ;;;  ;;;
520    
# Line 869  and `altavista'.") Line 536  and `altavista'.")
536      (mapcar 'nnweb-insert-html (nth 2 parse))      (mapcar 'nnweb-insert-html (nth 2 parse))
537      (insert "</" (symbol-name (car parse)) ">\n")))      (insert "</" (symbol-name (car parse)) ">\n")))
538    
 (defun nnweb-encode-www-form-urlencoded (pairs)  
   "Return PAIRS encoded for forms."  
   (mapconcat  
    (function  
     (lambda (data)  
       (concat (w3-form-encode-xwfu (car data)) "="  
               (w3-form-encode-xwfu (cdr data)))))  
    pairs "&"))  
   
 (defun nnweb-fetch-form (url pairs)  
   "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  
          '(("Content-type" . "application/x-www-form-urlencoded"))))  
     (url-insert-file-contents url)  
     (setq buffer-file-name nil))  
   t)  
   
 (defun nnweb-decode-entities ()  
   "Decode all HTML entities."  
   (goto-char (point-min))  
   (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."  
   (goto-char (point-min))  
   (while (search-forward "<!--" nil t)  
     (delete-region (match-beginning 0)  
                    (or (search-forward "-->" nil t)  
                        (point-max))))  
   (goto-char (point-min))  
   (while (re-search-forward "<[^>]+>" nil t)  
     (replace-match "" t t)))  
   
 (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))  
     (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)))  
   
539  (defun nnweb-parse-find (type parse &optional maxdepth)  (defun nnweb-parse-find (type parse &optional maxdepth)
540    "Find the element of TYPE in PARSE."    "Find the element of TYPE in PARSE."
541    (catch 'found    (catch 'found
# Line 987  If FOLLOW-REFRESH is non-nil, redirect r Line 585  If FOLLOW-REFRESH is non-nil, redirect r
585                   (listp (cdr element)))                   (listp (cdr element)))
586          (nnweb-text-1 element)))))          (nnweb-text-1 element)))))
587    
 (defun nnweb-replace-in-string (string match newtext)  
   (while (string-match match string)  
     (setq string (replace-match newtext t t string)))  
   string)  
   
588  (provide 'nnweb)  (provide 'nnweb)
589    
590  ;;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697  ;;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697

Legend:
Removed from v.1.9.4.2  
changed lines
  Added in v.1.9.4.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26