Merge from emacs--devo--0
[gnus] / lisp / nnsoup.el
index 253557e..64c4fee 100644 (file)
@@ -1,16 +1,18 @@
 ;;; nnsoup.el --- SOUP access for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -18,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 (nnoo-declare nnsoup)
 
-(defvoo nnsoup-directory "~/SOUP/"
+(defvoo nnsoup-directory (nnheader-concat gnus-home-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"
+(defvoo nnsoup-packer (concat "tar cf - %s | gzip > "
+                             (expand-file-name gnus-home-directory)
+                             "Soupin%d.tgz")
   "Format string command for packing a SOUP packet.
 The SOUP files will be inserted where the %s is in the string.
 This string MUST contain both %s and %d.  The file number will be
@@ -63,15 +68,15 @@ inserted where %d appears.")
   "*Format string command for unpacking a SOUP packet.
 The SOUP packet file name will be inserted at the %s.")
 
-(defvoo nnsoup-packet-directory "~/"
+(defvoo nnsoup-packet-directory gnus-home-directory
   "*Where nnsoup will look for incoming packets.")
 
 (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 
+  "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
@@ -109,7 +114,7 @@ backend for the messages.")
        ;; 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.
@@ -125,7 +130,7 @@ backend for the messages.")
              (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)
@@ -153,7 +158,7 @@ backend for the messages.")
                  (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)
@@ -244,7 +249,7 @@ backend for the messages.")
   ;; Try to guess the type based on the first article in the group.
   (when (not article)
     (setq article
-         (cdaar (cddr (assoc group nnsoup-group-alist)))))
+         (cdar (car (cddr (assoc group nnsoup-group-alist))))))
   (if (not article)
       'unknown
     (let ((kind (gnus-soup-encoding-kind
@@ -310,7 +315,7 @@ backend for the messages.")
       (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
@@ -332,7 +337,7 @@ backend for the messages.")
                  (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)
@@ -364,9 +369,7 @@ backend for the messages.")
            entry e min max)
        (while (setq e (cdr (setq entry (pop alist))))
          (setq min (caaar e))
-         (while (cdr e)
-           (setq e (cdr e)))
-         (setq max (cdaar e))
+         (setq max (cdar (car (last e))))
          (setcdr entry (cons (cons min max) (cdr entry)))))
       (setq nnsoup-group-alist-touched t))
     nnsoup-group-alist))
@@ -394,7 +397,7 @@ backend for the messages.")
     prefix))
 
 (defun nnsoup-file-name (dir file)
-  "Return the full path of FILE (in any case) in DIR."
+  "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) "$")))
@@ -419,12 +422,15 @@ backend for the messages.")
            (setq cur-prefix (nnsoup-next-prefix))
            (nnheader-message 5 "Incorporating file %s..." cur-prefix)
            (when (file-exists-p
-                  (setq file (concat nnsoup-tmp-directory
-                                     (gnus-soup-area-prefix area) ".IDX")))
+                  (setq file
+                        (expand-file-name
+                         (concat (gnus-soup-area-prefix area) ".IDX")
+                         nnsoup-tmp-directory)))
              (rename-file file (nnsoup-file cur-prefix)))
            (when (file-exists-p
-                  (setq file (concat nnsoup-tmp-directory
-                                     (gnus-soup-area-prefix area) ".MSG")))
+                  (setq file (expand-file-name
+                              (concat (gnus-soup-area-prefix area) ".MSG")
+                              nnsoup-tmp-directory)))
              (rename-file file (nnsoup-file cur-prefix t))
              (gnus-soup-set-area-prefix area cur-prefix)
              ;; Find the number of new articles in this area.
@@ -473,7 +479,8 @@ backend for the messages.")
     (goto-char (point-min))
     (cond
      ;; rnews batch format
-     ((= format ?n)
+     ((or (= format ?u)
+         (= format ?n)) ;; Gnus back compatibility.
       (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
        (forward-line 1)
        (push (list
@@ -527,17 +534,19 @@ backend for the messages.")
   (let* ((file (concat prefix (if message ".MSG" ".IDX")))
         (buffer-name (concat " *nnsoup " file "*")))
     (or (get-buffer buffer-name)       ; File already loaded.
-       (when (file-exists-p (concat nnsoup-directory file))
+       (when (file-exists-p (expand-file-name file nnsoup-directory))
          (save-excursion               ; Load the file.
            (set-buffer (get-buffer-create buffer-name))
-           (buffer-disable-undo (current-buffer))
+           (buffer-disable-undo)
            (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
-           (nnheader-insert-file-contents (concat nnsoup-directory file))
+           (nnheader-insert-file-contents
+            (expand-file-name file nnsoup-directory))
            (current-buffer))))))
 
 (defun nnsoup-file (prefix &optional message)
   (expand-file-name
-   (concat nnsoup-directory prefix (if message ".MSG" ".IDX"))))
+   (concat prefix (if message ".MSG" ".IDX"))
+   nnsoup-directory))
 
 (defun nnsoup-message-buffer (prefix)
   (nnsoup-index-buffer prefix 'msg))
@@ -545,9 +554,8 @@ backend for the messages.")
 (defun nnsoup-unpack-packets ()
   "Unpack all packets in `nnsoup-packet-directory'."
   (let ((packets (directory-files
-                 nnsoup-packet-directory t nnsoup-packet-regexp))
-       packet)
-    (while (setq packet (pop packets))
+                 nnsoup-packet-directory t nnsoup-packet-regexp)))
+    (dolist (packet packets)
       (nnheader-message 5 "nnsoup: unpacking %s..." packet)
       (if (not (gnus-soup-unpack-packet
                nnsoup-tmp-directory nnsoup-unpacker packet))
@@ -587,7 +595,7 @@ backend for the messages.")
                (let ((format (gnus-soup-encoding-format
                               (gnus-soup-area-encoding (nth 1 area)))))
                  (goto-char end)
-                 (when (or (= format ?n) (= format ?m))
+                 (when (or (= format ?u) (= format ?n) (= format ?m))