Relicense "GPLv2 or later" files to "GPLv3 or later".
[gnus] / lisp / nnsoup.el
index 22c22da..1053ecc 100644 (file)
@@ -1,15 +1,17 @@
 ;;; nnsoup.el --- SOUP access for Gnus
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007 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
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -19,8 +21,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -35,7 +37,7 @@
 
 (nnoo-declare nnsoup)
 
-(defvoo nnsoup-directory "~/SOUP/"
+(defvoo nnsoup-directory (nnheader-concat gnus-home-directory "SOUP/")
   "*SOUP packet directory.")
 
 (defvoo nnsoup-tmp-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
@@ -66,14 +70,14 @@ 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.
+  "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.")
 
@@ -112,7 +116,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.
@@ -128,7 +132,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)
@@ -156,7 +160,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)
@@ -247,7 +251,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
@@ -313,7 +317,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
@@ -335,7 +339,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)
@@ -367,9 +371,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))
@@ -397,7 +399,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) "$")))
@@ -422,12 +424,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.
@@ -476,7 +481,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
@@ -530,17 +536,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)
            (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
-           (mm-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))
@@ -548,9 +556,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))
@@ -590,7 +597,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))
                    (setq end (progn (forward-line -1) (point))))))
            (set-buffer msg-buf))
          (widen)
@@ -643,25 +650,25 @@ backend for the messages.")
 (defun nnsoup-article-to-area (article group)
   "Return the area that ARTICLE in GROUP is located in."
   (let ((areas (cddr (assoc group nnsoup-group-alist))))
-    (while (and areas (< (cdaar areas) article))
+    (while (and areas (< (cdar (car areas)) article))
       (setq areas (cdr areas)))
     (and areas (car areas))))
 
 (defvar nnsoup-old-functions
-  (list message-send-mail-function message-send-news-function))
+  (list message-send-mail-real-function message-send-news-function))
 
 ;;;###autoload
 (defun nnsoup-set-variables ()
   "Use the SOUP methods for posting news and mailing mail."
   (interactive)
   (setq message-send-news-function 'nnsoup-request-post)
-  (setq message-send-mail-function 'nnsoup-request-mail))
+  (setq message-send-mail-real-function 'nnsoup-request-mail))
 
 ;;;###autoload
 (defun nnsoup-revert-variables ()
   "Revert posting and mailing methods to the standard Emacs methods."
   (interactive)
-  (setq message-send-mail-function (car nnsoup-old-functions))
+  (setq message-send-mail-real-function (car nnsoup-old-functions))
   (setq message-send-news-function (cadr nnsoup-old-functions)))
 
 (defun nnsoup-store-reply (kind)
@@ -721,7 +728,7 @@ backend for the messages.")
   (unless nnsoup-replies-list
     (setq nnsoup-replies-list
          (gnus-soup-parse-replies
-          (concat nnsoup-replies-directory "REPLIES"))))
+          (expand-file-name "REPLIES" nnsoup-replies-directory))))
   (let ((replies nnsoup-replies-list))
     (while (and replies
                (not (string= kind (gnus-soup-reply-kind (car replies)))))
@@ -744,37 +751,34 @@ backend for the messages.")
   (let ((files (sort (directory-files nnsoup-directory t "IDX$")
                     (lambda (f1 f2)
                       (< (progn (string-match "/\\([0-9]+\\)\\." f1)
-                                (string-to-int (match-string 1 f1)))
+                                (string-to-number (match-string 1 f1)))
                          (progn (string-match "/\\([0-9]+\\)\\." f2)
-                                (string-to-int (match-string 1 f2)))))))
+                                (string-to-number (match-string 1 f2)))))))
        active group lines ident elem min)
     (set-buffer (get-buffer-create " *nnsoup work*"))
-    (while files
-      (nnheader-message 5 "Doing %s..." (car files))
+    (dolist (file files)
+      (nnheader-message 5 "Doing %s..." file)
       (erase-buffer)
-      (mm-insert-file-contents (car files))
+      (nnheader-insert-file-contents file)
       (goto-char (point-min))
       (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
          (setq group "unknown")
        (setq group (match-string 2)))
       (setq lines (count-lines (point-min) (point-max)))
       (setq ident (progn (string-match
-                         "/\\([0-9]+\\)\\." (car files))
-                        (substring
-                         (car files) (match-beginning 1)
-                         (match-end 1))))
+                         "/\\([0-9]+\\)\\." file)
+                        (match-string 1 file)))
       (if (not (setq elem (assoc group active)))
          (push (list group (cons 1 lines)
                      (list (cons 1 lines)
-                           (vector ident group "ncm" "" lines)))
+                           (vector ident group "ucm" "" lines)))
                active)
        (nconc elem
               (list
                (list (cons (1+ (setq min (cdadr elem)))
                            (+ min lines))
-                     (vector ident group "ncm" "" lines))))
-       (setcdr (cadr elem) (+ min lines)))
-      (setq files (cdr files)))
+                     (vector ident group "ucm" "" lines))))
+       (setcdr (cadr elem) (+ min lines))))
     (nnheader-message 5 "")
     (setq nnsoup-group-alist active)
     (nnsoup-write-active-file t)))
@@ -791,18 +795,20 @@ backend for the messages.")
                               nnsoup-group-alist)))
         (regexp "\\.MSG$\\|\\.IDX$")
         (files (directory-files nnsoup-directory nil regexp))
-        non-files file)
+        non-files)
     ;; Find all files that aren't known by nnsoup.
-    (while (setq file (pop files))
+    (dolist (file files)
       (string-match regexp file)
       (unless (member (substring file 0 (match-beginning 0)) known)
        (push file non-files)))
     ;; Sort and delete the files.
     (setq non-files (sort non-files 'string<))
     (map-y-or-n-p "Delete file %s? "
-                 (lambda (file) (delete-file (concat nnsoup-directory file)))
+                 (lambda (file) (delete-file
+                                 (expand-file-name file nnsoup-directory)))
                  non-files)))
 
 (provide 'nnsoup)
 
+;;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828
 ;;; nnsoup.el ends here