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   (while nnsoup-buffers
 203     (and (car nnsoup-buffers)
 204          (buffer-name (car nnsoup-buffers))
 205          (kill-buffer (car nnsoup-buffers)))
 206     (setq nnsoup-buffers (cdr nnsoup-buffers)))
 207   (setq nnsoup-group-alist nil
 208         nnsoup-current-group nil
 209         nnsoup-current-server nil
 210         nnsoup-server-alist nil
 211         nnsoup-replies-list nil)
 212   t)
 213
 214 (defun nnsoup-close-server (&optional server)
 215   t)
 216
 217 (defun nnsoup-server-opened (&optional server)
 218   (and (equal server nnsoup-current-server)
 219        nntp-server-buffer
 220        (buffer-name nntp-server-buffer)))
 221
 222 (defun nnsoup-status-message (&optional server)
 223   nnsoup-status-string)
 224
 225 (defun nnsoup-request-article (id &optional newsgroup server buffer)
 226   (nnsoup-possibly-change-group newsgroup)
 227   (let ((buffer (or buffer nntp-server-buffer)))
 228     (save-excursion
 229       (set-buffer buffer)
 230       (erase-buffer)
 231       (if (stringp id)
 232           ()
 233         (insert-buffer-substring
 234          (nnsoup-narrow-to-article id))
 235         t))))
 236
 237 (defun nnsoup-request-group (group &optional server dont-check)
 238   (nnsoup-possibly-change-group group)
 239   (if dont-check
 240       ()
 241     (let ((area (cdr (assoc group nnsoup-group-alist)))
 242           min max)
 243       (save-excursion
 244         (set-buffer nntp-server-buffer)
 245         (erase-buffer)
 246         (setq min (car (car (car area))))
 247         (while (cdr area)
 248           (setq area (cdr area)))
 249         (setq max (cdr (car (car area))))
 250         (insert (format "211 %d %d %d %s\n"
 251                         (max (1+ (- max min)) 0) min max group)))))
 252   t)
 253
 254 (defun nnsoup-close-group (group &optional server)
 255   t)
 256
 257 (defun nnsoup-request-list (&optional server)
 258   (save-excursion
 259     (set-buffer nntp-server-buffer)
 260     (erase-buffer)
 261     (let ((alist nnsoup-group-alist)
 262           min)
 263       (while alist
 264         (setq min (car (car (nth 1 (car alist)))))
 265         (insert (format "%s %d %d y\n" (car (car alist))
 266                         (let ((areas (car alist)))
 267                           (while (cdr areas)
 268                             (setq areas (cdr areas)))
 269                           (cdr (car (car areas)))) min))
 270         (setq alist (cdr alist)))
 271       t)))
 272
 273 (defun nnsoup-request-scan (group &optional server)
 274   (or nnsoup-group-alist (nnsoup-read-areas))
 275   (nnsoup-unpack-packets))
 276
 277 (defun nnsoup-request-newgroups (date &optional server)
 278   (nnsoup-request-list))
 279
 280 (defun nnsoup-request-list-newsgroups (&optional server)
 281   nil)
 282
 283 (defun nnsoup-request-post (&optional server)
 284   (nnsoup-store-reply "news")
 285   t)
 286
 287 (defun nnsoup-request-mail ()
 288   (nnsoup-store-reply "mail")
 289   t)
 290
 291 (defun nnsoup-request-expire-articles (articles group &optional server force)
 292   (nnsoup-possibly-change-group group)
 293   (let* ((days (or (and nnmail-expiry-wait-function
 294                         (funcall nnmail-expiry-wait-function group))
 295                    nnmail-expiry-wait))
 296          (total-infolist (assoc group nnsoup-group-alist))
 297          (infolist (cdr total-infolist))
 298          info range-list mod-time prefix)
 299     (while infolist
 300       (setq info (pop infolist)
 301             range-list (gnus-uncompress-range (car info))
 302             prefix (gnus-soup-area-prefix (nth 1 info)))
 303       (when ;; All the articles in this file are marked for expiry.
 304           (and (gnus-sublist-p articles range-list)
 305                ;; This file is old enough.  We have to check for
 306                ;; `(0 0)', since that's what ange-ftp files reply with.
 307                (or force
 308                    (and (not (equal
 309                               (setq mod-time (nth 5 (nnsoup-file prefix)))
 310                               '(0 0)))
 311                         (> (nnmail-days-between
 312                             (current-time-string)
 313                             (current-time-string mod-time))
 314                            days))))
 315         ;; Ok, we delete this file.
 316         (when (condition-case nil
 317                   (and
 318                    (delete-file (nnsoup-file prefix))
 319                    (delete-file (nnsoup-file prefix) t)
 320                    t)
 321                 (error nil))
 322           (setcdr total-infolist (delq info total-infolist))
 323           (setq articles (gnus-sorted-complement articles range-list)))))
 324     (nnsoup-write-active-file)
 325     ;; Return the articles that weren't expired.
 326     articles))
 327
 328 \f
 329 ;;; Internal functions
 330
 331 (defun nnsoup-possibly-change-group (group &optional force)
 332   (if group
 333       (setq nnsoup-current-group group)
 334     t))
 335
 336 (defun nnsoup-read-active-file ()
 337   (if (file-exists-p nnsoup-active-file)
 338       (condition-case ()
 339           (load nnsoup-active-file)
 340         (error nil))))
 341
 342 (defun nnsoup-write-active-file ()
 343   (when nnsoup-group-alist
 344     (save-excursion
 345       (set-buffer (get-buffer-create " *nnsoup work*"))
 346       (buffer-disable-undo (current-buffer))
 347       (erase-buffer)
 348       (insert (format "(setq nnsoup-group-alist '%S)\n" nnsoup-group-alist))
 349       (write-region (point-min) (point-max) nnsoup-active-file
 350                     nil 'silent)
 351       (kill-buffer (current-buffer)))))
 352
 353 (defun nnsoup-read-areas ()
 354   (save-excursion
 355     (set-buffer nntp-server-buffer)
 356     (let ((areas (gnus-soup-parse-areas (concat nnsoup-directory "AREAS")))
 357           entry number area lnum)
 358       ;; Go through all areas in the new AREAS file.
 359       (while areas
 360         (setq area (car areas)
 361               areas (cdr areas))
 362         ;; Find the number of new articles in this area.
 363         (setq number (nnsoup-number-of-articles area))
 364         (if (not (setq entry (assoc (gnus-soup-area-name area)
 365                                     nnsoup-group-alist)))
 366             ;; If this is a new area (group), we just add this info to
 367             ;; the group alist.
 368             (setq nnsoup-group-alist
 369                   (cons (list (gnus-soup-area-name area)
 370                               (list (cons 1 number) area))
 371                         nnsoup-group-alist))
 372           ;; There are already articles in this group, so we add this
 373           ;; info to the end of the entry.
 374           (let ((e (cdr entry)))
 375             (while (cdr e)
 376               (setq e (cdr e)))
 377             (setcdr e (list (list (cons (setq lnum (1+ (cdr (car (car e)))))
 378                                         (+ lnum number))
 379                                   area)))))))
 380     (nnsoup-write-active-file)))
 381
 382 (defun nnsoup-number-of-articles (area)
 383   (save-excursion
 384     (cond
 385      ;; If the number is in the area info, we just return it.
 386      ((gnus-soup-area-number area)
 387       (gnus-soup-area-number area))
 388      ;; If there is an index file, we just count the lines.
 389      ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
 390       (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
 391       (count-lines (point-min) (point-max)))
 392      ;; We do it the hard way - re-searching through the message
 393      ;; buffer.
 394      (t
 395       (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
 396       (goto-char (point-min))
 397       (let ((regexp (nnsoup-header (gnus-soup-encoding-format
 398                                     (gnus-soup-area-encoding area))))
 399             (num 0))
 400         (while (re-search-forward regexp nil t)
 401           (setq num (1+ num)))
 402         num)))))
 403
 404 (defun nnsoup-index-buffer (prefix &optional message)
 405   (let* ((file (concat prefix (if message ".MSG" ".IDX")))
 406          (buffer-name (concat " *nnsoup " file "*")))
 407     (or (get-buffer buffer-name)        ; File aready loaded.
 408         (save-excursion                 ; Load the file.
 409           (set-buffer (get-buffer-create buffer-name))
 410           (buffer-disable-undo (current-buffer))
 411           (setq nnsoup-buffers (cons (current-buffer) nnsoup-buffers))
 412           (insert-file-contents (concat nnsoup-directory file))
 413           (current-buffer)))))
 414
 415 (defun nnsoup-file (prefix &optional message)
 416   (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))
 417
 418 (defun nnsoup-message-buffer (prefix)
 419   (nnsoup-index-buffer prefix 'msg))
 420
 421 (defun nnsoup-unpack-packets ()
 422   (let ((packets (directory-files
 423                   nnsoup-packet-directory t nnsoup-packet-regexp))
 424         msg)
 425     (while packets
 426       (message (setq msg (format "nnsoup: unpacking %s..." (car packets))))
 427       (gnus-soup-unpack-packet nnsoup-directory nnsoup-unpacker (car packets))
 428       (delete-file (car packets))
 429       (nnsoup-read-areas)
 430       (message "%sdone" msg)
 431       (setq packets (cdr packets)))))
 432
 433 (defun nnsoup-narrow-to-article (article &optional area head)
 434   (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
 435          (prefix (gnus-soup-area-prefix (nth 1 area)))
 436          beg end msg-buf)
 437     (setq msg-buf (nnsoup-index-buffer prefix 'msg))
 438     (save-excursion
 439       (cond
 440        ;; We use the index file to find out where the article begins and ends.
 441        ((and (= (gnus-soup-encoding-index
 442                  (gnus-soup-area-encoding (nth 1 area)))
 443                 ?c)
 444              (file-exists-p (nnsoup-file prefix)))
 445         (set-buffer (nnsoup-index-buffer prefix))
 446         (widen)
 447         (goto-char (point-min))
 448         (forward-line (- article (car (car area))))
 449         (setq beg (read (current-buffer)))
 450         (forward-line 1)
 451         (if (looking-at "[0-9]+")
 452             (progn
 453               (setq end (read (current-buffer)))
 454               (set-buffer msg-buf)
 455               (widen)
 456               (let ((format (gnus-soup-encoding-format
 457                              (gnus-soup-area-encoding (nth 1 area)))))
 458                 (goto-char end)
 459                 (if (or (= format ?n) (= format ?m))
 460                     (setq end (progn (forward-line -1) (point))))))
 461           (set-buffer msg-buf))
 462         (widen)
 463         (narrow-to-region beg (or end (point-max))))
 464        (t
 465         (set-buffer msg-buf)
 466         (widen)
 467         (goto-char (point-min))
 468         (let ((header (nnsoup-header
 469                        (gnus-soup-encoding-format
 470                         (gnus-soup-area-encoding (nth 1 area))))))
 471           (re-search-forward header nil t (- article (car (car area))))
 472           (narrow-to-region
 473            (match-beginning 0)
 474            (if (re-search-forward header nil t)
 475                (match-beginning 0)
 476              (point-max))))))
 477       (goto-char (point-min))
 478       (if (not head)
 479           ()
 480         (narrow-to-region
 481          (point-min)
 482          (if (search-forward "\n\n" nil t)
 483              (1- (point))
 484            (point-max))))
 485       msg-buf)))
 486
 487 (defun nnsoup-header (format)
 488   (cond
 489    ((= format ?n)
 490     "^#! *rnews +[0-9]+ *$")
 491    ((= format ?m)
 492     (concat "^" rmail-unix-mail-delimiter))
 493    ((= format ?M)
 494     "^\^A\^A\^A\^A\n")
 495    (t
 496     (error "Unknown format: %c" format))))
 497
 498 ;;;###autoload
 499 (defun nnsoup-pack-replies ()
 500   "Make an outbound package of SOUP replies."
 501   (interactive)
 502   ;; Write all data buffers.
 503   (gnus-soup-save-areas)
 504   ;; Write the active file.
 505   (nnsoup-write-active-file)
 506   ;; Write the REPLIES file.
 507   (nnsoup-write-replies)
 508   ;; Pack all these files into a SOUP packet.
 509   (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
 510
 511 (defun nnsoup-write-replies ()
 512   "Write the REPLIES file."
 513   (when nnsoup-replies-list
 514     (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
 515     (setq nnsoup-replies-list nil)))
 516
 517 (defun nnsoup-article-to-area (article group)
 518   "Return the area that ARTICLE in GROUP is located in."
 519   (let ((areas (cdr (assoc group nnsoup-group-alist))))
 520     (while (and areas (< (cdr (car (car areas))) article))
 521       (setq areas (cdr areas)))
 522     (and areas (car areas))))
 523
 524 ;;;###autoload
 525 (defun nnsoup-set-variables ()
 526   "Use the SOUP methods for posting news and mailing mail."
 527   (interactive)
 528   (setq gnus-inews-article-function 'nnsoup-request-post)
 529   (setq send-mail-function 'nnsoup-request-mail))
 530
 531 (defun nnsoup-store-reply (kind)
 532   ;; Mostly stolen from `sendmail.el'.
 533   (let ((tembuf (generate-new-buffer " sendmail temp"))
 534         (case-fold-search nil)
 535         (mailbuf (current-buffer))
 536         delimline)
 537     (save-excursion
 538       (set-buffer tembuf)
 539       (erase-buffer)
 540       (insert-buffer-substring mailbuf)
 541       (goto-char (point-max))
 542       ;; require one newline at the end.
 543       (or (= (preceding-char) ?\n)
 544           (insert ?\n))
 545       ;; Change header-delimiter to be what sendmail expects.
 546       (goto-char (point-min))
 547       (re-search-forward
 548         (concat "^" (regexp-quote mail-header-separator) "\n"))
 549       (replace-match "\n")
 550       (backward-char 1)
 551       (setq delimline (point-marker))
 552       (if mail-aliases (expand-mail-aliases (point-min) delimline))
 553       (goto-char (point-min))
 554       ;; ignore any blank lines in the header
 555       (while (and (re-search-forward "\n\n\n*" delimline t)
 556                   (< (point) delimline))
 557         (replace-match "\n"))
 558       (let ((case-fold-search t))
 559         (goto-char (point-min))
 560         ;; Find and handle any FCC fields.
 561         (goto-char (point-min))
 562         (if (re-search-forward "^FCC:" delimline t)
 563             (mail-do-fcc delimline))
 564         (goto-char (point-min))
 565         ;; "S:" is an abbreviation for "Subject:".
 566         (goto-char (point-min))
 567         (if (re-search-forward "^S:" delimline t)
 568             (replace-match "Subject:"))
 569         ;; Don't send out a blank subject line
 570         (goto-char (point-min))
 571         (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
 572             (replace-match ""))
 573         ;; Insert an extra newline if we need it to work around
 574         ;; Sun's bug that swallows newlines.
 575         (goto-char (1+ delimline))
 576         (if (eval mail-mailer-swallows-blank-line)
 577             (newline)))
 578       (gnus-soup-store
 579        nnsoup-replies-directory
 580        (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
 581        nnsoup-replies-index-type)
 582       (kill-buffer tembuf))))
 583
 584 (defun nnsoup-kind-to-prefix (kind)
 585   (unless nnsoup-replies-list
 586     (setq nnsoup-replies-list
 587           (gnus-soup-parse-replies
 588            (concat nnsoup-replies-directory "REPLIES"))))
 589   (let ((replies nnsoup-replies-list))
 590     (while (and replies
 591                 (not (string= kind (gnus-soup-reply-kind (car replies)))))
 592       (setq replies (cdr replies)))
 593     (if replies
 594         (gnus-soup-reply-prefix (car replies))
 595       (setq nnsoup-replies-list
 596             (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
 597                           kind
 598                           (format "%c%c%c"
 599                                   nnsoup-replies-format-type
 600                                   nnsoup-replies-index-type
 601                                   (if (string= kind "news")
 602                                       ?n ?m)))
 603                   nnsoup-replies-list))
 604       (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
 605
 606 (defun nnsoup-make-active ()
 607   (let ((files (sort (directory-files nnsoup-directory t "IDX$")
 608                      (lambda (f1 f2)
 609                        (< (progn (string-match "/\\([0-9]+\\)\\." f1)
 610                                  (string-to-int (substring
 611                                                  f1 (match-beginning 1)
 612                                                  (match-end 1))))
 613                           (progn (string-match "/\\([0-9]+\\)\\." f2)
 614                                  (string-to-int (substring
 615                                                  f2 (match-beginning 1)
 616                                                  (match-end 1))))))))
 617         active group lines ident elem min)
 618     (set-buffer (get-buffer-create " *nnsoup work*"))
 619     (buffer-disable-undo)
 620     (while files
 621       (message "Doing %s..." (car files))
 622       (erase-buffer)
 623       (insert-file-contents (car files))
 624       (goto-char (point-min))
 625       (end-of-line)
 626       (re-search-backward "[ \t]\\([^ ]+\\):[0-9]")
 627       (setq group (buffer-substring (match-beginning 1) (match-end 1)))
 628       (setq lines (count-lines (point-min) (point-max)))
 629       (setq ident (progn (string-match
 630                           "/\\([0-9]+\\)\\." (car files))
 631                          (substring
 632                           (car files) (match-beginning 1)
 633                           (match-end 1))))
 634       (if (not (setq elem (assoc group active)))
 635           (push (list group (list (cons 1 lines)
 636                                   (vector ident group "ncm" "" lines)))
 637                 active)
 638         (setcdr elem (cons (list (cons (setq min (1+ (cdr (car (car
 639                                                                 (cdr elem))))))
 640                                        (+ min lines))
 641                                  (vector ident group "ncm" "" lines))
 642                            (cdr elem))))
 643       (setq files (cdr files)))
 644     (setq nnsoup-group-alist active)
 645     (while active
 646       (setcdr (car active) (nreverse (cdr (car active))))
 647       (setq active (cdr active)))))
 648
 649 (provide 'nnsoup)
 650
 651 ;;; nnsoup.el ends here