From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Magnus Henoch Newsgroups: gmane.emacs.bugs Subject: bug#8055: Patch for handling Maildir flags in nnmaildir Date: Sat, 11 Aug 2012 19:25:14 +0100 Message-ID: References: <8762skm50w.fsf@gismo.pca.it> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1344709560 29519 80.91.229.3 (11 Aug 2012 18:26:00 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 11 Aug 2012 18:26:00 +0000 (UTC) To: 8055@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Aug 11 20:26:00 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1T0GNj-0000on-21 for geb-bug-gnu-emacs@m.gmane.org; Sat, 11 Aug 2012 20:25:51 +0200 Original-Received: from localhost ([::1]:42000 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T0GNi-0006HU-7w for geb-bug-gnu-emacs@m.gmane.org; Sat, 11 Aug 2012 14:25:50 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:39252) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T0GNd-0006HA-5P for bug-gnu-emacs@gnu.org; Sat, 11 Aug 2012 14:25:47 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1T0GNY-0001fX-Tz for bug-gnu-emacs@gnu.org; Sat, 11 Aug 2012 14:25:44 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:40280) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T0GNY-0001fR-N5 for bug-gnu-emacs@gnu.org; Sat, 11 Aug 2012 14:25:40 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1T0GVe-00075v-99; Sat, 11 Aug 2012 14:34:02 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: <8762skm50w.fsf@gismo.pca.it> Resent-From: Magnus Henoch Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org, bugs@gnus.org Resent-Date: Sat, 11 Aug 2012 18:34:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 8055 X-GNU-PR-Package: emacs,gnus X-GNU-PR-Keywords: patch Original-Received: via spool by 8055-submit@debbugs.gnu.org id=B8055.134471003127254 (code B ref 8055); Sat, 11 Aug 2012 18:34:02 +0000 Original-Received: (at 8055) by debbugs.gnu.org; 11 Aug 2012 18:33:51 +0000 Original-Received: from localhost ([127.0.0.1]:49825 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1T0GVR-00075V-WF for submit@debbugs.gnu.org; Sat, 11 Aug 2012 14:33:51 -0400 Original-Received: from mail-wi0-f170.google.com ([209.85.212.170]:54775) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1T0GVN-00075L-50 for 8055@debbugs.gnu.org; Sat, 11 Aug 2012 14:33:47 -0400 Original-Received: by wibhq12 with SMTP id hq12so1962315wib.3 for <8055@debbugs.gnu.org>; Sat, 11 Aug 2012 11:25:22 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:date:message-id:mime-version:content-type; bh=WnSdMqioigMBgiW5kd2InuHWLU6OCtzj2qIi3inwqMg=; b=MSWNmtrfr+UeKJsaZW9q78SktHTXV366i2z4MLLvInt3HXrpXHEiQEWOi32fzmt0k+ Ji0trlTak5I0tE/15fXd3EqUM8obENsq98GkmzixQZ5UI5hOhegoW2wOtviE9GlBVAcJ /8kokBvyJjMzjMPilOqDuK/+fnImE8u1UlX2uV1Zqg+yQHvnZs7Xl7GgiuEgArbW7NhQ 0TRTZEgRGakAxtAC77OHwjjDB5oQS1mBtXpvOZXjtP9n/FD+Rgwofy2vdrLvS+8sHyKc fAiyrv0DkH1Bn7xyEP+Is4251AIOqApmEasFdb4yXvySTmNZ4aBsHz43XDTPdI5NcUAz Lc6w== Original-Received: by 10.216.3.85 with SMTP id 63mr3251970weg.134.1344709522009; Sat, 11 Aug 2012 11:25:22 -0700 (PDT) Original-Received: from poki-sona.local (94-194-213-6.zone8.bethere.co.uk. [94.194.213.6]) by mx.google.com with ESMTPS id h9sm5621007wiz.1.2012.08.11.11.25.19 (version=TLSv1/SSLv3 cipher=OTHER); Sat, 11 Aug 2012 11:25:21 -0700 (PDT) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:63054 Archived-At: --=-=-= Content-Type: text/plain [ 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Rename-nnmaildir-request-marks-back-to-nnmaildir-req.patch >From 1c828c568efcb9f4e51ca57247d7aade15cfc549 Mon Sep 17 00:00:00 2001 From: Magnus Henoch 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-Improve-nnmaildir.el-debuggability.patch >From 15688c61c906f887f3500aa1e4775e77c43a41b7 Mon Sep 17 00:00:00 2001 From: Magnus Henoch 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0003-Make-nnmaildir-understand-and-write-maildir-flags.patch >From 17e4da771f56d2f954e02ab46cc25abbbcd94696 Mon Sep 17 00:00:00 2001 From: Magnus Henoch 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 --=-=-=--