(rfc2047-encode-region): Encode =? strings.
[gnus] / lisp / nnsoup.el
index b182038..009a1d3 100644 (file)
@@ -1,8 +1,10 @@
 ;;; nnsoup.el --- SOUP access for Gnus
-;; Copyright (C) 1995,96 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.
 (require 'nnmail)
 (require 'gnus-soup)
 (require 'gnus-msg)
+(require 'nnoo)
 (eval-when-compile (require 'cl))
 
-(defvar nnsoup-directory "~/SOUP/"
+(nnoo-declare nnsoup)
+
+(defvoo nnsoup-directory "~/SOUP/"
   "*SOUP packet directory.")
 
-(defvar 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.")
 
-(defvar nnsoup-replies-directory (concat nnsoup-directory "replies/")
+(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory)
   "*Directory where outgoing packets will be composed.")
 
-(defvar nnsoup-replies-format-type ?n
+(defvoo nnsoup-replies-format-type ?u  ;; u is USENET news format.
   "*Format of the replies packages.")
 
-(defvar nnsoup-replies-index-type ?n
+(defvoo nnsoup-replies-index-type ?n
   "*Index type of the replies packages.")
 
-(defvar nnsoup-active-file (concat nnsoup-directory "active")
+(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory)
   "Active file.")
 
-(defvar nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
+(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/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
+This string MUST contain both %s and %d.  The file number will be
 inserted where %d appears.")
 
-(defvar nnsoup-unpacker "gunzip -c %s | tar xvf -"
+(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
   "*Format string command for unpacking a SOUP packet.
 The SOUP packet file name will be inserted at the %s.")
 
-(defvar nnsoup-packet-directory "~/"
+(defvoo nnsoup-packet-directory "~/"
   "*Where nnsoup will look for incoming packets.")
 
-(defvar nnsoup-packet-regexp "Soupout"
+(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"
   "nnsoup version.")
 
-(defvar nnsoup-status-string "")
-(defvar nnsoup-group-alist nil)
-(defvar nnsoup-current-prefix 0)
-(defvar nnsoup-replies-list nil)
-(defvar nnsoup-buffers nil)
-(defvar nnsoup-current-group nil)
-
-\f
-
-;; Server variables.
-
-(defvar nnsoup-current-server nil)
-(defvar nnsoup-server-alist nil)
-(defvar nnsoup-server-variables 
-  `((nnsoup-directory ,nnsoup-directory)
-    (nnsoup-active-file ,nnsoup-active-file)
-    (nnsoup-status-string "")
-    (nnsoup-current-prefix 0)
-    (nnsoup-group-alist nil)))
-
+(defvoo nnsoup-status-string "")
+(defvoo nnsoup-group-alist nil)
+(defvoo nnsoup-current-prefix 0)
+(defvoo nnsoup-replies-list nil)
+(defvoo nnsoup-buffers nil)
+(defvoo nnsoup-current-group nil)
+(defvoo nnsoup-group-alist-touched nil)
+(defvoo nnsoup-article-alist nil)
 \f
 
 ;;; Interface functions.
 
-(defun nnsoup-retrieve-headers (sequence &optional group server fetch-old)
+(nnoo-define-basics nnsoup)
+
+(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
   (nnsoup-possibly-change-group group)
   (save-excursion
     (set-buffer nntp-server-buffer)
@@ -103,7 +106,7 @@ The SOUP packet file name will be inserted at the %s.")
     (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
          (articles sequence)
          (use-nov t)
-         useful-areas this-area-seq)
+         useful-areas this-area-seq msg-buf)
       (if (stringp (car sequence))
          ;; We don't support fetching by Message-ID.
          'headers
@@ -111,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 (< (cdr (car (car areas))) (car sequence)))
+         (while (and areas (< (cdar (car areas)) (car sequence)))
            (setq areas (cdr areas)))
          (when areas
            ;; This is a useful area.
@@ -119,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
@@ -127,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) (cdr (car (car 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,59 +151,59 @@ The SOUP packet file name will be inserted at the %s.")
              (while useful-areas
                (goto-char (point-max))
                (let ((b (point))
-                     (number (car (nth 1 (car useful-areas)))))
-                 (insert-buffer-substring
-                  (nnsoup-index-buffer
-                   (gnus-soup-area-prefix
-                    (nth 2 (car useful-areas)))))
-                 (goto-char b)
-                 ;; We have to remove the index number entires and
-                 ;; insert article numbers instead.
-                 (while (looking-at "[0-9]+")
-                   (replace-match (int-to-string number) t t)
-                   (incf number)
-                   (forward-line 1)))
+                     (number (car (nth 1 (car useful-areas))))
+                     (index-buffer (nnsoup-index-buffer
+                                    (gnus-soup-area-prefix
+                                     (nth 2 (car useful-areas))))))
+                 (when index-buffer
+                   (insert-buffer-substring index-buffer)
+                   (goto-char b)
+                   ;; 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)
+                     (incf number)
+                     (forward-line 1))))
                (setq useful-areas (cdr useful-areas)))
              'nov)
          ;; We insert HEADs.
          (while useful-areas
-           (setq articles (car (car useful-areas))
+           (setq articles (caar useful-areas)
                  useful-areas (cdr useful-areas))
            (while articles
-             (goto-char (point-max))
-             (insert (format "221 %d Article retrieved.\n" (car articles)))
-             (insert-buffer-substring
-              (nnsoup-narrow-to-article 
-               (car articles) (cdr (car useful-areas)) 'head))
-             (goto-char (point-max))
-             (insert ".\n")
+             (when (setq msg-buf
+                         (nnsoup-narrow-to-article
+                          (car articles) (cdar useful-areas) 'head))
+               (goto-char (point-max))
+               (insert (format "221 %d Article retrieved.\n" (car articles)))
+               (insert-buffer-substring msg-buf)
+               (goto-char (point-max))
+               (insert ".\n"))
              (setq articles (cdr articles))))
 
-         ;; Fold continuation lines.
-         (goto-char (point-min))
-         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-           (replace-match " " t t))
+         (nnheader-fold-continuation-lines)
          'headers)))))
 
-(defun nnsoup-open-server (server &optional defs)
-  (nnheader-init-server-buffer)
-  (if (equal server nnsoup-current-server)
-      t
-    (if nnsoup-current-server
-       (setq nnsoup-server-alist 
-             (cons (list nnsoup-current-server
-                         (nnheader-save-variables nnsoup-server-variables))
-                   nnsoup-server-alist)))
-    (let ((state (assoc server nnsoup-server-alist)))
-      (if state 
-         (progn
-           (nnheader-restore-variables (nth 1 state))
-           (setq nnsoup-server-alist (delq state nnsoup-server-alist)))
-       (nnheader-set-init-variables nnsoup-server-variables defs)))
-    (setq nnsoup-current-server server))
-  (nnsoup-read-active-file))
-
-(defun nnsoup-request-close ()
+(deffoo nnsoup-open-server (server &optional defs)
+  (nnoo-change-server 'nnsoup server defs)
+  (when (not (file-exists-p nnsoup-directory))
+    (condition-case ()
+       (make-directory nnsoup-directory t)
+      (error t)))
+  (cond
+   ((not (file-exists-p nnsoup-directory))
+    (nnsoup-close-server)
+    (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
+   ((not (file-directory-p (file-truename nnsoup-directory)))
+    (nnsoup-close-server)
+    (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
+   (t
+    (nnsoup-read-active-file)
+    (nnheader-report 'nnsoup "Opened server %s using directory %s"
+                    server nnsoup-directory)
+    t)))
+
+(deffoo nnsoup-request-close ()
   (nnsoup-write-active-file)
   (nnsoup-write-replies)
   (gnus-soup-save-areas)
@@ -212,52 +215,44 @@ The SOUP packet file name will be inserted at the %s.")
           (buffer-name buffer)
           (kill-buffer buffer))))
   (setq nnsoup-group-alist nil
+       nnsoup-group-alist-touched nil
        nnsoup-current-group nil
-       nnsoup-current-server nil
-       nnsoup-server-alist nil
        nnsoup-replies-list nil)
+  (nnoo-close-server 'nnoo)
   t)
 
-(defun nnsoup-close-server (&optional server)
-  t)
-
-(defun nnsoup-server-opened (&optional server)
-  (and (equal server nnsoup-current-server)
-       nntp-server-buffer
-       (buffer-name nntp-server-buffer)))
-
-(defun nnsoup-status-message (&optional server)
-  nnsoup-status-string)
-
-(defun nnsoup-request-article (id &optional newsgroup server buffer)
+(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
   (nnsoup-possibly-change-group newsgroup)
-  (let ((buffer (or buffer nntp-server-buffer)))
+  (let (buf)
     (save-excursion
-      (set-buffer buffer)
+      (set-buffer (or buffer nntp-server-buffer))
       (erase-buffer)
-      (if (stringp id)
-         ()
-       (insert-buffer-substring
-        (nnsoup-narrow-to-article id))
+      (when (and (not (stringp id))
+                (setq buf (nnsoup-narrow-to-article id)))
+       (insert-buffer-substring buf)
        t))))
 
-(defun nnsoup-request-group (group &optional server dont-check)
+(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" 
-        (max (1+ (- (cdr active) (car active))) 0) 
+       (nnheader-insert
+        "211 %d %d %d %s\n"
+        (max (1+ (- (cdr active) (car active))) 0)
         (car active) (cdr active) group)))))
 
-(defun nnsoup-request-type (group &optional article)
+(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))))))
@@ -265,7 +260,7 @@ The SOUP packet file name will be inserted at the %s.")
            ((= kind ?n) 'news)
            (t 'unknown)))))
 
-(defun nnsoup-close-group (group &optional server)
+(deffoo nnsoup-close-group (group &optional server)
   ;; Kill all nnsoup buffers.
   (let ((buffers nnsoup-buffers)
        elem)
@@ -276,35 +271,41 @@ The SOUP packet file name will be inserted at the %s.")
             (kill-buffer (cdr elem))))))
   t)
 
-(defun nnsoup-request-list (&optional server)
+(deffoo nnsoup-request-list (&optional server)
   (save-excursion
     (set-buffer nntp-server-buffer)
     (erase-buffer)
+    (unless nnsoup-group-alist
+      (nnsoup-read-active-file))
     (let ((alist nnsoup-group-alist)
+         (standard-output (current-buffer))
          entry)
       (while (setq entry (pop alist))
-       (insert (format "%s %d %d y\n" (car entry)
-                       (cdadr entry) (caadr entry))))
+       (insert (car&nbs