Update copyright.
[gnus] / lisp / nnsoup.el
index f3708ec..9c69b1d 100644 (file)
@@ -1,8 +1,10 @@
 ;;; nnsoup.el --- SOUP access for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;;     Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 (defvoo nnsoup-directory "~/SOUP/"
   "*SOUP packet directory.")
 
-(defvoo nnsoup-tmp-directory "/tmp/"
+(defvoo nnsoup-tmp-directory
+    (cond ((fboundp 'temp-directory) (temp-directory))
+         ((boundp 'temporary-file-directory) temporary-file-directory)
+         ("/tmp/"))
   "*Where nnsoup will store temporary files.")
 
-(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/")
+(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory)
   "*Directory where outgoing packets will be composed.")
 
-(defvoo nnsoup-replies-format-type ?n
+(defvoo nnsoup-replies-format-type ?u  ;; u is USENET news format.
   "*Format of the replies packages.")
 
 (defvoo nnsoup-replies-index-type ?n
   "*Index type of the replies packages.")
 
-(defvoo nnsoup-active-file (concat nnsoup-directory "active")
+(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory)
   "Active file.")
 
 (defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
@@ -69,6 +74,11 @@ The SOUP packet file name will be inserted at the %s.")
 (defvoo nnsoup-packet-regexp "Soupout"
   "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
 
+(defvoo nnsoup-always-save t
+  "If non nil commit the reply buffer on each message send.
+This is necessary if using message mode outside Gnus with nnsoup as a
+backend for the messages.")
+
 \f
 
 (defconst nnsoup-version "nnsoup 0.0"
@@ -81,7 +91,7 @@ The SOUP packet file name will be inserted at the %s.")
 (defvoo nnsoup-buffers nil)
 (defvoo nnsoup-current-group nil)
 (defvoo nnsoup-group-alist-touched nil)
-
+(defvoo nnsoup-article-alist nil)
 \f
 
 ;;; Interface functions.
@@ -104,7 +114,7 @@ The SOUP packet file name will be inserted at the %s.")
        ;; articles in SEQUENCE come from.
        (while (and areas sequence)
          ;; Peel off areas that are below sequence.
-         (while (and areas (< (cdaar areas) (car sequence)))
+         (while (and areas (< (cdar (car areas)) (car sequence)))
            (setq areas (cdr areas)))
          (when areas
            ;; This is a useful area.
@@ -112,7 +122,7 @@ The SOUP packet file name will be inserted at the %s.")
            (setq this-area-seq nil)
            ;; We take note whether this MSG has a corresponding IDX
            ;; for later use.
-           (when (or (= (gnus-soup-encoding-index 
+           (when (or (= (gnus-soup-encoding-index
                          (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
                      (not (file-exists-p
                            (nnsoup-file
@@ -120,14 +130,14 @@ The SOUP packet file name will be inserted at the %s.")
              (setq use-nov nil))
            ;; We assign the portion of `sequence' that is relevant to
            ;; this MSG packet to this packet.
-           (while (and sequence (<= (car sequence) (cdaar areas)))
+           (while (and sequence (<= (car sequence) (cdar (car areas))))
              (push (car sequence) this-area-seq)
              (setq sequence (cdr sequence)))
            (setcar useful-areas (cons (nreverse this-area-seq)
                                       (car useful-areas)))))
 
        ;; We now have a list of article numbers and corresponding
-       ;; areas. 
+       ;; areas.
        (setq useful-areas (nreverse useful-areas))
 
        ;; Two different approaches depending on whether all the MSG
@@ -148,7 +158,7 @@ The SOUP packet file name will be inserted at the %s.")
                  (when index-buffer
                    (insert-buffer-substring index-buffer)
                    (goto-char b)
-                   ;; We have to remove the index number entires and
+                   ;; We have to remove the index number entries and
                    ;; insert article numbers instead.
                    (while (looking-at "[0-9]+")
                      (replace-match (int-to-string number) t t)
@@ -162,7 +172,7 @@ The SOUP packet file name will be inserted at the %s.")
                  useful-areas (cdr useful-areas))
            (while articles
              (when (setq msg-buf
-                         (nnsoup-narrow-to-article 
+                         (nnsoup-narrow-to-article
                           (car articles) (cdar useful-areas) 'head))
                (goto-char (point-max))
                (insert (format "221 %d Article retrieved.\n" (car articles)))
@@ -180,7 +190,7 @@ The SOUP packet file name will be inserted at the %s.")
     (condition-case ()
        (make-directory nnsoup-directory t)
       (error t)))
-  (cond 
+  (cond
    ((not (file-exists-p nnsoup-directory))
     (nnsoup-close-server)
     (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
@@ -224,21 +234,25 @@ The SOUP packet file name will be inserted at the %s.")
 
 (deffoo nnsoup-request-group (group &optional server dont-check)
   (nnsoup-possibly-change-group group)
-  (if dont-check 
+  (if dont-check
       t
     (let ((active (cadr (assoc group nnsoup-group-alist))))
       (if (not active)
          (nnheader-report 'nnsoup "No such group: %s" group)
-       (nnheader-insert 
-        "211 %d %d %d %s\n" 
+       (nnheader-insert
+        "211 %d %d %d %s\n"
         (max (1+ (- (cdr active) (car active))) 0)
         (car active) (cdr active) group)))))
 
 (deffoo nnsoup-request-type (group &optional article)
   (nnsoup-possibly-change-group group)
+  ;; Try to guess the type based on the first article in the group.
+  (when (not article)
+    (setq article
+         (cdar (car (cddr (assoc group nnsoup-group-alist))))))
   (if (not article)
       'unknown
-    (let ((kind (gnus-soup-encoding-kind 
+    (let ((kind (gnus-soup-encoding-kind
                 (gnus-soup-area-encoding
                  (nth 1 (nnsoup-article-to-area
                          article nnsoup-current-group))))))
@@ -301,29 +315,29 @@ The SOUP packet file name will be inserted at the %s.")
       (setq info (pop infolist)
            range-list (gnus-uncompress-range (car info))
            prefix (gnus-soup-area-prefix (nth 1 info)))
-      (when ;; All the articles in this file are marked for expiry.
+      (when;; All the articles in this file are marked for expiry.
          (and (or (setq mod-time (nth 5 (file-attributes
                                          (nnsoup-file prefix))))
                   (setq mod-time (nth 5 (file-attributes
                                          (nnsoup-file prefix t)))))
               (gnus-sublist-p articles range-list)
-              ;; This file is old enough. 
+              ;; This file is old enough.
               (nnmail-expired-article-p group mod-time force))
        ;; Ok, we delete this file.
        (when (ignore-errors
-               (nnheader-message 
+               (nnheader-message
                 5 "Deleting %s in group %s..." (nnsoup-file prefix)
                 group)
                (when (file-exists-p (nnsoup-file prefix))
                  (delete-file (nnsoup-file prefix)))
-               (nnheader-message 
+               (nnheader-message
                 5 "Deleting %s in group %s..." (nnsoup-file prefix t)
                 group)
                (when (file-exists-p (nnsoup-file prefix t))
                  (delete-file (nnsoup-file prefix t)))
                t)
          (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
-         (setq articles (gnus-sorted-complement articles range-list))))
+         (setq articles (gnus-sorted-difference articles range-list))))
       (when (not mod-time)
        (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
     (if (cddr total-infolist)
@@ -337,9 +351,11 @@ The SOUP packet file name will be inserted at the %s.")
 ;;; Internal functions
 
 (defun nnsoup-possibly-change-group (group &optional force)
-  (if group
-      (setq nnsoup-current-group group)
-    t))
+  (when (and group
+            (not (equal nnsoup-current-group group)))
+    (setq nnsoup-article-alist nil)
+    (setq nnsoup-current-group group))
+  t)
 
 (defun nnsoup-read-active-file ()
   (setq nnsoup-group-alist nil)
@@ -355,17 +371,17 @@ The SOUP packet file name will be inserted at the %s.")
          (setq min (caaar e))
          (while (cdr e)
            (setq e (cdr e)))
-         (setq max (cdaar e))
+         (setq max (cdar (car e)))
          (setcdr entry (cons (cons min max) (cdr entry)))))
       (setq nnsoup-group-alist-touched t))
     nnsoup-group-alist))
 
 (defun nnsoup-write-active-file (&optional force)
   (when (and nnsoup-group-alist
-            (or force 
+            (or force
                 nnsoup-group-alist-touched))
     (setq nnsoup-group-alist-touched nil)
-    (nnheader-temp-write nnsoup-active-file
+    (with-temp-file nnsoup-active-file
       (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
       (insert "\n")
       (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
@@ -374,7 +390,7 @@ The SOUP packet file name will be inserted at the %s.")
 (defun nnsoup-next-prefix ()
   "Return the next free prefix."
   (let (prefix)
-    (while (or (file-exists-p 
+    (while (or (file-exists-p
                (nnsoup-file (setq prefix (int-to-string
                                           nnsoup-current-prefix))))
               (file-exists-p (nnsoup-file prefix t)))
@@ -382,49 +398,65 @@ The SOUP packet file name will be inserted at the %s.")
     (incf nnsoup-current-prefix)
     prefix))
 
+(defun nnsoup-file-name (dir file)
+  "Return the full name of FILE (in any case) in DIR."
+  (let* ((case-fold-search t)
+        (files (directory-files dir t))
+        (regexp (concat (regexp-quote file) "$")))
+    (car (delq nil
+              (mapcar
+               (lambda (file)
+                 (if (string-match regexp file)
+