X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnml.el;h=a2947c0a9927b0503174313f2eb17d7929cb4e16;hp=11cdfd768c3b5893247f967cd96acad98bbdcc92;hb=94f288135f95ca48fb50f5aa43bc09f9669c5c23;hpb=d664b182776f988b5bcc4e95feae02089d41d7fd;ds=sidebyside diff --git a/lisp/nnml.el b/lisp/nnml.el index 11cdfd768..a2947c0a9 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -1,10 +1,9 @@ ;;; nnml.el --- mail spool access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1995-2015 Free Software Foundation, Inc. ;; Authors: Didier Verna (adding compaction) -;; Simon Josefsson (adding MARKS) +;; Simon Josefsson ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail @@ -67,15 +66,6 @@ the `nnml-generate-nov-databases' command. The function will go 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.") @@ -102,7 +92,6 @@ non-nil.") "nnml version.") (defvoo nnml-nov-file-name ".overview") -(defvoo nnml-marks-file-name ".marks") (defvoo nnml-current-directory nil) (defvoo nnml-current-group nil) @@ -118,10 +107,6 @@ non-nil.") (defvoo nnml-file-coding-system nnmail-file-coding-system) -(defvoo nnml-marks nil) - -(defvar nnml-marks-modtime (gnus-make-hashtable)) - ;;; Interface functions. @@ -193,7 +178,7 @@ non-nil.") (> 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) @@ -235,7 +220,11 @@ non-nil.") (nnheader-article-to-file-alist (setq gpath (nnml-group-pathname (car group-num) nil server)))))) - (setq path (concat gpath (int-to-string (cdr group-num))))) + (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) @@ -282,7 +271,15 @@ non-nil.") (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-incremental-nov nnml-directory group)) + (cond + (group + (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group)) + ((nnmail-get-new-mail-per-group) + (nnml-request-list) + (dolist (entry nnml-group-alist) + (nnml-request-scan (car entry) server))) + (t + (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory nil)))) (deffoo nnml-close-group (group &optional server) (setq nnml-article-file-alist nil) @@ -509,8 +506,7 @@ non-nil.") nnml-current-directory t (concat nnheader-numerical-short-files - "\\|" (regexp-quote nnml-nov-file-name) "$" - "\\|" (regexp-quote nnml-marks-file-name) "$"))) + "\\|" (regexp-quote nnml-nov-file-name) "$"))) (decoded (nnml-decoded-group-name group server))) (dolist (article articles) (when (file-writable-p article) @@ -550,10 +546,6 @@ non-nil.") (let ((overview (concat old-dir nnml-nov-file-name))) (when (file-exists-p overview) (rename-file overview (concat new-dir nnml-nov-file-name)))) - ;; Move .marks file. - (let ((marks (concat old-dir nnml-marks-file-name))) - (when (file-exists-p marks) - (rename-file marks (concat new-dir nnml-marks-file-name)))) (when (<= (length (directory-files old-dir)) 2) (ignore-errors (delete-directory old-dir))) ;; That went ok, so we change the internal structures. @@ -846,7 +838,9 @@ article number. This function is called narrowed to an article." buffer)) (defun nnml-open-nov (group) - (or (cdr (assoc group nnml-nov-buffer-alist)) + (or (let ((buffer (cdr (assoc group nnml-nov-buffer-alist)))) + (and (buffer-name buffer) + buffer)) (let ((buffer (nnml-get-nov-buffer group))) (push (cons group buffer) nnml-nov-buffer-alist) buffer))) @@ -942,22 +936,23 @@ Unless no-active is non-nil, update the active file too." (when (file-exists-p nov) (funcall nnmail-delete-file-function nov)) (dolist (file files) - (unless (file-directory-p (setq file (concat dir (cdr file)))) - (erase-buffer) - (nnheader-insert-file-contents file) - (narrow-to-region - (goto-char (point-min)) - (progn - (re-search-forward "\n\r?\n" nil t) - (setq chars (- (point-max) (point))) - (max (point-min) (1- (point))))) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (setq headers (nnml-parse-head chars (car file))) - (with-current-buffer nov-buffer - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (widen))) + (let ((path (concat dir (cdr file)))) + (unless (file-directory-p path) + (erase-buffer) + (nnheader-insert-file-contents path) + (narrow-to-region + (goto-char (point-min)) + (progn + (re-search-forward "\n\r?\n" nil t) + (setq chars (- (point-max) (point))) + (max (point-min) (1- (point))))) + (unless (zerop (buffer-size)) + (goto-char (point-min)) + (setq headers (nnml-parse-head chars (car file))) + (with-current-buffer nov-buffer + (goto-char (point-max)) + (nnheader-insert-nov headers))) + (widen)))) (with-current-buffer nov-buffer (nnmail-write-region (point-min) (point-max) nov nil 'nomesg) (kill-buffer (current-buffer)))))) @@ -1026,111 +1021,6 @@ Use the nov database for the current group if available." (forward-line 1)) alist)))) -(deffoo nnml-request-set-mark (group actions &optional server) - (nnml-possibly-change-directory group server) - (unless nnml-marks-is-evil - (nnml-open-marks group server) - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) nil - "Unknown request-set-mark action: %s" what) - (dolist (mark marks) - (setq nnml-marks (gnus-update-alist-soft - mark - (funcall (if (eq what 'add) 'gnus-range-add - 'gnus-remove-from-range) - (cdr (assoc mark nnml-marks)) range) - nnml-marks))))) - (nnml-save-marks group server)) - nil) - -(deffoo nnml-request-update-info (group info &optional server) - (nnml-possibly-change-directory group server) - (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server)) - (nnheader-message 8 "Updating marks for %s..." group) - (nnml-open-marks group server) - ;; Update info using `nnml-marks'. - (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) nnml-marks)) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) - (let ((seen (cdr (assq 'read nnml-marks)))) - (gnus-info-set-read info - (if (and (integerp (car seen)) - (null (cdr seen))) - (list (cons (car seen) (car seen))) - seen))) - (nnheader-message 8 "Updating marks for %s...done" group)) - info) - -(defun nnml-marks-changed-p (group server) - (let ((file (nnml-group-pathname group nnml-marks-file-name server))) - (if (null (gnus-gethash file nnml-marks-modtime)) - t ;; never looked at marks file, assume it has changed - (not (equal (gnus-gethash file nnml-marks-modtime) - (nth 5 (file-attributes file))))))) - -(defun nnml-save-marks (group server) - (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (nnml-group-pathname group nnml-marks-file-name server))) - (condition-case err - (progn - (nnml-possibly-create-directory group server) - (with-temp-file file - (erase-buffer) - (gnus-prin1 nnml-marks) - (insert "\n")) - (gnus-sethash file - (nth 5 (file-attributes file)) - nnml-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)" file err)))))) - -(defun nnml-open-marks (group server) - (let* ((decoded (nnml-decoded-group-name group server)) - (file (nnmail-group-pathname decoded nnml-directory - nnml-marks-file-name)) - (file-name-coding-system nnmail-pathname-coding-system)) - (if (file-exists-p file) - (condition-case err - (with-temp-buffer - (gnus-sethash file (nth 5 (file-attributes file)) - nnml-marks-modtime) - (nnheader-insert-file-contents file) - (setq nnml-marks (read (current-buffer))) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnml-marks (gnus-remassoc el nnml-marks)))) - (error (or (gnus-yes-or-no-p - (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) - (error "Cannot read nnml marks file %s (%s)" file err)))) - ;; User didn't have a .marks file. Probably first time - ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. - (let ((info (gnus-get-info - (gnus-group-prefixed-name - group - (gnus-server-to-method - (format "nnml:%s" (or server ""))))))) - (setq decoded (if (member server '(nil "")) - (concat "nnml:" decoded) - (format "nnml+%s:%s" server decoded))) - (nnheader-message 7 "Bootstrapping marks for %s..." decoded) - (setq nnml-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nnml-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnml-marks (gnus-remassoc el nnml-marks))) - (nnml-save-marks group server) - (nnheader-message 7 "Bootstrapping marks for %s...done" decoded))))) - - ;;; ;;; Group and server compaction. -- dvl ;;; @@ -1212,13 +1102,16 @@ Use the nov database for the current group if available." (concat group ":" new-number-string))) ;; Save to the new file: (nnmail-write-region (point-min) (point-max) newfile)) - (funcall nnmail-delete-file-function oldfile)) + (condition-case () + (funcall nnmail-delete-file-function oldfile) + (file-error + (message "Couldn't delete %s" oldfile)))) ;; 2/ Update all marks for this article: ;; #### NOTE: it is possible that the new article number ;; #### already belongs to a range, whereas the corresponding ;; #### article doesn't exist (for example, if you delete an ;; #### article). For that reason, it is important to update - ;; #### the ranges (meaning remove inexistent articles) before + ;; #### the ranges (meaning remove nonexistent articles) before ;; #### doing anything on them. ;; 2 a/ read articles: (let ((read (gnus-info-read info))) @@ -1280,19 +1173,11 @@ Use the nov database for the current group if available." (gnus-set-active group-full-name active)) ;; 1 bis/ ;; #### NOTE: normally, we should save the overview (NOV) file - ;; #### here, just like we save the marks file. However, there is no - ;; #### such function as nnml-save-nov for a single group. Only for - ;; #### all groups. Gnus inconsistency is getting worse every day... - ;; 2/ Rebuild marks file: - (unless nnml-marks-is-evil - ;; #### NOTE: this constant use of global variables everywhere is - ;; #### truly disgusting. Gnus really needs a *major* cleanup. - (setq nnml-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nnml-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnml-marks (gnus-remassoc el nnml-marks))) - (nnml-save-marks group server)) - ;; 3/ Save everything if this was not part of a bigger operation: + ;; #### here. However, there is no such function as + ;; #### nnml-save-nov for a single group. Only for all + ;; #### groups. Gnus inconsistency is getting worse every + ;; #### day... ;; 3/ Save everything if this was not part of + ;; #### a bigger operation: (if (not save) ;; Nothing to save (yet): t