Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnsoup.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children 360340f9fd5f
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; nnsoup.el --- SOUP access for Gnus 1 ;;; nnsoup.el --- SOUP access for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Keywords: news, mail 6 ;; Keywords: news, mail
7 7
54 "Active file.") 54 "Active file.")
55 55
56 (defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz" 56 (defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
57 "Format string command for packing a SOUP packet. 57 "Format string command for packing a SOUP packet.
58 The SOUP files will be inserted where the %s is in the string. 58 The SOUP files will be inserted where the %s is in the string.
59 This string MUST contain both %s and %d. The file number will be 59 This string MUST contain both %s and %d. The file number will be
60 inserted where %d appears.") 60 inserted where %d appears.")
61 61
62 (defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -" 62 (defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
63 "*Format string command for unpacking a SOUP packet. 63 "*Format string command for unpacking a SOUP packet.
64 The SOUP packet file name will be inserted at the %s.") 64 The SOUP packet file name will be inserted at the %s.")
79 (defvoo nnsoup-current-prefix 0) 79 (defvoo nnsoup-current-prefix 0)
80 (defvoo nnsoup-replies-list nil) 80 (defvoo nnsoup-replies-list nil)
81 (defvoo nnsoup-buffers nil) 81 (defvoo nnsoup-buffers nil)
82 (defvoo nnsoup-current-group nil) 82 (defvoo nnsoup-current-group nil)
83 (defvoo nnsoup-group-alist-touched nil) 83 (defvoo nnsoup-group-alist-touched nil)
84 (defvoo nnsoup-article-alist nil)
84 85
85 86
86 87
87 ;;; Interface functions. 88 ;;; Interface functions.
88 89
229 (let ((active (cadr (assoc group nnsoup-group-alist)))) 230 (let ((active (cadr (assoc group nnsoup-group-alist))))
230 (if (not active) 231 (if (not active)
231 (nnheader-report 'nnsoup "No such group: %s" group) 232 (nnheader-report 'nnsoup "No such group: %s" group)
232 (nnheader-insert 233 (nnheader-insert
233 "211 %d %d %d %s\n" 234 "211 %d %d %d %s\n"
234 (max (1+ (- (cdr active) (car active))) 0) 235 (max (1+ (- (cdr active) (car active))) 0)
235 (car active) (cdr active) group))))) 236 (car active) (cdr active) group)))))
236 237
237 (deffoo nnsoup-request-type (group &optional article) 238 (deffoo nnsoup-request-type (group &optional article)
238 (nnsoup-possibly-change-group group) 239 (nnsoup-possibly-change-group group)
240 ;; Try to guess the type based on the first articl ein the group.
241 (when (not article)
242 (setq article
243 (cdaar (cddr (assoc group nnsoup-group-alist)))))
239 (if (not article) 244 (if (not article)
240 'unknown 245 'unknown
241 (let ((kind (gnus-soup-encoding-kind 246 (let ((kind (gnus-soup-encoding-kind
242 (gnus-soup-area-encoding 247 (gnus-soup-area-encoding
243 (nth 1 (nnsoup-article-to-area 248 (nth 1 (nnsoup-article-to-area
308 (nnsoup-file prefix t))))) 313 (nnsoup-file prefix t)))))
309 (gnus-sublist-p articles range-list) 314 (gnus-sublist-p articles range-list)
310 ;; This file is old enough. 315 ;; This file is old enough.
311 (nnmail-expired-article-p group mod-time force)) 316 (nnmail-expired-article-p group mod-time force))
312 ;; Ok, we delete this file. 317 ;; Ok, we delete this file.
313 (when (condition-case nil 318 (when (ignore-errors
314 (progn 319 (nnheader-message
315 (nnheader-message 320 5 "Deleting %s in group %s..." (nnsoup-file prefix)
316 5 "Deleting %s in group %s..." (nnsoup-file prefix) 321 group)
317 group) 322 (when (file-exists-p (nnsoup-file prefix))
318 (when (file-exists-p (nnsoup-file prefix)) 323 (delete-file (nnsoup-file prefix)))
319 (delete-file (nnsoup-file prefix))) 324 (nnheader-message
320 (nnheader-message 325 5 "Deleting %s in group %s..." (nnsoup-file prefix t)
321 5 "Deleting %s in group %s..." (nnsoup-file prefix t) 326 group)
322 group) 327 (when (file-exists-p (nnsoup-file prefix t))
323 (when (file-exists-p (nnsoup-file prefix t)) 328 (delete-file (nnsoup-file prefix t)))
324 (delete-file (nnsoup-file prefix t))) 329 t)
325 t)
326 (error nil))
327 (setcdr (cdr total-infolist) (delq info (cddr total-infolist))) 330 (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
328 (setq articles (gnus-sorted-complement articles range-list)))) 331 (setq articles (gnus-sorted-complement articles range-list))))
329 (when (not mod-time) 332 (when (not mod-time)
330 (setcdr (cdr total-infolist) (delq info (cddr total-infolist))))) 333 (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
331 (if (cddr total-infolist) 334 (if (cddr total-infolist)
337 340
338 341
339 ;;; Internal functions 342 ;;; Internal functions
340 343
341 (defun nnsoup-possibly-change-group (group &optional force) 344 (defun nnsoup-possibly-change-group (group &optional force)
342 (if group 345 (when (and group
343 (setq nnsoup-current-group group) 346 (not (equal nnsoup-current-group group)))
344 t)) 347 (setq nnsoup-article-alist nil)
348 (setq nnsoup-current-group group))
349 t)
345 350
346 (defun nnsoup-read-active-file () 351 (defun nnsoup-read-active-file ()
347 (setq nnsoup-group-alist nil) 352 (setq nnsoup-group-alist nil)
348 (when (file-exists-p nnsoup-active-file) 353 (when (file-exists-p nnsoup-active-file)
349 (condition-case () 354 (ignore-errors
350 (load nnsoup-active-file t t t) 355 (load nnsoup-active-file t t t))
351 (error nil))
352 ;; Be backwards compatible. 356 ;; Be backwards compatible.
353 (when (and nnsoup-group-alist 357 (when (and nnsoup-group-alist
354 (not (atom (caadar nnsoup-group-alist)))) 358 (not (atom (caadar nnsoup-group-alist))))
355 (let ((alist nnsoup-group-alist) 359 (let ((alist nnsoup-group-alist)
356 entry e min max) 360 entry e min max)
367 (when (and nnsoup-group-alist 371 (when (and nnsoup-group-alist
368 (or force 372 (or force
369 nnsoup-group-alist-touched)) 373 nnsoup-group-alist-touched))
370 (setq nnsoup-group-alist-touched nil) 374 (setq nnsoup-group-alist-touched nil)
371 (nnheader-temp-write nnsoup-active-file 375 (nnheader-temp-write nnsoup-active-file
372 (let ((standard-output (current-buffer))) 376 (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
373 (prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist)) 377 (insert "\n")
374 (insert "\n") 378 (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
375 (prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix)) 379 (insert "\n"))))
376 (insert "\n")))))
377 380
378 (defun nnsoup-next-prefix () 381 (defun nnsoup-next-prefix ()
379 "Return the next free prefix." 382 "Return the next free prefix."
380 (let (prefix) 383 (let (prefix)
381 (while (or (file-exists-p 384 (while (or (file-exists-p
384 (file-exists-p (nnsoup-file prefix t))) 387 (file-exists-p (nnsoup-file prefix t)))
385 (incf nnsoup-current-prefix)) 388 (incf nnsoup-current-prefix))
386 (incf nnsoup-current-prefix) 389 (incf nnsoup-current-prefix)
387 prefix)) 390 prefix))
388 391
392 (defun nnsoup-file-name (dir file)
393 "Return the full path of FILE (in any case) in DIR."
394 (let* ((case-fold-search t)
395 (files (directory-files dir t))
396 (regexp (concat (regexp-quote file) "$")))
397 (car (delq nil
398 (mapcar
399 (lambda (file)
400 (if (string-match regexp file)
401 file
402 nil))
403 files)))))
404
389 (defun nnsoup-read-areas () 405 (defun nnsoup-read-areas ()
390 (save-excursion 406 (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas")))
391 (set-buffer nntp-server-buffer) 407 (when areas-file
392 (let ((areas (gnus-soup-parse-areas (concat nnsoup-tmp-directory "AREAS"))) 408 (save-excursion
393 entry number area lnum cur-prefix file) 409 (set-buffer nntp-server-buffer)
394 ;; Go through all areas in the new AREAS file. 410 (let ((areas (gnus-soup-parse-areas areas-file))
395 (while (setq area (pop areas)) 411 entry number area lnum cur-prefix file)
396 ;; Change the name to the permanent name and move the files. 412 ;; Go through all areas in the new AREAS file.
397 (setq cur-prefix (nnsoup-next-prefix)) 413 (while (setq area (pop areas))
398 (message "Incorporating file %s..." cur-prefix) 414 ;; Change the name to the permanent name and move the files.
399 (when (file-exists-p 415 (setq cur-prefix (nnsoup-next-prefix))
400 (setq file (concat nnsoup-tmp-directory 416 (message "Incorporating file %s..." cur-prefix)
401 (gnus-soup-area-prefix area) ".IDX"))) 417 (when (file-exists-p
402 (rename-file file (nnsoup-file cur-prefix))) 418 (setq file (concat nnsoup-tmp-directory
403 (when (file-exists-p 419 (gnus-soup-area-prefix area) ".IDX")))
404 (setq file (concat nnsoup-tmp-directory 420 (rename-file file (nnsoup-file cur-prefix)))
405 (gnus-soup-area-prefix area) ".MSG"))) 421 (when (file-exists-p
406 (rename-file file (nnsoup-file cur-prefix t)) 422 (setq file (concat nnsoup-tmp-directory
407 (gnus-soup-set-area-prefix area cur-prefix) 423 (gnus-soup-area-prefix area) ".MSG")))
408 ;; Find the number of new articles in this area. 424 (rename-file file (nnsoup-file cur-prefix t))
409 (setq number (nnsoup-number-of-articles area)) 425 (gnus-soup-set-area-prefix area cur-prefix)
410 (if (not (setq entry (assoc (gnus-soup-area-name area) 426 ;; Find the number of new articles in this area.
411 nnsoup-group-alist))) 427 (setq number (nnsoup-number-of-articles area))
412 ;; If this is a new area (group), we just add this info to 428 (if (not (setq entry (assoc (gnus-soup-area-name area)
413 ;; the group alist. 429 nnsoup-group-alist)))
414 (push (list (gnus-soup-area-name area) 430 ;; If this is a new area (group), we just add this info to
415 (cons 1 number) 431 ;; the group alist.
416 (list (cons 1 number) area)) 432 (push (list (gnus-soup-area-name area)
417 nnsoup-group-alist) 433 (cons 1 number)
418 ;; There are already articles in this group, so we add this 434 (list (cons 1 number) area))
419 ;; info to the end of the entry. 435 nnsoup-group-alist)
420 (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry))) 436 ;; There are already articles in this group, so we add this
421 (+ lnum number)) 437 ;; info to the end of the entry.
422 area))) 438 (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
423 (setcdr (cadr entry) (+ lnum number)))))) 439 (+ lnum number))
424 (nnsoup-write-active-file t) 440 area)))
425 (delete-file (concat nnsoup-tmp-directory "AREAS")))) 441 (setcdr (cadr entry) (+ lnum number))))))
442 (nnsoup-write-active-file t)
443 (delete-file areas-file)))))
426 444
427 (defun nnsoup-number-of-articles (area) 445 (defun nnsoup-number-of-articles (area)
428 (save-excursion 446 (save-excursion
429 (cond 447 (cond
430 ;; If the number is in the area info, we just return it. 448 ;; If the number is in the area info, we just return it.
436 (count-lines (point-min) (point-max))) 454 (count-lines (point-min) (point-max)))
437 ;; We do it the hard way - re-searching through the message 455 ;; We do it the hard way - re-searching through the message
438 ;; buffer. 456 ;; buffer.
439 (t 457 (t
440 (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) 458 (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
441 (goto-char (point-min)) 459 (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
442 (let ((regexp (nnsoup-header (gnus-soup-encoding-format 460 (nnsoup-dissect-buffer area))
443 (gnus-soup-area-encoding area)))) 461 (length (cdr (assoc (gnus-soup-area-prefix area)
444 (num 0)) 462 nnsoup-article-alist)))))))
445 (while (re-search-forward regexp nil t) 463
446 (setq num (1+ num))) 464 (defun nnsoup-dissect-buffer (area)
447 num))))) 465 (let ((mbox-delim (concat "^" message-unix-mail-delimiter))
466 (format (gnus-soup-encoding-format (gnus-soup-area-encoding area)))
467 (i 0)
468 alist len)
469 (goto-char (point-min))
470 (cond
471 ;; rnews batch format
472 ((= format ?n)
473 (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
474 (forward-line 1)
475 (push (list
476 (incf i) (point)
477 (progn
478 (forward-char (string-to-number (match-string 1)))
479 (point)))
480 alist)))
481 ;; Unix mbox format
482 ((= format ?m)
483 (while (looking-at mbox-delim)
484 (forward-line 1)
485 (push (list
486 (incf i) (point)
487 (progn
488 (if (re-search-forward mbox-delim nil t)
489 (beginning-of-line)
490 (goto-char (point-max)))
491 (point)))
492 alist)))
493 ;; MMDF format
494 ((= format ?M)
495 (while (looking-at "\^A\^A\^A\^A\n")
496 (forward-line 1)
497 (push (list
498 (incf i) (point)
499 (progn
500 (if (search-forward "\n\^A\^A\^A\^A\n" nil t)
501 (beginning-of-line)
502 (goto-char (point-max)))
503 (point)))
504 alist)))
505 ;; Binary format
506 ((or (= format ?B) (= format ?b))
507 (while (not (eobp))
508 (setq len (+ (* (char-after (point)) (expt 2.0 24))
509 (* (char-after (+ (point) 1)) (expt 2 16))
510 (* (char-after (+ (point) 2)) (expt 2 8))
511 (char-after (+ (point) 3))))
512 (push (list
513 (incf i) (+ (point) 4)
514 (progn
515 (forward-char (floor (+ len 4)))
516 (point)))
517 alist)))
518 (t
519 (error "Unknown format: %c" format)))
520 (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist)))
448 521
449 (defun nnsoup-index-buffer (prefix &optional message) 522 (defun nnsoup-index-buffer (prefix &optional message)
450 (let* ((file (concat prefix (if message ".MSG" ".IDX"))) 523 (let* ((file (concat prefix (if message ".MSG" ".IDX")))
451 (buffer-name (concat " *nnsoup " file "*"))) 524 (buffer-name (concat " *nnsoup " file "*")))
452 (or (get-buffer buffer-name) ; File aready loaded. 525 (or (get-buffer buffer-name) ; File already loaded.
453 (when (file-exists-p (concat nnsoup-directory file)) 526 (when (file-exists-p (concat nnsoup-directory file))
454 (save-excursion ; Load the file. 527 (save-excursion ; Load the file.
455 (set-buffer (get-buffer-create buffer-name)) 528 (set-buffer (get-buffer-create buffer-name))
456 (buffer-disable-undo (current-buffer)) 529 (buffer-disable-undo (current-buffer))
457 (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers) 530 (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
458 (insert-file-contents (concat nnsoup-directory file)) 531 (nnheader-insert-file-contents (concat nnsoup-directory file))
459 (current-buffer)))))) 532 (current-buffer))))))
460 533
461 (defun nnsoup-file (prefix &optional message) 534 (defun nnsoup-file (prefix &optional message)
462 (expand-file-name 535 (expand-file-name
463 (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))) 536 (concat nnsoup-directory prefix (if message ".MSG" ".IDX"))))
488 (save-excursion 561 (save-excursion
489 (cond 562 (cond
490 ;; There is no MSG file. 563 ;; There is no MSG file.
491 ((null msg-buf) 564 ((null msg-buf)
492 nil) 565 nil)
493 566 ;; We use the index file to find out where the article
494 ;; We use the index file to find out where the article begins and ends. 567 ;; begins and ends.
495 ((and (= (gnus-soup-encoding-index 568 ((and (= (gnus-soup-encoding-index
496 (gnus-soup-area-encoding (nth 1 area))) 569 (gnus-soup-area-encoding (nth 1 area)))
497 ?c) 570 ?c)
498 (file-exists-p (nnsoup-file prefix))) 571 (file-exists-p (nnsoup-file prefix)))
499 (set-buffer (nnsoup-index-buffer prefix)) 572 (set-buffer (nnsoup-index-buffer prefix))
508 (set-buffer msg-buf) 581 (set-buffer msg-buf)
509 (widen) 582 (widen)
510 (let ((format (gnus-soup-encoding-format 583 (let ((format (gnus-soup-encoding-format
511 (gnus-soup-area-encoding (nth 1 area))))) 584 (gnus-soup-area-encoding (nth 1 area)))))
512 (goto-char end) 585 (goto-char end)
513 (if (or (= format ?n) (= format ?m)) 586 (when (or (= format ?n) (= format ?m))
514 (setq end (progn (forward-line -1) (point)))))) 587 (setq end (progn (forward-line -1) (point))))))
515 (set-buffer msg-buf)) 588 (set-buffer msg-buf))
516 (widen) 589 (widen)
517 (narrow-to-region beg (or end (point-max)))) 590 (narrow-to-region beg (or end (point-max))))
518 (t 591 (t
519 (set-buffer msg-buf) 592 (set-buffer msg-buf)
520 (widen) 593 (widen)
521 (goto-char (point-min)) 594 (unless (assoc (gnus-soup-area-prefix (nth 1 area))
522 (let ((header (nnsoup-header 595 nnsoup-article-alist)
523 (gnus-soup-encoding-format 596 (nnsoup-dissect-buffer (nth 1 area)))
524 (gnus-soup-area-encoding (nth 1 area)))))) 597 (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix
525 (re-search-forward header nil t (- article (caar area))) 598 (nth 1 area))
526 (narrow-to-region 599 nnsoup-article-alist)))))
527 (match-beginning 0) 600 (when entry
528 (if (re-search-forward header nil t) 601 (narrow-to-region (cadr entry) (caddr entry))))))
529 (match-beginning 0)
530 (point-max))))))
531 (goto-char (point-min)) 602 (goto-char (point-min))
532 (if (not head) 603 (if (not head)
533 () 604 ()
534 (narrow-to-region 605 (narrow-to-region
535 (point-min) 606 (point-min)
536 (if (search-forward "\n\n" nil t) 607 (if (search-forward "\n\n" nil t)
537 (1- (point)) 608 (1- (point))
538 (point-max)))) 609 (point-max))))
539 msg-buf)))) 610 msg-buf))))
540 611
541 (defun nnsoup-header (format)
542 (cond
543 ((= format ?n)
544 "^#! *rnews +[0-9]+ *$")
545 ((= format ?m)
546 (concat "^" message-unix-mail-delimiter))
547 ((= format ?M)
548 "^\^A\^A\^A\^A\n")
549 (t
550 (error "Unknown format: %c" format))))
551
552 ;;;###autoload 612 ;;;###autoload
553 (defun nnsoup-pack-replies () 613 (defun nnsoup-pack-replies ()
554 "Make an outbound package of SOUP replies." 614 "Make an outbound package of SOUP replies."
555 (interactive) 615 (interactive)
616 (unless (file-exists-p nnsoup-replies-directory)
617 (message "No such directory: %s" nnsoup-replies-directory))
556 ;; Write all data buffers. 618 ;; Write all data buffers.
557 (gnus-soup-save-areas) 619 (gnus-soup-save-areas)
558 ;; Write the active file. 620 ;; Write the active file.
559 (nnsoup-write-active-file) 621 (nnsoup-write-active-file)
560 ;; Write the REPLIES file. 622 ;; Write the REPLIES file.
561 (nnsoup-write-replies) 623 (nnsoup-write-replies)
624 ;; Check whether there is anything here.
625 (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
626 (error "No files to pack."))
562 ;; Pack all these files into a SOUP packet. 627 ;; Pack all these files into a SOUP packet.
563 (gnus-soup-pack nnsoup-replies-directory nnsoup-packer)) 628 (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
564 629
565 (defun nnsoup-write-replies () 630 (defun nnsoup-write-replies ()
566 "Write the REPLIES file." 631 "Write the REPLIES file."
595 (defun nnsoup-store-reply (kind) 660 (defun nnsoup-store-reply (kind)
596 ;; Mostly stolen from `message.el'. 661 ;; Mostly stolen from `message.el'.
597 (require 'mail-utils) 662 (require 'mail-utils)
598 (let ((tembuf (generate-new-buffer " message temp")) 663 (let ((tembuf (generate-new-buffer " message temp"))
599 (case-fold-search nil) 664 (case-fold-search nil)
600 (news (message-news-p))
601 (resend-to-addresses (mail-fetch-field "resent-to"))
602 delimline 665 delimline
603 (mailbuf (current-buffer))) 666 (mailbuf (current-buffer)))
604 (unwind-protect 667 (unwind-protect
605 (save-excursion 668 (save-excursion
606 (save-restriction 669 (save-restriction
618 (message-remove-header message-ignored-mail-headers t)) 681 (message-remove-header message-ignored-mail-headers t))
619 (goto-char (point-max)) 682 (goto-char (point-max))
620 ;; require one newline at the end. 683 ;; require one newline at the end.
621 (or (= (preceding-char) ?\n) 684 (or (= (preceding-char) ?\n)
622 (insert ?\n)) 685 (insert ?\n))
623 (when (and news
624 (equal kind "mail")
625 (or (mail-fetch-field "cc")
626 (mail-fetch-field "to")))
627 (message-insert-courtesy-copy))
628 (let ((case-fold-search t)) 686 (let ((case-fold-search t))
629 ;; Change header-delimiter to be what sendmail expects. 687 ;; Change header-delimiter to be what sendmail expects.
630 (goto-char (point-min)) 688 (goto-char (point-min))
631 (re-search-forward 689 (re-search-forward
632 (concat "^" (regexp-quote mail-header-separator) "\n")) 690 (concat "^" (regexp-quote mail-header-separator) "\n"))
663 (while (and replies 721 (while (and replies
664 (not (string= kind (gnus-soup-reply-kind (car replies))))) 722 (not (string= kind (gnus-soup-reply-kind (car replies)))))
665 (setq replies (cdr replies))) 723 (setq replies (cdr replies)))
666 (if replies 724 (if replies
667 (gnus-soup-reply-prefix (car replies)) 725 (gnus-soup-reply-prefix (car replies))
668 (setq nnsoup-replies-list 726 (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
669 (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory) 727 kind
670 kind 728 (format "%c%c%c"
671 (format "%c%c%c" 729 nnsoup-replies-format-type
672 nnsoup-replies-format-type 730 nnsoup-replies-index-type
673 nnsoup-replies-index-type 731 (if (string= kind "news")
674 (if (string= kind "news") 732 ?n ?m)))
675 ?n ?m))) 733 nnsoup-replies-list)
676 nnsoup-replies-list))
677 (gnus-soup-reply-prefix (car nnsoup-replies-list))))) 734 (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
678 735
679 (defun nnsoup-make-active () 736 (defun nnsoup-make-active ()
680 "(Re-)create the SOUP active file." 737 "(Re-)create the SOUP active file."
681 (interactive) 738 (interactive)
689 (set-buffer (get-buffer-create " *nnsoup work*")) 746 (set-buffer (get-buffer-create " *nnsoup work*"))
690 (buffer-disable-undo (current-buffer)) 747 (buffer-disable-undo (current-buffer))
691 (while files 748 (while files
692 (message "Doing %s..." (car files)) 749 (message "Doing %s..." (car files))
693 (erase-buffer) 750 (erase-buffer)
694 (insert-file-contents (car files)) 751 (nnheader-insert-file-contents (car files))
695 (goto-char (point-min)) 752 (goto-char (point-min))
696 (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) 753 (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
697 (setq group "unknown") 754 (setq group "unknown")
698 (setq group (match-string 2))) 755 (setq group (match-string 2)))
699 (setq lines (count-lines (point-min) (point-max))) 756 (setq lines (count-lines (point-min) (point-max)))
702 (substring 759 (substring
703 (car files) (match-beginning 1) 760 (car files) (match-beginning 1)
704 (match-end 1)))) 761 (match-end 1))))
705 (if (not (setq elem (assoc group active))) 762 (if (not (setq elem (assoc group active)))
706 (push (list group (cons 1 lines) 763 (push (list group (cons 1 lines)
707 (list (cons 1 lines) 764 (list (cons 1 lines)
708 (vector ident group "ncm" "" lines))) 765 (vector ident group "ncm" "" lines)))
709 active) 766 active)
710 (nconc elem 767 (nconc elem
711 (list 768 (list
712 (list (cons (1+ (setq min (cdadr elem))) 769 (list (cons (1+ (setq min (cdadr elem)))