Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnweb.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents 4103f0995bd7
children 8b8b7f3559a2 9b50b4588a93
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
32 (require 'message) 32 (require 'message)
33 (require 'gnus-util) 33 (require 'gnus-util)
34 (require 'gnus) 34 (require 'gnus)
35 (require 'w3) 35 (require 'w3)
36 (require 'url) 36 (require 'url)
37 (require 'nnmail)
37 (ignore-errors 38 (ignore-errors
38 (require 'w3-forms)) 39 (require 'w3-forms))
39 40
40 (nnoo-declare nnweb) 41 (nnoo-declare nnweb)
41 42
106 (nnweb-write-active) 107 (nnweb-write-active)
107 (nnweb-write-overview group))) 108 (nnweb-write-overview group)))
108 109
109 (deffoo nnweb-request-group (group &optional server dont-check) 110 (deffoo nnweb-request-group (group &optional server dont-check)
110 (nnweb-possibly-change-server nil server) 111 (nnweb-possibly-change-server nil server)
111 (when (and group 112 (when (and group
112 (not (equal group nnweb-group)) 113 (not (equal group nnweb-group))
113 (not nnweb-ephemeral-p)) 114 (not nnweb-ephemeral-p))
114 (let ((info (assoc group nnweb-group-alist))) 115 (let ((info (assoc group nnweb-group-alist)))
115 (setq nnweb-group group) 116 (setq nnweb-group group)
116 (setq nnweb-type (nth 2 info)) 117 (setq nnweb-type (nth 2 info))
197 (deffoo nnweb-request-delete-group (group &optional force server) 198 (deffoo nnweb-request-delete-group (group &optional force server)
198 (nnweb-possibly-change-server group server) 199 (nnweb-possibly-change-server group server)
199 (gnus-delete-assoc group nnweb-group-alist) 200 (gnus-delete-assoc group nnweb-group-alist)
200 (gnus-delete-file (nnweb-overview-file group)) 201 (gnus-delete-file (nnweb-overview-file group))
201 t) 202 t)
202 203
203 (nnoo-define-skeleton nnweb) 204 (nnoo-define-skeleton nnweb)
204 205
205 ;;; Internal functions 206 ;;; Internal functions
206 207
207 (defun nnweb-read-overview (group) 208 (defun nnweb-read-overview (group)
248 (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer)))) 249 (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
249 250
250 (defun nnweb-read-active () 251 (defun nnweb-read-active ()
251 "Read the active file." 252 "Read the active file."
252 (load (nnheader-concat nnweb-directory "active") t t t)) 253 (load (nnheader-concat nnweb-directory "active") t t t))
253 254
254 (defun nnweb-definition (type &optional noerror) 255 (defun nnweb-definition (type &optional noerror)
255 "Return the definition of TYPE." 256 "Return the definition of TYPE."
256 (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition))))) 257 (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
257 (when (and (not def) 258 (when (and (not def)
258 (not noerror)) 259 (not noerror))
320 (url-retrieve url)) 321 (url-retrieve url))
321 (setq-default url-be-asynchronous old-asynch))) 322 (setq-default url-be-asynchronous old-asynch)))
322 323
323 (defun nnweb-encode-www-form-urlencoded (pairs) 324 (defun nnweb-encode-www-form-urlencoded (pairs)
324 "Return PAIRS encoded for forms." 325 "Return PAIRS encoded for forms."
325 (mapconcat 326 (mapconcat
326 (function 327 (function
327 (lambda (data) 328 (lambda (data)
328 (concat (w3-form-encode-xwfu (car data)) "=" 329 (concat (w3-form-encode-xwfu (car data)) "="
329 (w3-form-encode-xwfu (cdr data))))) 330 (w3-form-encode-xwfu (cdr data)))))
330 pairs "&")) 331 pairs "&"))
331 332
332 (defun nnweb-fetch-form (url pairs) 333 (defun nnweb-fetch-form (url pairs)
333 (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs)) 334 (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
334 (url-request-method "POST") 335 (url-request-method "POST")
335 (url-request-extra-headers 336 (url-request-extra-headers
336 '(("Content-type" . "application/x-www-form-urlencoded")))) 337 '(("Content-type" . "application/x-www-form-urlencoded"))))
337 (url-insert-file-contents url) 338 (url-insert-file-contents url)
338 (setq buffer-file-name nil)) 339 (setq buffer-file-name nil))
339 t) 340 t)
340 341
377 ;; Go through all the article hits on this page. 378 ;; Go through all the article hits on this page.
378 (goto-char (point-min)) 379 (goto-char (point-min))
379 (nnweb-decode-entities) 380 (nnweb-decode-entities)
380 (goto-char (point-min)) 381 (goto-char (point-min))
381 (while (re-search-forward "^ +[0-9]+\\." nil t) 382 (while (re-search-forward "^ +[0-9]+\\." nil t)
382 (narrow-to-region 383 (narrow-to-region
383 (point) 384 (point)
384 (cond ((re-search-forward "^ +[0-9]+\\." nil t) 385 (cond ((re-search-forward "^ +[0-9]+\\." nil t)
385 (match-beginning 0)) 386 (match-beginning 0))
386 ((search-forward "\n\n" nil t) 387 ((search-forward "\n\n" nil t)
387 (point)) 388 (point))
442 (forward-line 1)) 443 (forward-line 1))
443 (when (re-search-forward "\n\n+" nil t) 444 (when (re-search-forward "\n\n+" nil t)
444 (replace-match "\n" t t)))) 445 (replace-match "\n" t t))))
445 446
446 (defun nnweb-dejanews-search (search) 447 (defun nnweb-dejanews-search (search)
447 (nnweb-fetch-form 448 (nnweb-fetch-form
448 (nnweb-definition 'address) 449 (nnweb-definition 'address)
449 `(("query" . ,search) 450 `(("query" . ,search)
450 ("defaultOp" . "AND") 451 ("defaultOp" . "AND")
451 ("svcclass" . "dncurrent") 452 ("svcclass" . "dncurrent")
452 ("maxhits" . "100") 453 ("maxhits" . "100")
486 (search-forward "</pre><hr>" nil t) 487 (search-forward "</pre><hr>" nil t)
487 (delete-region (point-min) (point)) 488 (delete-region (point-min) (point))
488 ;(nnweb-decode-entities) 489 ;(nnweb-decode-entities)
489 (goto-char (point-min)) 490 (goto-char (point-min))
490 (while (re-search-forward "^ +[0-9]+\\." nil t) 491 (while (re-search-forward "^ +[0-9]+\\." nil t)
491 (narrow-to-region 492 (narrow-to-region
492 (point) 493 (point)
493 (if (re-search-forward "^$" nil t) 494 (if (re-search-forward "^$" nil t)
494 (match-beginning 0) 495 (match-beginning 0)
495 (point-max))) 496 (point-max)))
496 (goto-char (point-min)) 497 (goto-char (point-min))
562 (set-marker body nil)))) 563 (set-marker body nil))))
563 564
564 (defun nnweb-reference-search (search) 565 (defun nnweb-reference-search (search)
565 (prog1 566 (prog1
566 (url-insert-file-contents 567 (url-insert-file-contents
567 (concat 568 (concat
568 (nnweb-definition 'address) 569 (nnweb-definition 'address)
569 "?" 570 "?"
570 (nnweb-encode-www-form-urlencoded 571 (nnweb-encode-www-form-urlencoded
571 `(("search" . "advanced") 572 `(("search" . "advanced")
572 ("querytext" . ,search) 573 ("querytext" . ,search)
573 ("subj" . "") 574 ("subj" . "")
574 ("name" . "") 575 ("name" . "")
575 ("login" . "") 576 ("login" . "")
668 (nnweb-remove-markup))) 669 (nnweb-remove-markup)))
669 670
670 (defun nnweb-altavista-search (search &optional part) 671 (defun nnweb-altavista-search (search &optional part)
671 (prog1 672 (prog1
672 (url-insert-file-contents 673 (url-insert-file-contents
673 (concat 674 (concat
674 (nnweb-definition 'address) 675 (nnweb-definition 'address)
675 "?" 676 "?"
676 (nnweb-encode-www-form-urlencoded 677 (nnweb-encode-www-form-urlencoded
677 `(("pg" . "aq") 678 `(("pg" . "aq")
678 ("what" . "news") 679 ("what" . "news")
679 ,@(when part `(("stq" . ,(int-to-string (* part 30))))) 680 ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
680 ("fmt" . "d") 681 ("fmt" . "d")
681 ("q" . ,search) 682 ("q" . ,search)