cgit.sxemacs.org Git - gnus/blob - lisp/nnsoup.el

   1 ;;; nnsoup.el --- SOUP access for Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   6 ;; Keywords: news, mail
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'nnheader)
  29 (require 'nnmail)
  30 (require 'gnus-soup)
  31 (require 'gnus-msg)
  32 (eval-when-compile (require 'cl))
  33
  34 (defvar nnsoup-directory "~/SOUP/"
  35   "*SOUP packet directory.")
  36
  37 (defvar nnsoup-replies-directory (concat nnsoup-directory "replies/")
  38   "*Directory where outgoing packets will be composed.")
  39
  40 (defvar nnsoup-replies-format-type ?n
  41   "*Format of the replies packages.")
  42
  43 (defvar nnsoup-replies-index-type ?n
  44   "*Index type of the replies packages.")
  45
  46 (defvar nnsoup-active-file (concat nnsoup-directory "active")
  47   "Active file.")
  48
  49 (defvar nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
  50   "Format string command for packing a SOUP packet.
  51 The SOUP files will be inserted where the %s is in the string.
  52 This string MUST contain both %s and %d. The file number will be
  53 inserted where %d appears.")
  54
  55 (defvar nnsoup-unpacker "gunzip -c %s | tar xvf -"
  56   "*Format string command for unpacking a SOUP packet.
  57 The SOUP packet file name will be inserted at the %s.")
  58
  59 (defvar nnsoup-packet-directory "~/"
  60   "*Where nnsoup will look for incoming packets.")
  61
  62 (defvar nnsoup-packet-regexp "Soupout"
  63   "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
  64
  65 \f
  66
  67 (defconst nnsoup-version "nnsoup 0.0"
  68   "nnsoup version.")
  69
  70 (defvar nnsoup-status-string "")
  71 (defvar nnsoup-group-alist nil)
  72 (defvar nnsoup-replies-list nil)
  73 (defvar nnsoup-buffers nil)
  74 (defvar nnsoup-current-group nil)
  75
  76 \f
  77
  78 ;; Server variables.
  79
  80 (defvar nnsoup-current-server nil)
  81 (defvar nnsoup-server-alist nil)
  82 (defvar nnsoup-server-variables
  83   (list
  84    (list 'nnsoup-directory nnsoup-directory)
  85    (list 'nnsoup-active-file nnsoup-active-file)
  86    '(nnsoup-status-string "")
  87    '(nnsoup-group-alist nil)))
  88
  89 \f
  90
  91 ;;; Interface functions.
  92
  93 (defun nnsoup-retrieve-headers (sequence &optional group server fetch-old)
  94   (nnsoup-possibly-change-group group)
  95   (save-excursion
  96     (set-buffer nntp-server-buffer)
  97     (erase-buffer)
  98     (let ((areas (cdr (assoc nnsoup-current-group nnsoup-group-alist)))
  99           (articles sequence)
 100           (use-nov t)
 101           useful-areas this-area-seq)
 102       (if (stringp (car sequence))
 103           ;; We don't support fetching by Message-ID.
 104           'headers
 105         ;; We go through all the areas and find which files the
 106         ;; articles in SEQUENCE come from.
 107         (while (and areas sequence)
 108           ;; Peel off areas that are below sequence.
 109           (while (and areas (< (cdr (car (car areas))) (car sequence)))
 110             (setq areas (cdr areas)))
 111           (when areas
 112             ;; This is a useful area.
 113             (push (car areas) useful-areas)
 114             (setq this-area-seq nil)
 115             ;; We take note whether this MSG has a corresponding IDX
 116             ;; for later use.
 117             (when (or (= (gnus-soup-encoding-index
 118                           (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
 119                       (not (file-exists-p
 120                             (nnsoup-file
 121                              (gnus-soup-area-prefix (nth 1 (car areas)))))))
 122               (setq use-nov nil))
 123             ;; We assign the portion of `sequence' that is relevant to
 124             ;; this MSG packet to this packet.
 125             (while (and sequence (<= (car sequence) (cdr (car (car areas)))))
 126               (push (car sequence) this-area-seq)
 127               (setq sequence (cdr sequence)))
 128             (setcar useful-areas (cons (nreverse this-area-seq)
 129                                        (car useful-areas)))))
 130
 131         ;; We now have a list of article numbers and corresponding
 132         ;; areas.
 133         (setq useful-areas (nreverse useful-areas))
 134
 135         ;; Two different approaches depending on whether all the MSG
 136         ;; files have corresponding IDX files.  If they all do, we
 137         ;; simply return the relevant IDX files and let Gnus sort out
 138         ;; what lines are relevant.  If some of the IDX files are
 139         ;; missing, we must return HEADs for all the articles.
 140         (if use-nov
 141             ;; We have IDX files for all areas.
 142             (progn
 143               (while useful-areas
 144                 (goto-char (point-max))
 145                 (let ((b (point))
 146                       (number (car (nth 1 (car useful-areas)))))
 147                   (insert-buffer-substring
 148                    (nnsoup-index-buffer
 149                     (gnus-soup-area-prefix
 150                      (nth 2 (car useful-areas)))))
 151                   (goto-char b)
 152                   ;; We have to remove the index number entires and
 153                   ;; insert article numbers instead.
 154                   (while (looking-at "[0-9]+")
 155                     (replace-match (int-to-string number) t t)
 156                     (incf number)
 157                     (forward-line 1)))
 158                 (setq useful-areas (cdr useful-areas)))
 159               'nov)
 160           ;; We insert HEADs.
 161           (while useful-areas
 162             (setq articles (car (car useful-areas))
 163                   useful-areas (cdr useful-areas))
 164             (while articles
 165               (goto-char (point-max))
 166               (insert (format "221 %d Article retrieved.\n" (car articles)))
 167               (insert-buffer-substring
 168                (nnsoup-narrow-to-article
 169                 (car articles) (cdr (car useful-areas)) 'head))
 170               (goto-char (point-max))
 171               (insert ".\n")
 172               (setq articles (cdr articles))))
 173
 174           ;; Fold continuation lines.
 175           (goto-char (point-min))
 176           (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 177             (replace-match " " t t))
 178           'headers)))))
 179
 180 (defun nnsoup-open-server (server &optional defs)
 181   (nnheader-init-server-buffer)
 182   (if (equal server nnsoup-current-server)
 183       t
 184     (if nnsoup-current-server
 185         (setq nnsoup-server-alist
 186               (cons (list nnsoup-current-server
 187                           (nnheader-save-variables nnsoup-server-variables))
 188                     nnsoup-server-alist)))
 189     (let ((state (assoc server nnsoup-server-alist)))
 190       (if state
 191           (progn
 192             (nnheader-restore-variables (nth 1 state))
 193             (setq nnsoup-server-alist (delq state nnsoup-server-alist)))
 194         (nnheader-set-init-variables nnsoup-server-variables defs)))
 195     (setq nnsoup-current-server server))
 196   (nnsoup-read-active-file))
 197
 198 (defun nnsoup-request-close ()
 199   (nnsoup-write-active-file)
 200   (nnsoup-write-replies)
 201   (gnus-soup-save-areas)
 202   ;; Kill all nnsoup buffers.
 203   (let (buffer)
 204     (while nnsoup-buffers
 205       (setq buffer (cdr (pop nnsoup-buffers)))
 206       (and buffer
 207            (buffer-name buffer)
 208            (kill-buffer buffer))))
 209   (setq nnsoup-group-alist nil
 210         nnsoup-current-group nil
 211         nnsoup-current-server nil
 212         nnsoup-server-alist nil
 213         nnsoup-replies-list nil)
 214   t)
 215
 216 (defun nnsoup-close-server (&optional server)
 217   t)
 218
 219 (defun nnsoup-server-opened (&optional server)
 220   (and (equal server nnsoup-current-server)
 221        nntp-server-buffer
 222        (buffer-name nntp-server-buffer)))
 223
 224 (defun nnsoup-status-message (&optional server)
 225   nnsoup-status-string)
 226
 227 (defun nnsoup-request-article (id &optional newsgroup server buffer)
 228   (nnsoup-possibly-change-group newsgroup)
 229   (let ((buffer (or buffer nntp-server-buffer)))
 230     (save-excursion
 231       (set-buffer buffer)
 232       (erase-buffer)
 233       (if (stringp id)
 234           ()
 235         (insert-buffer-substring
 236          (nnsoup-narrow-to-article id))
 237         t))))
 238
 239 (defun nnsoup-request-group (group &optional server dont-check)
 240   (nnsoup-possibly-change-group group)
 241   (if dont-check
 242       ()
 243     (let ((area (cdr (assoc group nnsoup-group-alist)))
 244           min max)
 245       (save-excursion
 246         (set-buffer nntp-server-buffer)
 247         (erase-buffer)
 248         (setq min (car (car (car area))))
 249         (while (cdr area)
 250           (setq area (cdr area)))
 251         (setq max (cdr (car (car area))))
 252         (insert (format "211 %d %d %d %s\n"
 253                         (max (1+ (- max min)) 0) min max group)))))
 254   t)
 255
 256 (defun nnsoup-close-group (group &optional server)
 257   ;; Kill all nnsoup buffers.
 258   (let ((buffers nnsoup-buffers)
 259         elem)
 260     (while buffers
 261       (when (equal (car (setq elem (pop buffers))) group)
 262         (setq nnsoup-buffers (delq elem nnsoup-buffers))
 263         (and (cdr elem) (buffer-name (cdr elem))
 264              (kill-buffer (cdr elem))))))
 265   t)
 266
 267 (defun nnsoup-request-list (&optional server)
 268   (save-excursion
 269     (set-buffer nntp-server-buffer)
 270     (erase-buffer)
 271     (let ((alist nnsoup-group-alist)
 272           min)
 273       (while alist
 274         (setq min (car (car (nth 1 (car alist)))))
 275         (insert (format "%s %d %d y\n" (car (car alist))
 276                         (let ((areas (car alist)))
 277                           (while (cdr areas)
 278                             (setq areas (cdr areas)))
 279                           (cdr (car (car areas)))) min))
 280         (setq alist (cdr alist)))
 281       t)))
 282
 283 (defun nnsoup-request-scan (group &optional server)
 284   (or nnsoup-group-alist (nnsoup-read-areas))
 285   (nnsoup-unpack-packets))
 286
 287 (defun nnsoup-request-newgroups (date &optional server)
 288   (nnsoup-request-list))
 289
 290 (defun nnsoup-request-list-newsgroups (&optional server)
 291   nil)
 292
 293 (defun nnsoup-request-post (&optional server)
 294   (nnsoup-store-reply "news")
 295   t)
 296
 297 (defun nnsoup-request-mail ()
 298   (nnsoup-store-reply "mail")
 299   t)
 300
 301 (defun nnsoup-request-expire-articles (articles group &optional server force)
 302   (nnsoup-possibly-change-group group)
 303   (let* ((days (or (and nnmail-expiry-wait-function
 304                         (funcall nnmail-expiry-wait-function group))
 305                    nnmail-expiry-wait))
 306          (total-infolist (assoc group nnsoup-group-alist))
 307          (infolist (cdr total-infolist))
 308          info range-list mod-time prefix)
 309     (while infolist
 310       (setq info (pop infolist)
 311             range-list (gnus-uncompress-range (car info))
 312             prefix (gnus-soup-area-prefix (nth 1 info)))
 313       (when ;; All the articles in this file are marked for expiry.
 314           (and (gnus-sublist-p articles range-list)
 315                ;; This file is old enough.  We have to check for
 316                ;; `(0 0)', since that's what ange-ftp files reply with.
 317                (or force
 318                    (and (not (equal
 319                               (setq mod-time (nth 5 (nnsoup-file prefix)))
 320                               '(0 0)))
 321                         (> (nnmail-days-between
 322                             (current-time-string)
 323                             (current-time-string mod-time))
 324                            days))))
 325         ;; Ok, we delete this file.
 326         (when (condition-case nil
 327                   (and
 328                    (delete-file (nnsoup-file prefix))
 329                    (delete-file (nnsoup-file prefix) t)
 330                    t)
 331                 (error nil))
 332           (setcdr total-infolist (delq info total-infolist))
 333           (setq articles (gnus-sorted-complement articles range-list)))))
 334     (nnsoup-write-active-file)
 335     ;; Return the articles that weren't expired.
 336     articles))
 337
 338 \f
 339 ;;; Internal functions
 340
 341 (defun nnsoup-possibly-change-group (group &optional force)
 342   (if group
 343       (setq nnsoup-current-group group)
 344     t))
 345
 346 (defun nnsoup-read-active-file ()
 347   (if (file-exists-p nnsoup-active-file)
 348       (condition-case ()
 349           (load nnsoup-active-file)
 350         (error nil))))
 351
 352 (defun nnsoup-write-active-file ()
 353   (when nnsoup-group-alist
 354     (save-excursion
 355       (set-buffer (get-buffer-create " *nnsoup work*"))
 356       (buffer-disable-undo (current-buffer))
 357       (erase-buffer)
 358       (insert (format "(setq nnsoup-group-alist '%S)\n" nnsoup-group-alist))
 359       (write-region (point-min) (point-max) nnsoup-active-file
 360                     nil 'silent)
 361       (kill-buffer (current-buffer)))))
 362
 363 (defun nnsoup-read-areas ()
 364   (save-excursion
 365     (set-buffer nntp-server-buffer)
 366     (let ((areas (gnus-soup-parse-areas (concat nnsoup-directory "AREAS")))
 367           entry number area lnum)
 368       ;; Go through all areas in the new AREAS file.
 369       (while areas
 370         (setq area (car areas)
 371               areas (cdr areas))
 372         ;; Find the number of new articles in this area.
 373         (setq number (nnsoup-number-of-articles area))
 374         (if (not (setq entry (assoc (gnus-soup-area-name area)
 375                                     nnsoup-group-alist)))
 376             ;; If this is a new area (group), we just add this info to
 377             ;; the group alist.
 378             (setq nnsoup-group-alist
 379                   (cons (list (gnus-soup-area-name area)
 380                               (list (cons 1 number) area))
 381                         nnsoup-group-alist))
 382           ;; There are already articles in this group, so we add this
 383           ;; info to the end of the entry.
 384           (let ((e (cdr entry)))
 385             (while (cdr e)
 386               (setq e (cdr e)))
 387             (setcdr e (list (list (cons (setq lnum (1+ (cdr (car (car e)))))
 388                                         (+ lnum number))
 389                                   area)))))))
 390     (nnsoup-write-active-file)))
 391
 392 (defun nnsoup-number-of-articles (area)
 393   (save-excursion
 394     (cond
 395      ;; If the number is in the area info, we just return it.
 396      ((gnus-soup-area-number area)
 397       (gnus-soup-area-number area))
 398      ;; If there is an index file, we just count the lines.
 399      ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
 400       (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
 401       (count-lines (point-min) (point-max)))
 402      ;; We do it the hard way - re-searching through the message
 403      ;; buffer.
 404      (t
 405       (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
 406       (goto-char (point-min))
 407       (let ((regexp (nnsoup-header (gnus-soup-encoding-format
 408                                     (gnus-soup-area-encoding area))))
 409             (num 0))
 410         (while (re-search-forward regexp nil t)
 411           (setq num (1+ num)))
 412         num)))))
 413
 414 (defun nnsoup-index-buffer (prefix &optional message)
 415   (let* ((file (concat prefix (if message ".MSG" ".IDX")))
 416          (buffer-name (concat " *nnsoup " file "*")))
 417     (or (get-buffer buffer-name)        ; File aready loaded.
 418         (save-excursion                 ; Load the file.
 419           (set-buffer (get-buffer-create buffer-name))
 420           (buffer-disable-undo (current-buffer))
 421           (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
 422           (insert-file-contents (concat nnsoup-directory file))
 423           (current-buffer)))))
 424
 425 (defun nnsoup-file (prefix &optional message)
 426   (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))
 427
 428 (defun nnsoup-message-buffer (prefix)
 429   (nnsoup-index-buffer prefix 'msg))
 430
 431 (defun nnsoup-unpack-packets ()
 432   (let ((packets (directory-files
 433                   nnsoup-packet-directory t nnsoup-packet-regexp))
 434         msg)
 435     (while packets
 436       (message (setq msg (format "nnsoup: unpacking %s..." (car packets))))
 437       (gnus-soup-unpack-packet nnsoup-directory nnsoup-unpacker (car packets))
 438       (delete-file (car packets))
 439       (nnsoup-read-areas)
 440       (message "%sdone" msg)
 441       (setq packets (cdr packets)))))
 442
 443 (defun nnsoup-narrow-to-article (article &optional area head)
 444   (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
 445          (prefix (gnus-soup-area-prefix (nth 1 area)))
 446          beg end msg-buf)
 447     (setq msg-buf (nnsoup-index-buffer prefix 'msg))
 448     (save-excursion
 449       (cond
 450        ;; We use the index file to find out where the article begins and ends.
 451        ((and (= (gnus-soup-encoding-index
 452                  (gnus-soup-area-encoding (nth 1 area)))
 453                 ?c)
 454              (file-exists-p (nnsoup-file prefix)))
 455         (set-buffer (nnsoup-index-buffer prefix))
 456         (widen)
 457         (goto-char (point-min))
 458         (forward-line (- article (car (car area))))
 459         (setq beg (read (current-buffer)))
 460         (forward-line 1)
 461         (if (looking-at "[0-9]+")
 462             (progn
 463               (setq end (read (current-buffer)))
 464               (set-buffer msg-buf)
 465               (widen)
 466               (let ((format (gnus-soup-encoding-format
 467                              (gnus-soup-area-encoding (nth 1 area)))))
 468                 (goto-char end)
 469                 (if (or (= format ?n) (= format ?m))
 470                     (setq end (progn (forward-line -1) (point))))))
 471           (set-buffer msg-buf))
 472         (widen)
 473         (narrow-to-region beg (or end (point-max))))
 474        (t
 475         (set-buffer msg-buf)
 476         (widen)
 477         (goto-char (point-min))
 478         (let ((header (nnsoup-header
 479                        (gnus-soup-encoding-format
 480                         (gnus-soup-area-encoding (nth 1 area))))))
 481           (re-search-forward header nil t (- article (car (car area))))
 482           (narrow-to-region
 483            (match-beginning 0)
 484            (if (re-search-forward header nil t)
 485                (match-beginning 0)
 486              (point-max))))))
 487       (goto-char (point-min))
 488       (if (not head)
 489           ()
 490         (narrow-to-region
 491          (point-min)
 492          (if (search-forward "\n\n" nil t)
 493              (1- (point))
 494            (point-max))))
 495       msg-buf)))
 496
 497 (defun nnsoup-header (format)
 498   (cond
 499    ((= format ?n)
 500     "^#! *rnews +[0-9]+ *$")
 501    ((= format ?m)
 502     (concat "^" rmail-unix-mail-delimiter))
 503    ((= format ?M)
 504     "^\^A\^A\^A\^A\n")
 505    (t
 506     (error "Unknown format: %c" format))))
 507
 508 ;;;###autoload
 509 (defun nnsoup-pack-replies ()
 510   "Make an outbound package of SOUP replies."
 511   (interactive)
 512   ;; Write all data buffers.
 513   (gnus-soup-save-areas)
 514   ;; Write the active file.
 515   (nnsoup-write-active-file)
 516   ;; Write the REPLIES file.
 517   (nnsoup-write-replies)
 518   ;; Pack all these files into a SOUP packet.
 519   (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
 520
 521 (defun nnsoup-write-replies ()
 522   "Write the REPLIES file."
 523   (when nnsoup-replies-list
 524     (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
 525     (setq nnsoup-replies-list nil)))
 526
 527 (defun nnsoup-article-to-area (article group)
 528   "Return the area that ARTICLE in GROUP is located in."
 529   (let ((areas (cdr (assoc group nnsoup-group-alist))))
 530     (while (and areas (< (cdr (car (car areas))) article))
 531       (setq areas (cdr areas)))
 532     (and areas (car areas))))
 533
 534 ;;;###autoload
 535 (defun nnsoup-set-variables ()
 536   "Use the SOUP methods for posting news and mailing mail."
 537   (interactive)
 538   (setq gnus-inews-article-function 'nnsoup-request-post)
 539   (setq send-mail-function 'nnsoup-request-mail))
 540
 541 (defun nnsoup-store-reply (kind)
 542   ;; Mostly stolen from `sendmail.el'.
 543   (let ((tembuf (generate-new-buffer " sendmail temp"))
 544         (case-fold-search nil)
 545         (mailbuf (current-buffer))
 546         delimline)
 547     (save-excursion
 548       (set-buffer tembuf)
 549       (erase-buffer)
 550       (insert-buffer-substring mailbuf)
 551       (goto-char (point-max))
 552       ;; require one newline at the end.
 553       (or (= (preceding-char) ?\n)
 554           (insert ?\n))
 555       ;; Change header-delimiter to be what sendmail expects.
 556       (goto-char (point-min))
 557       (re-search-forward
 558         (concat "^" (regexp-quote mail-header-separator) "\n"))
 559       (replace-match "\n")
 560       (backward-char 1)
 561       (setq delimline (point-marker))
 562       (if mail-aliases (expand-mail-aliases (point-min) delimline))
 563       (goto-char (point-min))
 564       ;; ignore any blank lines in the header
 565       (while (and (re-search-forward "\n\n\n*" delimline t)
 566                   (< (point) delimline))
 567         (replace-match "\n"))
 568       (let ((case-fold-search t))
 569         (goto-char (point-min))
 570         ;; Find and handle any FCC fields.
 571         (goto-char (point-min))
 572         (if (re-search-forward "^FCC:" delimline t)
 573             (mail-do-fcc delimline))
 574         (goto-char (point-min))
 575         ;; "S:" is an abbreviation for "Subject:".
 576         (goto-char (point-min))
 577         (if (re-search-forward "^S:" delimline t)
 578             (replace-match "Subject:"))
 579         ;; Don't send out a blank subject line
 580         (goto-char (point-min))
 581         (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
 582             (replace-match ""))
 583         ;; Insert an extra newline if we need it to work around
 584         ;; Sun's bug that swallows newlines.
 585         (goto-char (1+ delimline))
 586         (if (eval mail-mailer-swallows-blank-line)
 587             (newline)))
 588       (gnus-soup-store
 589        nnsoup-replies-directory
 590        (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
 591        nnsoup-replies-index-type)
 592       (kill-buffer tembuf))))
 593
 594 (defun nnsoup-kind-to-prefix (kind)
 595   (unless nnsoup-replies-list
 596     (setq nnsoup-replies-list
 597           (gnus-soup-parse-replies
 598            (concat nnsoup-replies-directory "REPLIES"))))
 599   (let ((replies nnsoup-replies-list))
 600     (while (and replies
 601                 (not (string= kind (gnus-soup-reply-kind (car replies)))))
 602       (setq replies (cdr replies)))
 603     (if replies
 604         (gnus-soup-reply-prefix (car replies))
 605       (setq nnsoup-replies-list
 606             (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
 607                           kind
 608                           (format "%c%c%c"
 609                                   nnsoup-replies-format-type
 610                                   nnsoup-replies-index-type
 611                                   (if (string= kind "news")
 612                                       ?n ?m)))
 613                   nnsoup-replies-list))
 614       (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
 615
 616 (defun nnsoup-make-active ()
 617   (let ((files (sort (directory-files nnsoup-directory t "IDX$")
 618                      (lambda (f1 f2)
 619                        (< (progn (string-match "/\\([0-9]+\\)\\." f1)
 620                                  (string-to-int (substring
 621                                                  f1 (match-beginning 1)
 622                                                  (match-end 1))))
 623                           (progn (string-match "/\\([0-9]+\\)\\." f2)
 624                                  (string-to-int (substring
 625                                                  f2 (match-beginning 1)
 626                                                  (match-end 1))))))))
 627         active group lines ident elem min)
 628     (set-buffer (get-buffer-create " *nnsoup work*"))
 629     (buffer-disable-undo (current-buffer))
 630     (while files
 631       (message "Doing %s..." (car files))
 632       (erase-buffer)
 633       (insert-file-contents (car files))
 634       (goto-char (point-min))
 635       (end-of-line)
 636       (re-search-backward "[ \t]\\([^ ]+\\):[0-9]")
 637       (setq group (buffer-substring (match-beginning 1) (match-end 1)))
 638       (setq lines (count-lines (point-min) (point-max)))
 639       (setq ident (progn (string-match
 640                           "/\\([0-9]+\\)\\." (car files))
 641                          (substring
 642                           (car files) (match-beginning 1)
 643                           (match-end 1))))
 644       (if (not (setq elem (assoc group active)))
 645           (push (list group (list (cons 1 lines)
 646                                   (vector ident group "ncm" "" lines)))
 647                 active)
 648         (setcdr elem (cons (list (cons (setq min (1+ (cdr (car (car
 649                                                                 (cdr elem))))))
 650                                        (+ min lines))
 651                                  (vector ident group "ncm" "" lines))
 652                            (cdr elem))))
 653       (setq files (cdr files)))
 654     (setq nnsoup-group-alist active)
 655     (while active
 656       (setcdr (car active) (nreverse (cdr (car active))))
 657       (setq active (cdr active)))))
 658
 659 (provide 'nnsoup)
 660
 661 ;;; nnsoup.el ends here