bug#8055: Patch for handling Maildir flags in nnmaildir

[Magnus Henoch]

[ And apparently you can't unarchive and comment on a bug report in the
same email... Resending my patches so they appear in the bug report
itself. ]

This annoyed me enough to make me dive into the code and try to fix it.
Please find attached my proposed changes, in 3 parts.  I also keep them
in a repository on Github:
https://github.com/legoscia/gnus/tree/nnmaildir-flags-may-eat-your-email

I've been using this code for a week, and despite the branch name, it
hasn't eaten my email yet.

In my change, I made the Gnus `read', `tick' and `reply' marks
correspond to the Maildir S, F and R flags, respectively.  Other marks
are kept as hardlinks in the marks directory, as before.  The new code
will read marks from both sources, and when marks are cleared, they will
be cleared in both places, but when marks that correspond to flags are
added, they will only be added to the filename.  That means that the new
nnmaildir should read directories used by old nnmaildir versions
correctly, but if you use an old nnmaildir on a directory previously
used with the new version, marks will be missing.  Is that acceptable?

My patches don't address the performance and disk space issues mentioned
in this bug report; my aim was to make it correct first, and fast later.

Regards,
Magnus

>From 1c828c568efcb9f4e51ca57247d7aade15cfc549 Mon Sep 17 00:00:00 2001
From: Magnus Henoch <magnus.henoch@gmail.com>
Date: Mon, 23 Jul 2012 08:43:22 +0100
Subject: [PATCH 1/3] Rename nnmaildir-request-marks back to
 nnmaildir-request-update-info

This function was renamed as part of a greater change on 2010-09-23,
but nnmaildir actually needs this function to be called to be able to
read marks from the maildir (as opposed to from .newsrc.eld).  As
noted in the file comments, a goal of nnmaildir is to have all
information about a group stored in the maildir.

* nnmaildir.el (nnmaildir-request-update-info): Rename from
nnmaildir-request-marks.
---
 lisp/nnmaildir.el |    2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el
index 7139a52..164703a 100644
--- a/lisp/nnmaildir.el
+++ b/lisp/nnmaildir.el
@@ -916,7 +916,7 @@ by nnmaildir-request-article.")
                  "\n")))))
   'group)
 
-(defun nnmaildir-request-marks (gname info &optional server)
+(defun nnmaildir-request-update-info (gname info &optional server)
   (let ((group (nnmaildir--prepare server gname))
        pgname flist always-marks never-marks old-marks dotfile num dir
        markdirs marks mark ranges markdir article read end new-marks ls
-- 
1.7.10.2

>From 15688c61c906f887f3500aa1e4775e77c43a41b7 Mon Sep 17 00:00:00 2001
From: Magnus Henoch <magnus.henoch@gmail.com>
Date: Sat, 11 Aug 2012 18:16:55 +0100
Subject: [PATCH 2/3] Improve nnmaildir.el debuggability

* nnmaildir.el (nnmaildir--with-nntp-buffer)
(nnmaildir--with-work-buffer, nnmaildir--with-nov-buffer)
(nnmaildir--with-move-buffer, nnmaildir--condcase): Add `debug'
declaration for edebug.
(nnmaildir--subdir, nnmaildir--srvgrp-dir, nnmaildir--tmp)
(nnmaildir--new, nnmaildir--cur, nnmaildir--nndir)
(nnmaildir--nov-dir, nnmaildir--marks-dir, nnmaildir--num-dir): Change
from macros to inline functions.
---
 lisp/nnmaildir.el |   27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el
index 164703a..87dfca2 100644
--- a/lisp/nnmaildir.el
+++ b/lisp/nnmaildir.el
@@ -208,29 +208,33 @@ by nnmaildir-request-article.")
   (eval param))
 
 (defmacro nnmaildir--with-nntp-buffer (&rest body)
+  (declare (debug (body)))
   `(with-current-buffer nntp-server-buffer
      ,@body))
 (defmacro nnmaildir--with-work-buffer (&rest body)
+  (declare (debug (body)))
   `(with-current-buffer (get-buffer-create " *nnmaildir work*")
      ,@body))
 (defmacro nnmaildir--with-nov-buffer (&rest body)
+  (declare (debug (body)))
   `(with-current-buffer (get-buffer-create " *nnmaildir nov*")
      ,@body))
 (defmacro nnmaildir--with-move-buffer (&rest body)
+  (declare (debug (body)))
   `(with-current-buffer (get-buffer-create " *nnmaildir move*")
      ,@body))
 
-(defmacro nnmaildir--subdir (dir subdir)
-  `(file-name-as-directory (concat ,dir ,subdir)))
-(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
-  `(nnmaildir--subdir ,srv-dir ,gname))
-(defmacro nnmaildir--tmp       (dir) `(nnmaildir--subdir ,dir "tmp"))
-(defmacro nnmaildir--new       (dir) `(nnmaildir--subdir ,dir "new"))
-(defmacro nnmaildir--cur       (dir) `(nnmaildir--subdir ,dir "cur"))
-(defmacro nnmaildir--nndir     (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
-(defmacro nnmaildir--nov-dir   (dir) `(nnmaildir--subdir ,dir "nov"))
-(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
-(defmacro nnmaildir--num-dir   (dir) `(nnmaildir--subdir ,dir "num"))
+(defsubst nnmaildir--subdir (dir subdir)
+  (file-name-as-directory (concat dir subdir)))
+(defsubst nnmaildir--srvgrp-dir (srv-dir gname)
+  (nnmaildir--subdir srv-dir gname))
+(defsubst nnmaildir--tmp       (dir) (nnmaildir--subdir dir "tmp"))
+(defsubst nnmaildir--new       (dir) (nnmaildir--subdir dir "new"))
+(defsubst nnmaildir--cur       (dir) (nnmaildir--subdir dir "cur"))
+(defsubst nnmaildir--nndir     (dir) (nnmaildir--subdir dir ".nnmaildir"))
+(defsubst nnmaildir--nov-dir   (dir) (nnmaildir--subdir dir "nov"))
+(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks"))
+(defsubst nnmaildir--num-dir   (dir) (nnmaildir--subdir dir "num"))
 
 (defmacro nnmaildir--unlink (file-arg)
   `(let ((file ,file-arg))
@@ -305,6 +309,7 @@ by nnmaildir-request-article.")
   string)
 
 (defmacro nnmaildir--condcase (errsym body &rest handler)
+  (declare (debug (sexp form body)))
   `(condition-case ,errsym
        (let ((system-messages-locale "C")) ,body)
      (error . ,handler)))
-- 
1.7.10.2

>From 17e4da771f56d2f954e02ab46cc25abbbcd94696 Mon Sep 17 00:00:00 2001
From: Magnus Henoch <magnus.henoch@gmail.com>
Date: Thu, 26 Jul 2012 00:52:15 +0100
Subject: [PATCH 3/3] Make nnmaildir understand and write maildir flags

That is, rename files from "unique:2," to "unique:2,S" for "seen", etc.
This should make nnmaildir more usable with offlineimap.

* nnmaildir.el (nnmaildir-flag-mark-mapping): New constant.
(nnmaildir--mark-to-flag, nnmaildir--flag-to-mark)
(nnmaildir--ensure-suffix, nnmaildir--add-flag)
(nnmaildir--remove-flag, nnmaildir--article-set-flags): New functions.
(nnmaildir--scan): Don't blindly append ":2,"; call
`nnmaildir--ensure-suffix' to ensure idempotency.
When counting unseen and ticked articles, consider flags
in file names.
(nnmaildir-request-update-info): Look for flags in file names as well
as in mark directories.
(nnmaildir-request-set-mark): When clearing a mark, remove the
corresponding flag as well, if any.  When setting a mark corresponding
to a flag, just rename, don't use the mark directory.
---
 lisp/nnmaildir.el |  257 +++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 199 insertions(+), 58 deletions(-)

diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el
index 87dfca2..caf2820 100644
--- a/lisp/nnmaildir.el
+++ b/lisp/nnmaildir.el
@@ -77,6 +77,66 @@
 
 (defconst nnmaildir-version "Gnus")
 
+(defconst nnmaildir-flag-mark-mapping
+  '((?F . tick)
+    (?R . reply)
+    (?S . read))
+  "Alist mapping Maildir filename flags to Gnus marks.
+Maildir filenames are of the form \"unique-id:2,FLAGS\",
+where FLAGS are a string of characters in ASCII order.
+Some of the FLAGS correspond to Gnus marks.")
+
+(defsubst nnmaildir--mark-to-flag (mark)
+  "Find the Maildir flag that corresponds to MARK (an atom).
+Return a character, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+  (car (rassq mark nnmaildir-flag-mark-mapping)))
+
+(defsubst nnmaildir--flag-to-mark (flag)
+  "Find the Gnus mark that corresponds to FLAG (a character).
+Return an atom, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+  (cdr (assq flag nnmaildir-flag-mark-mapping)))
+
+(defun nnmaildir--ensure-suffix (filename)
+  "Ensure that FILENAME contains the suffix \":2,\"."
+  (if (string-match-p ":2," filename)
+      filename
+    (concat filename ":2,")))
+
+(defun nnmaildir--add-flag (flag suffix)
+  "Return a copy of SUFFIX where FLAG is set.
+SUFFIX should start with \":2,\"."
+  (unless (string-match-p "^:2," suffix)
+    (error "Invalid suffix `%s'" suffix))
+  (let* ((flags (substring suffix 3))
+        (flags-as-list (append flags nil))
+        (new-flags
+         (concat (gnus-delete-duplicates
+                  ;; maildir flags must be sorted
+                  (sort (cons flag flags-as-list) '<)))))
+    (concat ":2," new-flags)))
+
+(defun nnmaildir--remove-flag (flag suffix)
+  "Return a copy of SUFFIX where FLAG is cleared.
+SUFFIX should start with \":2,\"."
+  (unless (string-match-p "^:2," suffix)
+    (error "Invalid suffix `%s'" suffix))
+  (let* ((flags (substring suffix 3))
+        (flags-as-list (append flags nil))
+        (new-flags (concat (delq flag flags-as-list))))
+    (concat ":2," new-flags)))
+
+(defun nnmaildir--article-set-flags (article new-suffix curdir)
+  (let* ((prefix (nnmaildir--art-prefix article))
+        (suffix (nnmaildir--art-suffix article))
+        (article-file (concat curdir prefix suffix))
+        (new-name (concat curdir prefix new-suffix)))
+    (unless (file-exists-p article-file)
+      (error "Couldn't find article file %s" article-file))
+    (rename-file article-file new-name 'replace)
+    (setf (nnmaildir--art-suffix article) new-suffix)))
+
 (defvar nnmaildir-article-file-name nil
   "*The filename of the most recently requested article.  This variable is set
 by nnmaildir-request-article.")
@@ -764,7 +824,7 @@ by nnmaildir-request-article.")
          (dolist (file  (funcall ls ndir nil "\\`[^.]" 'nosort))
            (setq x (concat ndir file))
            (and (time-less-p (nth 5 (file-attributes x)) (current-time))
-                (rename-file x (concat cdir file ":2,"))))
+                (rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
          (setf (nnmaildir--grp-new group) nattr))
        (setq cattr (nth 5 (file-attributes cdir)))
        (if (equal cattr (nnmaildir--grp-cur group))
@@ -789,11 +849,23 @@ by nnmaildir-request-article.")
                cdir (nnmaildir--marks-dir nndir)
                ndir (nnmaildir--subdir cdir "tick")
                cdir (nnmaildir--subdir cdir "read"))
-         (dolist (file files)
-           (setq file (car file))
-           (if (or (not (file-exists-p (concat cdir file)))
-                   (file-exists-p (concat ndir file)))
-               (setq num (1+ num)))))
+         (dolist (prefix-suffix files)
+           (let ((prefix (car prefix-suffix))
+                 (suffix (cdr prefix-suffix)))
+             ;; increase num for each unread or ticked article
+             (when (or
+                    ;; first look for marks in suffix, if it's valid...
+                    (when (and (stringp suffix)
+                               (string-prefix-p ":2," suffix))
+                      (or
+                       (not (string-match-p
+                             (string (nnmaildir--mark-to-flag 'read)) suffix))
+                       (string-match-p
+                        (string (nnmaildir--mark-to-flag 'tick)) suffix)))
+                    ;; then look in marks directories
+                    (not (file-exists-p (concat cdir prefix)))
+                    (file-exists-p (concat ndir prefix)))
+               (incf num)))))
        (setf (nnmaildir--grp-cache group) (make-vector num nil))
         (let ((inhibit-quit t))
           (set (intern gname groups) group))
@@ -922,11 +994,14 @@ by nnmaildir-request-article.")
   'group)
 
 (defun nnmaildir-request-update-info (gname info &optional server)
-  (let ((group (nnmaildir--prepare server gname))
-       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 existing missing deactivate-mark
-       article-list)
+  (let* ((group (nnmaildir--prepare server gname))
+        (curdir (nnmaildir--cur
+                 (nnmaildir--srvgrp-dir
+                  (nnmaildir--srv-dir nnmaildir--cur-server) gname)))
+        (curdir-mtime (nth 5 (file-attributes curdir)))
+        pgname flist always-marks never-marks old-marks dotfile num dir
+        all-marks marks mark ranges markdir read end new-marks ls
+        old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
     (catch 'return
       (unless group
        (setf (nnmaildir--srv-error nnmaildir--cur-server)
@@ -955,34 +1030,71 @@ by nnmaildir-request-article.")
            dir (nnmaildir--nndir dir)
            dir (nnmaildir--marks-dir dir)
             ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
-           markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
-           new-mmth (nnmaildir--up2-1 (length markdirs))
+           all-marks (gnus-delete-duplicates
+                      ;; get mark names from mark dirs and from flag
+                      ;; mappings
+                      (append
+                       (mapcar 'cdr nnmaildir-flag-mark-mapping)
+                       (mapcar 'intern (funcall ls dir nil "\\`[^.]" 
'nosort))))
+           new-mmth (nnmaildir--up2-1 (length all-marks))
            new-mmth (make-vector new-mmth 0)
            old-mmth (nnmaildir--grp-mmth group))
-      (dolist (mark markdirs)
-       (setq markdir (nnmaildir--subdir dir mark)
-             mark-sym (intern mark)
+      (dolist (mark all-marks)
+       (setq markdir (nnmaildir--subdir dir (symbol-name mark))
              ranges nil)
        (catch 'got-ranges
-         (if (memq mark-sym never-marks) (throw 'got-ranges nil))
-         (when (memq mark-sym always-marks)
+         (if (memq mark never-marks) (throw 'got-ranges nil))
+         (when (memq mark always-marks)
            (setq ranges existing)
            (throw 'got-ranges nil))
-         (setq mtime (nth 5 (file-attributes markdir)))
-         (set (intern mark new-mmth) mtime)
-         (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
-           (setq ranges (assq mark-sym old-marks))
+         ;; Find the mtime for this mark.  If this mark can be expressed as
+         ;; a filename flag, get the later of the mtimes for markdir and
+         ;; curdir, otherwise only the markdir counts.
+         (setq mtime
+               (let ((markdir-mtime (nth 5 (file-attributes markdir))))
+                 (cond
+                  ((null (nnmaildir--mark-to-flag mark))
+                   markdir-mtime)
+                  ((null markdir-mtime)
+                   curdir-mtime)
+                  ((null curdir-mtime)
+                   ;; this should never happen...
+                   markdir-mtime)
+                  ((time-less-p markdir-mtime curdir-mtime)
+                   curdir-mtime)
+                  (t
+                   markdir-mtime))))
+         (set (intern (symbol-name mark) new-mmth) mtime)
+         (when (equal mtime (symbol-value (intern-soft (symbol-name mark) 
old-mmth)))
+           (setq ranges (assq mark old-marks))
            (if ranges (setq ranges (cdr ranges)))
            (throw 'got-ranges nil))
-         (setq article-list nil)
-         (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
-           (setq article (nnmaildir--flist-art flist prefix))
-           (if article
-               (setq article-list
-                     (cons (nnmaildir--art-num article) article-list))))
-         (setq ranges (gnus-add-to-range ranges (sort article-list '<))))
-       (if (eq mark-sym 'read) (setq read ranges)
-         (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
+         (let ((article-list nil))
+           ;; Consider the article marked if it either has the flag in the
+           ;; filename, or is in the markdir.  As you'd rarely remove a
+           ;; flag/mark, this should avoid losing information in the most
+           ;; common usage pattern.
+           (or
+            (let ((flag (nnmaildir--mark-to-flag mark)))
+              ;; If this mark has a corresponding maildir flag...
+              (when flag
+                (let ((regexp
+                       (concat "\\`[^.].*:2,[A-Z]*" (string flag))))
+                  ;; ...then find all files with that flag.
+                  (dolist (filename (funcall ls curdir nil regexp 'nosort))
+                    (let* ((prefix (car (split-string filename ":2,")))
+                           (article (nnmaildir--flist-art flist prefix)))
+                      (when article
+                        (push (nnmaildir--art-num article) article-list)))))))
+            ;; Also check Gnus-specific mark directory, if it exists.
+            (when (file-directory-p markdir)
+              (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
+                (let ((article (nnmaildir--flist-art flist prefix)))
+                  (when article
+                    (push (nnmaildir--art-num article) article-list))))))
+           (setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
+       (if (eq mark 'read) (setq read ranges)
+         (if ranges (setq marks (cons (cons mark ranges) marks)))))
       (gnus-info-set-read info (gnus-range-add read missing))
       (gnus-info-set-marks info marks 'extend)
       (setf (nnmaildir--grp-mmth group) new-mmth)
@@ -1530,39 +1642,63 @@ by nnmaildir-request-article.")
       didnt)))
 
 (defun nnmaildir-request-set-mark (gname actions &optional server)
-  (let ((group (nnmaildir--prepare server gname))
-       (coding-system-for-write nnheader-file-coding-system)
-       (buffer-file-coding-system nil)
-       (file-coding-system-alist nil)
-       del-mark del-action add-action set-action marksdir nlist
-       ranges begin end article all-marks todo-marks mdir mfile
-       pgname ls permarkfile deactivate-mark)
+  (let* ((group (nnmaildir--prepare server gname))
+        (curdir (nnmaildir--cur
+                 (nnmaildir--srvgrp-dir
+                  (nnmaildir--srv-dir nnmaildir--cur-server)
+                  gname)))
+        (coding-system-for-write nnheader-file-coding-system)
+        (buffer-file-coding-system nil)
+        (file-coding-system-alist nil)
+        del-mark del-action add-action set-action marksdir nlist
+        ranges begin end article all-marks todo-marks mdir mfile
+        pgname ls permarkfile deactivate-mark)
     (setq del-mark
          (lambda (mark)
-           (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
-                 mfile (concat mfile (nnmaildir--art-prefix article)))
-           (nnmaildir--unlink mfile))
+           (let ((prefix (nnmaildir--art-prefix article))
+                 (suffix (nnmaildir--art-suffix article))
+                 (flag (nnmaildir--mark-to-flag mark)))
+             (when flag
+               ;; If this mark corresponds to a flag, remove the flag from
+               ;; the file name.
+               (nnmaildir--article-set-flags
+                article (nnmaildir--remove-flag flag suffix) curdir))
+             ;; We still want to delete the hardlink in the marks dir if
+             ;; present, regardless of whether this mark has a maildir flag or
+             ;; not, to avoid getting out of sync.
+             (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
+                   mfile (concat mfile prefix))
+             (nnmaildir--unlink mfile)))
          del-action (lambda (article) (mapcar del-mark todo-marks))
          add-action
          (lambda (article)
            (mapcar
             (lambda (mark)
-              (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
-                    permarkfile (concat mdir ":")
-                    mfile (concat mdir (nnmaildir--art-prefix article)))
-              (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
-                (cond
-                 ((nnmaildir--eexist-p err))
-                 ((nnmaildir--enoent-p err)
-                  (nnmaildir--mkdir mdir)
-                  (nnmaildir--mkfile permarkfile)
-                  (add-name-to-file permarkfile mfile))
-                 ((nnmaildir--emlink-p err)
-                  (let ((permarkfilenew (concat permarkfile "{new}")))
-                    (nnmaildir--mkfile permarkfilenew)
-                    (rename-file permarkfilenew permarkfile 'replace)
-                    (add-name-to-file permarkfile mfile)))
-                 (t (signal (car err) (cdr err))))))
+              (let ((prefix (nnmaildir--art-prefix article))
+                    (suffix (nnmaildir--art-suffix article))
+                    (flag (nnmaildir--mark-to-flag mark)))
+                (if flag
+                    ;; If there is a corresponding maildir flag, just rename
+                    ;; the file.
+                    (nnmaildir--article-set-flags
+                     article (nnmaildir--add-flag flag suffix) curdir)
+                  ;; Otherwise, use nnmaildir-specific marks dir.
+                  (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
+                        permarkfile (concat mdir ":")
+                        mfile (concat mdir prefix))
+                  (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
+                    (cond
+                     ((nnmaildir--eexist-p err))
+                     ((nnmaildir--enoent-p err)
+                      (nnmaildir--mkdir mdir)
+                      (nnmaildir--mkfile permarkfile)
+                      (add-name-to-file permarkfile mfile))
+                     ((nnmaildir--emlink-p err)
+                      (let ((permarkfilenew (concat permarkfile "{new}")))
+                        (nnmaildir--mkfile permarkfilenew)
+                        (rename-file permarkfilenew permarkfile 'replace)
+                        (add-name-to-file permarkfile mfile)))
+                     (t (signal (car err) (cdr err))))))))
             todo-marks))
          set-action (lambda (article)
                       (funcall add-action article)
@@ -1586,7 +1722,12 @@ by nnmaildir-request-article.")
             pgname (nnmaildir--pgname nnmaildir--cur-server gname)
             ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
            all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
-           all-marks (mapcar 'intern all-marks))
+           all-marks (gnus-delete-duplicates
+                      ;; get mark names from mark dirs and from flag
+                      ;; mappings
+                      (append
+                       (mapcar 'cdr nnmaildir-flag-mark-mapping)
+                       (mapcar 'intern all-marks))))
       (dolist (action actions)
        (setq ranges (car action)
              todo-marks (caddr action))
-- 
1.7.10.2