(shr-insert): Get white space at the beginning/end of elements right.
[gnus] / lisp / nnbabyl.el
index 2d41d4c..8f1f6ec 100644 (file)
@@ -1,18 +1,18 @@
 ;;; nnbabyl.el --- rmail mbox access for Gnus
 
-;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000
-;;     Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 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
@@ -20,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:
 
@@ -34,7 +32,7 @@
 (require 'nnheader)
 (condition-case nil
     (require 'rmail)
-  (t (nnheader-message
+  (error (nnheader-message
       5 "Ignore rmail errors from this file, you don't have rmail")))
 (require 'nnmail)
 (require 'nnoo)
 (nnoo-declare nnbabyl)
 
 (defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
-  "The name of the rmail box file in the users home directory.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "The name of the rmail box file in the users home directory.")
 
 (defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
-  "The name of the active file for the rmail box.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "The name of the active file for the rmail box.")
 
 (defvoo nnbabyl-get-new-mail t
-  "If non-nil, nnbabyl will check the incoming mail file and split the mail.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
 
 
 (defvoo nnbabyl-prepare-save-mail-hook nil
-  "Hook run narrowed to an article before saving.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "Hook run narrowed to an article before saving.")
 
 \f
 
@@ -78,9 +68,6 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 
 (defvoo nnbabyl-previous-buffer-mode nil)
 
-(eval-and-compile
-  (autoload 'gnus-set-text-properties "gnus-ems"))
-
 \f
 
 ;;; Interface functions
@@ -88,8 +75,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 (nnoo-define-basics nnbabyl)
 
 (deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (let ((number (length articles))
          (count 0)
@@ -149,8 +135,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
   ;; Restore buffer mode.
   (when (and (nnbabyl-server-opened)
             nnbabyl-previous-buffer-mode)
-    (save-excursion
-      (set-buffer nnbabyl-mbox-buffer)
+    (with-current-buffer nnbabyl-mbox-buffer
       (narrow-to-region
        (caar nnbabyl-previous-buffer-mode)
        (cdar nnbabyl-previous-buffer-mode))
@@ -168,8 +153,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 
 (deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
   (nnbabyl-possibly-change-newsgroup newsgroup server)
-  (save-excursion
-    (set-buffer nnbabyl-mbox-buffer)
+  (with-current-buffer nnbabyl-mbox-buffer
     (goto-char (point-min))
     (when (search-forward (nnbabyl-article-string article) nil t)
       (let (start stop summary-line)
@@ -207,7 +191,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
              (cons nnbabyl-current-group article)
            (nnbabyl-article-group-number)))))))
 
-(deffoo nnbabyl-request-group (group &optional server dont-check)
+(deffoo nnbabyl-request-group (group &optional server dont-check info)
   (let ((active (cadr (assoc group nnbabyl-group-alist))))
     (save-excursion
       (cond
@@ -229,8 +213,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
   (nnmail-get-new-mail
    'nnbabyl
    (lambda ()
-     (save-excursion
-       (set-buffer nnbabyl-mbox-buffer)
+     (with-current-buffer nnbabyl-mbox-buffer
        (save-buffer)))
    (file-name-directory nnbabyl-mbox-file)
    group
@@ -277,9 +260,8 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
         rest)
     (nnmail-activate 'nnbabyl)
 
-    (save-excursion
-      (set-buffer nnbabyl-mbox-buffer)
-      (gnus-set-text-properties (point-min) (point-max) nil)
+    (with-current-buffer nnbabyl-mbox-buffer
+      (set-text-properties (point-min) (point-max) nil)
       (while (and articles is-old)
        (goto-char (point-min))
        (when (search-forward (nnbabyl-article-string (car articles)) nil t)
@@ -296,7 +278,8 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
                                             (current-buffer))
                    (let ((nnml-current-directory nil))
                      (nnmail-expiry-target-group
-                      nnmail-expiry-target newsgroup))))
+                      nnmail-expiry-target newsgroup)))
+                 (nnbabyl-possibly-change-newsgroup newsgroup server))
                (nnheader-message 5 "Deleting article %d in %s..."
                                  (car articles) newsgroup)
                (nnbabyl-delete-mail))
@@ -315,13 +298,12 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
       (nconc rest articles))))
 
 (deffoo nnbabyl-request-move-article
-    (article group server accept-form &optional last)
+    (article group server accept-form &optional last move-is-internal)
   (let ((buf (get-buffer-create " *nnbabyl move*"))
        result)
     (and
      (nnbabyl-request-article article group server)
-     (save-excursion
-       (set-buffer buf)
+     (with-current-buffer buf
        (insert-buffer-substring nntp-server-buffer)
        (goto-char (point-min))
        (while (re-search-forward
@@ -356,7 +338,10 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
         (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
           (delete-region (point) (progn (forward-line 1) (point)))))
        (when nnmail-cache-accepted-message-ids
-        (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+        (nnmail-cache-insert (nnmail-fetch-field "message-id")
+                             group
+                             (nnmail-fetch-field "subject")
+                             (nnmail-fetch-field "from")))
        (setq result
             (if (stringp group)
                 (list (cons group (nnbabyl-active-number group)))
@@ -372,15 +357,17 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
        (insert-buffer-substring buf)
        (when last
         (when nnmail-cache-accepted-message-ids
-          (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+          (nnmail-cache-insert (nnmail-fetch-field "message-id")
+                               group
+                               (nnmail-fetch-field "subject")
+                               (nnmail-fetch-field "from")))
         (save-buffer)
         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
        result))))
 
 (deffoo nnbabyl-request-replace-article (article group buffer)
   (nnbabyl-possibly-change-newsgroup group)
-  (save-excursion
-    (set-buffer nnbabyl-mbox-buffer)
+  (with-current-buffer nnbabyl-mbox-buffer
     (goto-char (point-min))
     (if (not (search-forward (nnbabyl-article-string article) nil t))
        nil
@@ -394,8 +381,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
   ;; Delete all articles in GROUP.
   (if (not force)
       ()                               ; Don't delete the articles.
-    (save-excursion
-      (set-buffer nnbabyl-mbox-buffer)
+    (with-current-buffer nnbabyl-mbox-buffer
       (goto-char (point-min))
       ;; Delete all articles in this group.
       (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
@@ -415,8 +401,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 
 (deffoo nnbabyl-request-rename-group (group new-name &optional server)
   (nnbabyl-possibly-change-newsgroup group server)
-  (save-excursion
-    (set-buffer nnbabyl-mbox-buffer)
+  (with-current-buffer nnbabyl-mbox-buffer
     (goto-char (point-min))
     (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
          (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
@@ -494,7 +479,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
     (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
                             nil t)
       (cons (buffer-substring (match-beginning 1) (match-end 1))
-           (string-to-int
+           (string-to-number
             (buffer-substring (match-beginning 2) (match-end 2)))))))
 
 (defun nnbabyl-insert-lines ()
@@ -564,9 +549,8 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 (defun nnbabyl-create-mbox ()
   (unless (file-exists-p nnbabyl-mbox-file)
     ;; Create a new, empty RMAIL mbox file.
-    (save-excursion
-      (set-buffer (setq nnbabyl-mbox-buffer
-                       (create-file-buffer nnbabyl-mbox-file)))
+    (with-current-buffer (setq nnbabyl-mbox-buffer
+                              (create-file-buffer nnbabyl-mbox-file))
       (setq buffer-file-name nnbabyl-mbox-file)
       (insert "BABYL OPTIONS:\n\n\^_")
       (nnmail-write-region
@@ -578,8 +562,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 
   (unless (and nnbabyl-mbox-buffer
               (buffer-name nnbabyl-mbox-buffer)
-              (save-excursion
-                (set-buffer nnbabyl-mbox-buffer)
+              (with-current-buffer nnbabyl-mbox-buffer
                 (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
     ;; This buffer has changed since we read it last.  Possibly.
     (save-excursion