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