X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnmaildir.el;h=18c6eb110bd8da05491eab5dd9410eff6611430e;hb=ca101d0305c3ff2ecc44dade2025c974ffc7168a;hp=dff0443067065e191ba18f4d10c342a4b0988e33;hpb=deefcadcd864c43eb6dc3191339b0d5132a40cd2;p=elisp%2Fgnus.git- diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el index dff0443..18c6eb1 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -41,16 +41,14 @@ ;; copying, restoring, etc. ;; ;; Todo: -;; * Merge the information from -;; into the Gnus manual. -;; * Allow create-directory = ".", and configurable prefix of maildir names, -;; stripped off to produce group names. +;; * Replace create-directory with target-prefix, so the maildirs can be in +;; the same directory as the symlinks, starting with, e.g., ".". ;; * Add a hook for when moving messages from new/ to cur/, to support ;; nnmail's duplicate detection. ;; * Allow each mark directory in a group to have its own inode for mark ;; files, to accommodate AFS. ;; * Improve generated Xrefs, so crossposts are detectable. -;; * Improve readability. +;; * Improve code readability. ;;; Code: @@ -86,8 +84,8 @@ by nnmaildir-request-article.") ;; Variables to generate filenames of messages being delivered: (defvar nnmaildir--delivery-time "") -(defconst nnmaildir--delivery-pid (number-to-string (emacs-pid))) -(defvar nnmaildir--delivery-ct nil) +(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid)))) +(defvar nnmaildir--delivery-count nil) ;; An obarry containing symbols whose names are server names and whose values ;; are servers: @@ -620,17 +618,13 @@ by nnmaildir-request-article.") (defun nnmaildir--parse-filename (file) (let ((prefix (car file)) timestamp len) - (if (string-match - "\\`\\([0-9]+\\)\\.\\([0-9]+\\)\\(_\\([0-9]+\\)\\)?\\(\\..*\\)\\'" - prefix) + (if (string-match "\\`\\([0-9]+\\)\\(\\..*\\)\\'" prefix) (progn (setq timestamp (concat "0000" (match-string 1 prefix)) len (- (length timestamp) 4)) (vector (string-to-number (substring timestamp 0 len)) (string-to-number (substring timestamp len)) - (string-to-number (match-string 2 prefix)) - (string-to-number (or (match-string 4 prefix) "-1")) - (match-string 5 prefix) + (match-string 2 prefix) file)) file))) @@ -643,11 +637,7 @@ by nnmaildir-request-article.") (if (> (aref a 0) (aref b 0)) (throw 'return nil)) (if (< (aref a 1) (aref b 1)) (throw 'return t)) (if (> (aref a 1) (aref b 1)) (throw 'return nil)) - (if (< (aref a 2) (aref b 2)) (throw 'return t)) - (if (> (aref a 2) (aref b 2)) (throw 'return nil)) - (if (< (aref a 3) (aref b 3)) (throw 'return t)) - (if (> (aref a 3) (aref b 3)) (throw 'return nil)) - (string-lessp (aref a 4) (aref b 4)))) + (string-lessp (aref a 2) (aref b 2)))) (defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls) (catch 'return @@ -703,7 +693,9 @@ by nnmaildir-request-article.") (when (or isnew nattr) (mapcar (lambda (file) - (rename-file (concat ndir file) (concat cdir file ":2,"))) + (let ((path (concat ndir file))) + (and (time-less-p (nth 5 (file-attributes path)) (current-time)) + (rename-file path (concat cdir file ":2,"))))) (funcall ls ndir nil "\\`[^.]" 'nosort)) (setf (nnmaildir--grp-new group) nattr)) (setq cattr (nth 5 (file-attributes cdir))) @@ -751,7 +743,7 @@ by nnmaildir-request-article.") files (sort files 'nnmaildir--sort-files)) (mapcar (lambda (file) - (setq file (if (consp file) file (aref file 5)) + (setq file (if (consp file) file (aref file 3)) x (make-nnmaildir--art :prefix (car file) :suffix (cdr file))) (nnmaildir--grp-add-art nnmaildir--cur-server group x)) files) @@ -855,9 +847,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-update-info (gname info &optional server) (let ((group (nnmaildir--prepare server gname)) - pgname flist all always-marks never-marks old-marks dotfile num dir + pgname flist always-marks never-marks old-marks dotfile num dir markdirs marks mark ranges markdir article read end new-marks ls - old-mmth new-mmth mtime mark-sym deactivate-mark) + old-mmth new-mmth mtime mark-sym existing missing deactivate-mark) (catch 'return (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) @@ -874,6 +866,13 @@ by nnmaildir-request-article.") old-marks (cons old-marks (gnus-info-marks info)) always-marks (nnmaildir--param pgname 'always-marks) never-marks (nnmaildir--param pgname 'never-marks) + existing (nnmaildir--grp-nlist group) + existing (mapcar 'car existing) + existing (nreverse existing) + existing (gnus-compress-sequence existing 'always-list) + missing (list (cons 1 (nnmaildir--group-maxnum + nnmaildir--cur-server group))) + missing (gnus-range-difference missing existing) dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--nndir dir) @@ -891,13 +890,7 @@ by nnmaildir-request-article.") (catch 'got-ranges (if (memq mark-sym never-marks) (throw 'got-ranges nil)) (when (memq mark-sym always-marks) - (unless all - (setq all (nnmaildir--grp-nlist group) - all (mapcar 'car all) - all (nreverse all) - all (gnus-compress-sequence all 'always-list) - all (cons 'dummy-mark-symbol all))) - (setq ranges (cdr all)) + (setq ranges existing) (throw 'got-ranges nil)) (setq mtime (nth 5 (file-attributes markdir))) (set (intern mark new-mmth) mtime) @@ -916,7 +909,7 @@ by nnmaildir-request-article.") (if (eq mark-sym 'read) (setq read ranges) (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) markdirs) - (gnus-info-set-read info read) + (gnus-info-set-read info (gnus-range-add read missing)) (gnus-info-set-marks info marks 'extend) (setf (nnmaildir--grp-mmth group) new-mmth) info))) @@ -1265,7 +1258,7 @@ by nnmaildir-request-article.") (coding-system-for-write nnheader-file-coding-system) (buffer-file-coding-system nil) (file-coding-system-alist nil) - srv-dir dir file tmpfile curfile 24h article) + srv-dir dir file time tmpfile curfile 24h article) (catch 'return (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) @@ -1279,15 +1272,17 @@ by nnmaildir-request-article.") (throw 'return nil)) (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir srv-dir gname) - file (format-time-string "%s" nil)) + time (current-time) + file (format-time-string "%s." time)) (unless (string-equal nnmaildir--delivery-time file) (setq nnmaildir--delivery-time file - nnmaildir--delivery-ct 0)) - (setq file (concat file "." nnmaildir--delivery-pid)) - (unless (zerop nnmaildir--delivery-ct) - (setq file (concat file "_" - (number-to-string nnmaildir--delivery-ct)))) - (setq file (concat file "." (system-name)) + nnmaildir--delivery-count 0)) + (when (and (consp (cdr time)) + (consp (cddr time))) + (setq file (concat file "M" (number-to-string (caddr time))))) + (setq file (concat file nnmaildir--delivery-pid) + file (concat file "Q" (number-to-string nnmaildir--delivery-count)) + file (concat file "." (system-name)) ;;;; FIXME: encode / and : tmpfile (concat (nnmaildir--tmp dir) file) curfile (concat (nnmaildir--cur dir) file ":2,")) (when (file-exists-p tmpfile) @@ -1298,7 +1293,7 @@ by nnmaildir-request-article.") (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "File exists: " curfile)) (throw 'return nil)) - (setq nnmaildir--delivery-ct (1+ nnmaildir--delivery-ct) + (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count) 24h (run-with-timer 86400 nil (lambda () (nnmaildir--unlink tmpfile)