nnweb.el 18.5 KB
Newer Older
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1
;;; nnweb.el --- retrieving articles via web search engines
2

3
;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
4

5
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
6 7 8 9
;; Keywords: news

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
14 15 16 17 18 19 20

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
22 23 24

;;; Commentary:

25
;; Note: You need to have `w3' installed for some functions to work.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
26 27 28

;;; Code:

29 30
(eval-when-compile (require 'cl))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
31 32 33 34 35
(require 'nnoo)
(require 'message)
(require 'gnus-util)
(require 'gnus)
(require 'nnmail)
36
(require 'mm-util)
37 38
(require 'mm-url)
(eval-and-compile
39
  (ignore-errors
40 41
    (require 'url)))
(autoload 'w3-parse-buffer "w3-parse")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
42 43 44 45 46 47

(nnoo-declare nnweb)

(defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
  "Where nnweb will save its files.")

48
(defvoo nnweb-type 'google
49
  "What search engine type is being used.
50
Valid types include `google', `dejanews', and `gmane'.")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
51

52
(defvar nnweb-type-definition
53
  '((google
54
     (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source")
55
     (result . "http://groups.google.com/group/%s/msg/%s?dmode=source")
56
     (article . nnweb-google-wash-article)
57 58 59
     (reference . identity)
     (map . nnweb-google-create-mapping)
     (search . nnweb-google-search)
60 61
     (address . "http://groups.google.com/groups")
     (base    . "http://groups.google.com")
62 63
     (identifier . nnweb-google-identity))
    (dejanews ;; alias of google
64 65 66
     (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source")
     (result . "http://groups.google.com/group/%s/msg/%s?dmode=source")
     (article . nnweb-google-wash-article)
67 68 69 70
     (reference . identity)
     (map . nnweb-google-create-mapping)
     (search . nnweb-google-search)
     (address . "http://groups.google.com/groups")
71
     (base    . "http://groups.google.com")
72
     (identifier . nnweb-google-identity))
73 74 75 76 77 78
    (gmane
     (article . nnweb-gmane-wash-article)
     (id . "http://gmane.org/view.php?group=%s")
     (reference . identity)
     (map . nnweb-gmane-create-mapping)
     (search . nnweb-gmane-search)
79
     (address . "http://search.gmane.org/nov.php")
80
     (identifier . nnweb-gmane-identity)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
81 82 83
  "Type-definition alist.")

(defvoo nnweb-search nil
84
  "Search string to feed to Google.")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
85

86
(defvoo nnweb-max-hits 999
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
87 88 89 90 91 92 93 94 95
  "Maximum number of hits to display.")

(defvoo nnweb-ephemeral-p nil
  "Whether this nnweb server is ephemeral.")

;;; Internal variables

(defvoo nnweb-articles nil)
(defvoo nnweb-buffer nil)
96
(defvoo nnweb-group-alist nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
97 98 99 100 101 102 103 104 105
(defvoo nnweb-group nil)
(defvoo nnweb-hashtb nil)

;;; Interface functions

(nnoo-define-basics nnweb)

(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
  (nnweb-possibly-change-server group server)
106
  (with-current-buffer nntp-server-buffer
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
107 108
    (erase-buffer)
    (let (article header)
109 110 111 112
      (mm-with-unibyte-current-buffer
	(while (setq article (pop articles))
	  (when (setq header (cadr (assq article nnweb-articles)))
	    (nnheader-insert-nov header))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
113 114 115 116
      'nov)))

(deffoo nnweb-request-scan (&optional group server)
  (nnweb-possibly-change-server group server)
117
  (if nnweb-ephemeral-p
118 119 120
      (setq nnweb-hashtb (gnus-make-hashtable 4095))
    (unless nnweb-articles
      (nnweb-read-overview group)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
121 122 123 124 125
  (funcall (nnweb-definition 'map))
  (unless nnweb-ephemeral-p
    (nnweb-write-active)
    (nnweb-write-overview group)))

126
(deffoo nnweb-request-group (group &optional server dont-check info)
127 128
  (nnweb-possibly-change-server group server)
  (unless (or nnweb-ephemeral-p
129 130
	      dont-check
	      nnweb-articles)
131
    (nnweb-read-overview group))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
  (cond
   ((not nnweb-articles)
    (nnheader-report 'nnweb "No matching articles"))
   (t
    (let ((active (if nnweb-ephemeral-p
		      (cons (caar nnweb-articles)
			    (caar (last nnweb-articles)))
		    (cadr (assoc group nnweb-group-alist)))))
      (nnheader-report 'nnweb "Opened group %s" group)
      (nnheader-insert
       "211 %d %d %d %s\n" (length nnweb-articles)
       (car active) (cdr active) group)))))

(deffoo nnweb-close-group (group &optional server)
  (nnweb-possibly-change-server group server)
  (when (gnus-buffer-live-p nnweb-buffer)
148
    (with-current-buffer nnweb-buffer
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
149 150 151 152 153 154
      (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)
155
  (with-current-buffer (or buffer nntp-server-buffer)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
156 157 158
    (let* ((header (cadr (assq article nnweb-articles)))
	   (url (and header (mail-header-xref header))))
      (when (or (and url
159
		     (mm-with-unibyte-current-buffer
160
		       (mm-url-insert url)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
161 162 163
		(and (stringp article)
		     (nnweb-definition 'id t)
		     (let ((fetch (nnweb-definition 'id))
164
			   art active)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
165 166
		       (when (string-match "^<\\(.*\\)>$" article)
			 (setq art (match-string 1 article)))
167
		       (when (and fetch art)
Miles Bader's avatar
Miles Bader committed
168 169
			 (setq url (format fetch
					   (mm-url-form-encode-xwfu art)))
170
			 (mm-with-unibyte-current-buffer
171
			   (mm-url-insert url))
172 173 174 175
			 (if (nnweb-definition 'reference t)
			     (setq article
				   (funcall (nnweb-definition
					     'reference) article)))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
176
	(unless nnheader-callback-function
177
	  (funcall (nnweb-definition 'article)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
178
	(nnheader-report 'nnweb "Fetched article %s" article)
179
	(cons group (and (numberp article) article))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
180 181 182 183

(deffoo nnweb-close-server (&optional server)
  (when (and (nnweb-server-opened server)
	     (gnus-buffer-live-p nnweb-buffer))
184
    (with-current-buffer nnweb-buffer
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
185 186 187 188 189 190
      (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)
191
  (with-current-buffer nntp-server-buffer
192
    (nnmail-generate-active (list (assoc server nnweb-group-alist)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
193 194
    t))

195
(deffoo nnweb-request-update-info (group info &optional server))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
196 197

(deffoo nnweb-asynchronous-p ()
198
  nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
199 200 201 202

(deffoo nnweb-request-create-group (group &optional server args)
  (nnweb-possibly-change-server nil server)
  (nnweb-request-delete-group group)
203
  (push `(,group ,(cons 1 0)) nnweb-group-alist)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
204 205 206 207 208
  (nnweb-write-active)
  t)

(deffoo nnweb-request-delete-group (group &optional force server)
  (nnweb-possibly-change-server group server)
209
  (gnus-alist-pull group nnweb-group-alist t)
210
  (nnweb-write-active)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
211 212 213 214 215 216 217 218 219 220
  (gnus-delete-file (nnweb-overview-file group))
  t)

(nnoo-define-skeleton nnweb)

;;; Internal functions

(defun nnweb-read-overview (group)
  "Read the overview of GROUP and build the map."
  (when (file-exists-p (nnweb-overview-file group))
221
    (mm-with-unibyte-buffer
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
222 223 224 225 226 227 228 229 230 231 232 233 234
      (nnheader-insert-file-contents (nnweb-overview-file group))
      (goto-char (point-min))
      (let (header)
	(while (not (eobp))
	  (setq header (nnheader-parse-nov))
	  (forward-line 1)
	  (push (list (mail-header-number header)
		      header (mail-header-xref header))
		nnweb-articles)
	  (nnweb-set-hashtb header (car nnweb-articles)))))))

(defun nnweb-write-overview (group)
  "Write the overview file for GROUP."
235
  (with-temp-file (nnweb-overview-file group)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
    (let ((articles nnweb-articles))
      (while articles
	(nnheader-insert-nov (cadr (pop articles)))))))

(defun nnweb-set-hashtb (header data)
  (gnus-sethash (nnweb-identifier (mail-header-xref header))
		data nnweb-hashtb))

(defun nnweb-get-hashtb (url)
  (gnus-gethash (nnweb-identifier url) nnweb-hashtb))

(defun nnweb-identifier (ident)
  (funcall (nnweb-definition 'identifier) ident))

(defun nnweb-overview-file (group)
  "Return the name of the overview file of GROUP."
  (nnheader-concat nnweb-directory group ".overview"))

(defun nnweb-write-active ()
  "Save the active file."
256 257
  (gnus-make-directory nnweb-directory)
  (with-temp-file (nnheader-concat nnweb-directory "active")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274
    (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))

(defun nnweb-read-active ()
  "Read the active file."
  (load (nnheader-concat nnweb-directory "active") t t t))

(defun nnweb-definition (type &optional noerror)
  "Return the definition of TYPE."
  (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
    (when (and (not def)
	       (not noerror))
      (error "Undefined definition %s" type))
    def))

(defun nnweb-possibly-change-server (&optional group server)
  (when server
    (unless (nnweb-server-opened server)
275 276
      (nnweb-open-server server))
    (nnweb-init server))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
277 278
  (unless nnweb-group-alist
    (nnweb-read-active))
279 280
  (unless nnweb-hashtb
    (setq nnweb-hashtb (gnus-make-hashtable 4095)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
281
  (when group
282
    (setq nnweb-group group)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
283 284 285 286 287

(defun nnweb-init (server)
  "Initialize buffers and such."
  (unless (gnus-buffer-live-p nnweb-buffer)
    (setq nnweb-buffer
288 289 290 291 292 293
	  (save-current-buffer
            (nnheader-set-temp-buffer
             (format " *nnweb %s %s %s*"
                     nnweb-type nnweb-search server))
            (mm-disable-multibyte)
            (current-buffer)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
294

295
;;;
296
;;; groups.google.com
297 298 299
;;;

(defun nnweb-google-wash-article ()
300
  ;; We have Google's masked e-mail addresses here.  :-/
301
  (let ((case-fold-search t)
302 303
	(start-re "<pre>[\r\n ]*")
	(end-re "[\r\n ]*</pre>"))
304
    (goto-char (point-min))
305 306 307
    (if (save-excursion
	  (or (re-search-forward "The requested message.*could not be found."
				 nil t)
308 309
	      (not (and (re-search-forward start-re nil t)
			(re-search-forward end-re nil t)))))
310 311 312 313 314 315
	;; FIXME: Don't know how to indicate "not found".
	;; Should this function throw an error?  --rsteib
	(progn
	  (gnus-message 3 "Requested article not found")
	  (erase-buffer))
      (delete-region (point-min)
316
		     (re-search-forward start-re))
317
      (goto-char (point-min))
318 319 320
      (delete-region (progn
		       (re-search-forward end-re)
		       (match-beginning 0))
321 322
		     (point-max))
      (mm-url-decode-entities))))
323 324

(defun nnweb-google-parse-1 (&optional Message-ID)
325
  "Parse search result in current buffer."
326 327 328 329 330 331
  (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
332
      (push (list nnweb-group (setq active (cons 1 0)))
333 334 335
	    nnweb-group-alist))
    ;; Go through all the article hits on this page.
    (goto-char (point-min))
336 337 338 339 340 341 342 343
    (while
	(re-search-forward
	 "a +href=\"/group/\\([^>\"]+\\)/browse_thread/[^>]+#\\([0-9a-f]+\\)"
	 nil t)
      (setq Newsgroups (match-string-no-properties 1)
	    ;; Note: Starting with Google Groups 2, `mid' is a Google-internal
	    ;; ID, not a proper Message-ID.
	    mid (match-string-no-properties 2)
344
	    url (format
345
		 (nnweb-definition 'result) Newsgroups mid))
346 347
      (narrow-to-region (search-forward ">" nil t)
			(search-forward "</a>" nil t))
348 349
      (mm-url-remove-markup)
      (mm-url-decode-entities)
350 351 352
      (setq Subject (buffer-string))
      (goto-char (point-max))
      (widen)
353
      (narrow-to-region (point)
Miles Bader's avatar
Miles Bader committed
354
			(search-forward "</table" nil t))
355 356 357

      (mm-url-remove-markup)
      (mm-url-decode-entities)
Miles Bader's avatar
Miles Bader committed
358 359 360
      (goto-char (point-max))
      (when
	  (re-search-backward
Miles Bader's avatar
Miles Bader committed
361
 	   "^\\(?:\\(\\w+\\) \\([0-9]+\\)\\|\\S-+\\)\\(?: \\([0-9]\\{4\\}\\)\\)? by ?\\(.*\\)"
Miles Bader's avatar
Miles Bader committed
362
	   nil t)
Miles Bader's avatar
Miles Bader committed
363 364 365 366 367
	(setq Date (if (match-string 1)
		       (format "%s %s 00:00:00 %s"
			       (match-string 1)
			       (match-string 2)
			       (or (match-string 3)
Paul Eggert's avatar
Paul Eggert committed
368
				   (format-time-string "%Y")))
Miles Bader's avatar
Miles Bader committed
369
		     (current-time-string)))
Miles Bader's avatar
Miles Bader committed
370
	(setq From (match-string 4)))
371
      (widen)
372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392
      (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
393
	(mm-url-insert (mail-header-xref header)))
394 395 396
      (caar map))))

(defun nnweb-google-create-mapping ()
397
  "Perform the search and create a number-to-url alist."
398
  (with-current-buffer nnweb-buffer
399
    (erase-buffer)
400
    (nnheader-message 7 "Searching google...")
401
    (when (funcall (nnweb-definition 'search) nnweb-search)
402 403
	(let ((more t)
	      (i 0))
404 405 406
	  (while more
	    (setq nnweb-articles
		  (nconc nnweb-articles (nnweb-google-parse-1)))
407 408 409 410
	    ;; Check if there are more articles to fetch
	    (goto-char (point-min))
	    (incf i 100)
	    (if (or (not (re-search-forward
Miles Bader's avatar
Miles Bader committed
411
			  "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next"
412
			  nil t))
413 414 415
		    (>= i nnweb-max-hits))
		(setq more nil)
	      ;; Yup, there are more articles
416
	      (setq more (concat (nnweb-definition 'base) (match-string 1)))
417 418
	    (when more
	      (erase-buffer)
419
	      (nnheader-message 7 "Searching google...(%d)" i)
420
	      (mm-url-insert more))))
421
	  ;; Return the articles in the right order.
422
	  (nnheader-message 7 "Searching google...done")
423 424 425 426
	  (setq nnweb-articles
		(sort nnweb-articles 'car-less-than-car))))))

(defun nnweb-google-search (search)
427
  (mm-url-insert
428 429 430
   (concat
    (nnweb-definition 'address)
    "?"
431
    (mm-url-encode-www-form-urlencoded
432
     `(("q" . ,search)
Miles Bader's avatar
Miles Bader committed
433 434
       ("num" . ,(number-to-string
		  (min 100 nnweb-max-hits)))
435
       ("hq" . "")
436
       ("hl" . "en")
437 438
       ("lr" . "")
       ("safe" . "off")
439 440
       ("sites" . "groups")
       ("filter" . "0")))))
441 442 443 444 445 446 447 448
  t)

(defun nnweb-google-identity (url)
  "Return an unique identifier based on URL."
  (if (string-match "selm=\\([^ &>]+\\)" url)
      (match-string 1 url)
    url))

449 450 451 452 453
;;;
;;; gmane.org
;;;
(defun nnweb-gmane-create-mapping ()
  "Perform the search and create a number-to-url alist."
454
  (with-current-buffer nnweb-buffer
455 456 457 458 459 460 461
    (let ((case-fold-search t)
	  (active (or (cadr (assoc nnweb-group nnweb-group-alist))
		      (cons 1 0)))
	  map)
      (erase-buffer)
      (nnheader-message 7 "Searching Gmane..." )
      (when (funcall (nnweb-definition 'search) nnweb-search)
462
	(goto-char (point-min))
463 464 465 466 467 468 469 470 471 472
	;; Skip the status line
	(forward-line 1)
	;; Thanks to Olly Betts we now have NOV lines in our buffer!
	(while (not (eobp))
	  (unless (or (eolp) (looking-at "\x0d"))
	    (let ((header (nnheader-parse-nov)))
	      (let ((xref (mail-header-xref header))
		    (from (mail-header-from header))
		    (subject (mail-header-subject header))
		    (rfc2047-encoding-type 'mime))
Miles Bader's avatar
Miles Bader committed
473
		(when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
474 475 476 477 478 479 480 481 482 483 484 485 486 487 488
		  (mail-header-set-xref
		   header
		   (format "http://article.gmane.org/%s/%s/raw"
			   (match-string 1 xref)
			   (match-string 2 xref))))

		;; Add host part to gmane-encrypted addresses
		(when (string-match "@$" from)
		  (mail-header-set-from header
					(concat from "public.gmane.org")))

		(mail-header-set-subject header
					 (rfc2047-encode-string subject))

		(unless (nnweb-get-hashtb (mail-header-xref header))
Miles Bader's avatar
Miles Bader committed
489 490
		  (mail-header-set-number header (incf (cdr active)))
		  (push (list (mail-header-number header) header) map)
491 492 493 494 495
		  (nnweb-set-hashtb (cadar map) (car map))))))
	  (forward-line 1)))
      (nnheader-message 7 "Searching Gmane...done")
      (setq nnweb-articles
	    (sort (nconc nnweb-articles map) 'car-less-than-car)))))
496 497 498 499

(defun nnweb-gmane-wash-article ()
  (let ((case-fold-search t))
    (goto-char (point-min))
500 501 502 503 504 505 506
    (when (search-forward "<!--X-Head-of-Message-->" nil t)
      (delete-region (point-min) (point))
      (goto-char (point-min))
      (while (looking-at "^<li><em>\\([^ ]+\\)</em>.*</li>")
	(replace-match "\\1\\2" t)
	(forward-line 1))
      (mm-url-remove-markup))))
507 508 509 510 511 512 513

(defun nnweb-gmane-search (search)
  (mm-url-insert
   (concat
    (nnweb-definition 'address)
    "?"
    (mm-url-encode-www-form-urlencoded
514
     `(("query" . ,search)
515 516 517
       ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))
       ;;("TOPDOC" . "1000")
       ))))
518
  (setq buffer-file-name nil)
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
519
  (unless (featurep 'xemacs) (set-buffer-multibyte t))
520
  (mm-decode-coding-region (point-min) (point-max) 'utf-8)
521 522 523 524 525 526 527 528
  t)

(defun nnweb-gmane-identity (url)
  "Return a unique identifier based on URL."
  (if (string-match "group=\\(.+\\)" url)
      (match-string 1 url)
    url))

529 530 531 532 533 534 535
;;;
;;; General web/w3 interface utility functions
;;;

(defun nnweb-insert-html (parse)
  "Insert HTML based on a w3 parse tree."
  (if (stringp parse)
536 537 538 539 540
      ;; 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)
541 542 543 544 545 546 547 548 549 550 551
    (insert "<" (symbol-name (car parse)) " ")
    (insert (mapconcat
	     (lambda (param)
	       (concat (symbol-name (car param)) "="
		       (prin1-to-string
			(if (consp (cdr param))
			    (cadr param)
			  (cdr param)))))
	     (nth 1 parse)
	     " "))
    (insert ">\n")
552
    (mapc 'nnweb-insert-html (nth 2 parse))
553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603
    (insert "</" (symbol-name (car parse)) ">\n")))

(defun nnweb-parse-find (type parse &optional maxdepth)
  "Find the element of TYPE in PARSE."
  (catch 'found
    (nnweb-parse-find-1 type parse maxdepth)))

(defun nnweb-parse-find-1 (type contents maxdepth)
  (when (or (null maxdepth)
	    (not (zerop maxdepth)))
    (when (consp contents)
      (when (eq (car contents) type)
	(throw 'found contents))
      (when (listp (cdr contents))
	(dolist (element contents)
	  (when (consp element)
	    (nnweb-parse-find-1 type element
				(and maxdepth (1- maxdepth)))))))))

(defun nnweb-parse-find-all (type parse)
  "Find all elements of TYPE in PARSE."
  (catch 'found
    (nnweb-parse-find-all-1 type parse)))

(defun nnweb-parse-find-all-1 (type contents)
  (let (result)
    (when (consp contents)
      (if (eq (car contents) type)
	  (push contents result)
	(when (listp (cdr contents))
	  (dolist (element contents)
	    (when (consp element)
	      (setq result
		    (nconc result (nnweb-parse-find-all-1 type element))))))))
    result))

(defvar nnweb-text)
(defun nnweb-text (parse)
  "Return a list of text contents in PARSE."
  (let ((nnweb-text nil))
    (nnweb-text-1 parse)
    (nreverse nnweb-text)))

(defun nnweb-text-1 (contents)
  (dolist (element contents)
    (if (stringp element)
	(push element nnweb-text)
      (when (and (consp element)
		 (listp (cdr element)))
	(nnweb-text-1 element)))))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
604 605 606
(provide 'nnweb)

;;; nnweb.el ends here