;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
;; 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,
;; 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:
((search-backward (concat "\n" nnfolder-article-marker)
nil t)
(goto-char (match-end 0))
- (setq num (string-to-int
+ (setq num (string-to-number
(buffer-substring
(point) (point-at-eol))))
(goto-char start)
(search-forward (concat "\n" nnfolder-article-marker)
nil t)
(progn
- (setq num (string-to-int
+ (setq num (string-to-number
(buffer-substring
(point) (point-at-eol))))
(> num article))
(cons nnfolder-current-group
(if (search-forward (concat "\n" nnfolder-article-marker)
nil t)
- (string-to-int (buffer-substring
+ (string-to-number (buffer-substring
(point) (point-at-eol)))
-1))))))))
(deffoo nnfolder-request-group (group &optional server dont-check)
(nnfolder-possibly-change-group group server t)
(save-excursion
- (if (not (assoc group nnfolder-group-alist))
- (nnheader-report 'nnfolder "No such group: %s" group)
- (if dont-check
- (progn
- (nnheader-report 'nnfolder "Selected group %s" group)
- t)
- (let* ((active (assoc group nnfolder-group-alist))
- (group (car active))
- (range (cadr active)))
- (cond
- ((null active)
- (nnheader-report 'nnfolder "No such group: %s" group))
- ((null nnfolder-current-group)
- (nnheader-report 'nnfolder "Empty group: %s" group))
- (t
- (nnheader-report 'nnfolder "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
- (1+ (- (cdr range) (car range)))
- (car range) (cdr range) group))))))))
+ (cond ((not (assoc group nnfolder-group-alist))
+ (nnheader-report 'nnfolder "No such group: %s" group))
+ ((file-directory-p (nnfolder-group-pathname group))
+ (nnheader-report 'nnfolder "%s is a directory"
+ (file-name-as-directory
+ (let ((nnmail-pathname-coding-system nil))
+ (nnfolder-group-pathname group)))))
+ (dont-check
+ (nnheader-report 'nnfolder "Selected group %s" group)
+ t)
+ (t
+ (let* ((active (assoc group nnfolder-group-alist))
+ (group (car active))
+ (range (cadr active)))
+ (cond
+ ((null active)
+ (nnheader-report 'nnfolder "No such group: %s" group))
+ ((null nnfolder-current-group)
+ (nnheader-report 'nnfolder "Empty group: %s" group))
+ (t
+ (nnheader-report 'nnfolder "Selected group %s" group)
+ (nnheader-insert "211 %d %d %d %s\n"
+ (1+ (- (cdr range) (car range)))
+ (car range) (cdr range) group))))))))
(deffoo nnfolder-request-scan (&optional group server)
(nnfolder-possibly-change-group nil server)
(deffoo nnfolder-request-create-group (group &optional server args)
(nnfolder-possibly-change-group nil server)
(nnmail-activate 'nnfolder)
- (when group
- (unless (assoc group nnfolder-group-alist)
- (push (list group (cons 1 0)) nnfolder-group-alist)
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- (nnfolder-read-folder group)))
- t)
+ (cond ((zerop (length group))
+ (nnheader-report 'nnfolder "Invalid (empty) group name"))
+ ((file-directory-p (nnfolder-group-pathname group))
+ (nnheader-report 'nnfolder "%s is a directory"
+ (file-name-as-directory
+ (let ((nnmail-pathname-coding-system nil))
+ (nnfolder-group-pathname group)))))
+ ((assoc group nnfolder-group-alist)
+ t)
+ (t
+ (push (list group (cons 1 0)) nnfolder-group-alist)
+ (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
+ (save-current-buffer
+ (nnfolder-read-folder group))
+ t)))
(deffoo nnfolder-request-list (&optional server)
(nnfolder-possibly-change-group nil server)
;; The article numbers are increasing, so this result is sorted.
(nreverse numbers)))))
-(deffoo nnfolder-request-expire-articles
- (articles newsgroup &optional server force)
+(deffoo nnfolder-request-expire-articles (articles newsgroup
+ &optional server force)
(nnfolder-possibly-change-group newsgroup server)
- (let* ((is-old t)
- ;; The articles we have deleted so far.
- (deleted-articles nil)
- ;; The articles that really exist and will
- ;; be expired if they are old enough.
- (maybe-expirable
- (gnus-sorted-intersection articles (nnfolder-existing-articles))))
+ (let ((is-old t)
+ ;; The articles we have deleted so far.
+ (deleted-articles nil)
+ ;; The articles that really exist and will
+ ;; be expired if they are old enough.
+ (maybe-expirable
+ (gnus-sorted-intersection articles (nnfolder-existing-articles)))
+ target)
(nnmail-activate 'nnfolder)
(save-excursion
(buffer-substring
(point) (progn (end-of-line) (point)))
force nnfolder-inhibit-expiry))
- (unless (eq nnmail-expiry-target 'delete)
+ (setq target nnmail-expiry-target)
+ (unless (eq target 'delete)
(with-temp-buffer
(nnfolder-request-article (car maybe-expirable)
newsgroup server (current-buffer))
(let ((nnfolder-current-directory nil))
- (nnmail-expiry-target-group
- nnmail-expiry-target newsgroup)))
+ (when (functionp target)
+ (setq target (funcall target newsgroup)))
+ (if (and target
+ (or (gnus-request-group target)
+ (gnus-request-create-group target)))
+ (nnmail-expiry-target-group target newsgroup)
+ (setq target nil))))
(nnfolder-possibly-change-group newsgroup server))
- (nnheader-message 5 "Deleting article %d in %s..."
- (car maybe-expirable) newsgroup)
- (nnfolder-delete-mail)
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (nnfolder-nov-delete-article newsgroup (car maybe-expirable)))
- ;; Must remember which articles were actually deleted
- (push (car maybe-expirable) deleted-articles)))
+ (when target
+ (nnheader-message 5 "Deleting article %d in %s..."
+ (car maybe-expirable) newsgroup)
+ (nnfolder-delete-mail)
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (nnfolder-nov-delete-article newsgroup (car maybe-expirable)))
+ ;; Must remember which articles were actually deleted
+ (push (car maybe-expirable) deleted-articles))))
(setq maybe-expirable (cdr maybe-expirable)))
(unless nnfolder-inhibit-expiry
(nnheader-message 5 "Deleting articles...done"))
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
(gnus-sorted-difference articles (nreverse deleted-articles)))))
-(deffoo nnfolder-request-move-article (article group server
- accept-form &optional last)
+(deffoo nnfolder-request-move-article (article group server accept-form
+ &optional last move-is-internal)
(save-excursion
(let ((buf (get-buffer-create " *nnfolder move*"))
result)
(insert "\n"))
(forward-char -1)
(insert (format (concat nnfolder-article-marker "%d %s\n")
- (cdr group-art) (current-time-string)))))
+ (cdr group-art) (message-make-date)))))
(defun nnfolder-active-number (group)
;; Find the next article number in GROUP.
(buffer (set-buffer
(let ((nnheader-file-coding-system
nnfolder-file-coding-system))
- (nnheader-find-file-noselect file)))))
+ (nnheader-find-file-noselect file t)))))
(mm-enable-multibyte) ;; Use multibyte buffer for future copying.
+ (buffer-disable-undo)
(if (equal (cadr (assoc group nnfolder-scantime-alist))
(nth 5 (file-attributes file)))
;; This looks up-to-date, so we don't do any scanning.
maxid start end newscantime
novbuf articles newnum
buffer-read-only)
- (buffer-disable-undo)
(setq maxid (cdr active))
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil
(when (not (message-mail-file-mbox-p file))
(ignore-errors
(delete-file file)))))
- (let ((files (directory-files nnfolder-directory))
- file)
- (while (setq file (pop files))
+ (dolist (file (directory-files nnfolder-directory))
(when (and (not (backup-file-name-p file))
(message-mail-file-mbox-p
(nnheader-concat nnfolder-directory file)))
(nnfolder-possibly-change-folder file)
(nnfolder-possibly-change-group file)
(nnfolder-close-group file))))
- (nnheader-message 5 "")))
+ (nnheader-message 5 ""))
(defun nnfolder-group-pathname (group)
"Make file name for GROUP."
(gnus-make-directory (file-name-directory (buffer-file-name)))
(let ((coding-system-for-write
(or nnfolder-file-coding-system-for-write
- nnfolder-file-coding-system)))
+ nnfolder-file-coding-system))
+ (copyright-update nil))
(save-buffer)))
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(nnfolder-save-nov)))
(let ((range (nth 0 action))
(what (nth 1 action))
(marks (nth 2 action)))
- (assert (or (eq what 'add) (eq what 'del)) t
+ (assert (or (eq what 'add) (eq what 'del)) nil
"Unknown request-set-mark action: %s" what)
(dolist (mark marks)
(setq nnfolder-marks (gnus-update-alist-soft
(nnheader-message 8 "Updating marks for %s..." group)
(nnfolder-open-marks group server)
;; Update info using `nnfolder-marks'.
- (mapcar (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnfolder-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
+ (mapc (lambda (pred)
+ (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (cdr (assq (cdr pred) nnfolder-marks))
+ (gnus-info-marks info))
+ t)))
+ gnus-article-mark-lists)
(let ((seen (cdr (assq 'read nnfolder-marks))))
(gnus-info-set-read info
(if (and (integerp (car seen))
nnfolder-marks-modtime))
(error (or (gnus-yes-or-no-p
(format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" err))))))
+ (error "Cannot write to %s (%s)" file err))))))
(defun nnfolder-open-marks (group server)
(let ((file (nnfolder-group-marks-pathname group)))
(provide 'nnfolder)
+;;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6
;;; nnfolder.el ends here
projects / gnus / blobdiff