;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
-;; Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'nnoo)
(eval-when-compile (require 'cl))
-(eval-and-compile
- (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
+;; FIXME first is unused in this file.
+(autoload 'gnus-article-unpropagatable-p "gnus-sum")
+(autoload 'gnus-backlog-remove-article "gnus-bcklg")
(nnoo-declare nnml)
through all nnml directories and generate nov databases for them
all. This may very well take some time.")
-(defvoo nnml-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail spools.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set this
-to t, and want to set it to nil again, you should always remove the
-corresponding marks file (usually named `.marks' in the nnml group
-directory, but see `nnml-marks-file-name') for the group. Then the
-marks file will be regenerated properly by Gnus.")
-
(defvoo nnml-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
"If non-nil, inhibit expiry.")
(defvoo nnml-use-compressed-files nil
- "If non-nil, allow using compressed message files.")
+ "If non-nil, allow using compressed message files.
+
+If it is a string, use it as the file extension which specifies
+the compression program. You can set it to \".bz2\" if your Emacs
+supports auto-compression using the bzip2 program. A value of t
+is equivalent to \".gz\".")
(defvoo nnml-compressed-files-size-threshold 1000
"Default size threshold for compressed message files.
"nnml version.")
(defvoo nnml-nov-file-name ".overview")
-(defvoo nnml-marks-file-name ".marks")
(defvoo nnml-current-directory nil)
(defvoo nnml-current-group nil)
(defvoo nnml-file-coding-system nnmail-file-coding-system)
-(defvoo nnml-marks nil)
-
-(defvar nnml-marks-modtime (gnus-make-hashtable))
-
\f
;;; Interface functions.
(nnoo-define-basics nnml)
+(eval-when-compile
+ (defsubst nnml-group-name-charset (group server-or-method)
+ (gnus-group-name-charset
+ (if (stringp server-or-method)
+ (gnus-server-to-method
+ (if (string-match "\\+" server-or-method)
+ (concat (substring server-or-method 0 (match-beginning 0))
+ ":" (substring server-or-method (match-end 0)))
+ (concat "nnml:" server-or-method)))
+ (or server-or-method gnus-command-method '(nnml "")))
+ group)))
+
+(defun nnml-decoded-group-name (group &optional server-or-method)
+ "Return a decoded group name of GROUP on SERVER-OR-METHOD."
+ (if nnmail-group-names-not-encoded-p
+ group
+ (mm-decode-coding-string
+ group
+ (nnml-group-name-charset group server-or-method))))
+
+(defun nnml-encoded-group-name (group &optional server-or-method)
+ "Return an encoded group name of GROUP on SERVER-OR-METHOD."
+ (mm-encode-coding-string
+ group
+ (nnml-group-name-charset group server-or-method)))
+
+(defun nnml-group-pathname (group &optional file server)
+ "Return an absolute file name of FILE for GROUP on SERVER."
+ (nnmail-group-pathname (inline (nnml-decoded-group-name group server))
+ nnml-directory file))
+
(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
(when (nnml-possibly-change-directory group server)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(let* ((file nil)
(number (length sequence))
(> number nnmail-large-newsgroup)
(zerop (% count 20))
(nnheader-message 6 "nnml: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
(file-name-coding-system nnmail-pathname-coding-system)
path gpath group-num)
(if (stringp id)
- (when (and (setq group-num (nnml-find-group-number id))
+ (when (and (setq group-num (nnml-find-group-number id server))
(cdr
(assq (cdr group-num)
(nnheader-article-to-file-alist
- (setq gpath
- (nnmail-group-pathname
- (car group-num)
- nnml-directory))))))
- (setq path (concat gpath (int-to-string (cdr group-num)))))
+ (setq gpath (nnml-group-pathname (car group-num)
+ nil server))))))
+ (nnml-update-file-alist)
+ (setq path (concat gpath (if nnml-use-compressed-files
+ (cdr (assq (cdr group-num)
+ nnml-article-file-alist))
+ (number-to-string (cdr group-num))))))
(setq path (nnml-article-to-file id)))
(cond
((not path)
(cons (if group-num (car group-num) group)
(string-to-number (file-name-nondirectory path)))))))
-(deffoo nnml-request-group (group &optional server dont-check)
- (let ((file-name-coding-system nnmail-pathname-coding-system))
+(deffoo nnml-request-group (group &optional server dont-check info)
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (decoded (nnml-decoded-group-name group server)))
(cond
((not (nnml-possibly-change-directory group server))
(nnheader-report 'nnml "Invalid group (no such directory)"))
((not (file-directory-p nnml-current-directory))
(nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
(dont-check
- (nnheader-report 'nnml "Group %s selected" group)
+ (nnheader-report 'nnml "Group %s selected" decoded)
t)
(t
(nnheader-re-read-dir nnml-current-directory)
(nnmail-activate 'nnml)
(let ((active (nth 1 (assoc group nnml-group-alist))))
(if (not active)
- (nnheader-report 'nnml "No such group: %s" group)
- (nnheader-report 'nnml "Selected group %s" group)
+ (nnheader-report 'nnml "No such group: %s" decoded)
+ (nnheader-report 'nnml "Selected group %s" decoded)
(nnheader-insert "211 %d %d %d %s\n"
(max (1+ (- (cdr active) (car active))) 0)
(car active) (cdr active) group)))))))
(deffoo nnml-request-scan (&optional group server)
(setq nnml-article-file-alist nil)
(nnml-possibly-change-directory group server)
- (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
+ (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group))
(deffoo nnml-close-group (group &optional server)
(setq nnml-article-file-alist nil)
(nnml-possibly-change-directory nil server)
(nnmail-activate 'nnml)
(cond
+ ((let ((file (directory-file-name (nnml-group-pathname group nil server)))
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (and (file-exists-p file)
+ (not (file-directory-p file))))
+ (nnheader-report 'nnml "%s is a file"
+ (directory-file-name (nnml-group-pathname group
+ nil server))))
((assoc group nnml-group-alist)
t)
- ((and (file-exists-p (nnmail-group-pathname group nnml-directory))
- (not (file-directory-p (nnmail-group-pathname group nnml-directory))))
- (nnheader-report 'nnml "%s is a file"
- (nnmail-group-pathname group nnml-directory)))
(t
(let (active)
(push (list group (setq active (cons 1 0)))
nnml-group-alist)
- (nnml-possibly-create-directory group)
+ (nnml-possibly-create-directory group server)
(nnml-possibly-change-directory group server)
- (let ((articles (nnml-directory-articles nnml-current-directory)))
+ (let* ((file-name-coding-system nnmail-pathname-coding-system)
+ (articles (nnml-directory-articles nnml-current-directory)))
(when articles
(setcar active (apply 'min articles))
(setcdr active (apply 'max articles))))
(deffoo nnml-request-expire-articles (articles group &optional server force)
(nnml-possibly-change-directory group server)
- (let ((active-articles
- (nnml-directory-articles nnml-current-directory))
- (is-old t)
- article rest mod-time number)
+ (let* ((file-name-coding-system nnmail-pathname-coding-system)
+ (active-articles
+ (nnml-directory-articles nnml-current-directory))
+ (is-old t)
+ (decoded (nnml-decoded-group-name group server))
+ article rest mod-time number target)
(nnmail-activate 'nnml)
(setq active-articles (sort active-articles '<))
nnml-inhibit-expiry)))
(progn
;; Allow a special target group.
- (unless (eq nnmail-expiry-target 'delete)
+ (setq target nnmail-expiry-target)
+ (unless (eq target 'delete)
(with-temp-buffer
(nnml-request-article number group server (current-buffer))
(let (nnml-current-directory
nnml-current-group
nnml-article-file-alist)
- (nnmail-expiry-target-group nnmail-expiry-target group)))
+ (when (functionp target)
+ (setq target (funcall target group)))
+ (when (and target (not (eq target 'delete)))
+ (if (or (gnus-request-group target)
+ (gnus-request-create-group target))
+ (nnmail-expiry-target-group target group)
+ (setq target nil)))))
;; Maybe directory is changed during nnmail-expiry-target-group.
(nnml-possibly-change-directory group server))
- (nnheader-message 5 "Deleting article %s in %s"
- number group)
- (condition-case ()
- (funcall nnmail-delete-file-function article)
- (file-error
- (push number rest)))
- (setq active-articles (delq number active-articles))
- (nnml-nov-delete-article group number))
+ (if target
+ (progn
+ (nnheader-message 5 "Deleting article %s in %s"
+ number decoded)
+ (condition-case ()
+ (funcall nnmail-delete-file-function article)
+ (file-error
+ (push number rest)))
+ (setq active-articles (delq number active-articles))
+ (nnml-nov-delete-article group number))
+ (push number rest)))
(push number rest)))
(let ((active (nth 1 (assoc group nnml-group-alist))))
(when active
(deffoo nnml-request-move-article
(article group server accept-form &optional last move-is-internal)
(let ((buf (get-buffer-create " *nnml move*"))
+ (file-name-coding-system nnmail-pathname-coding-system)
result)
(nnml-possibly-change-directory group server)
(nnml-update-file-alist)
(let (nnml-current-directory
nnml-current-group
nnml-article-file-alist)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(insert-buffer-substring nntp-server-buffer)
&
projects / gnus / blobdiff