Fix last commit.

[gnus] / lisp / nnmaildir.el

diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el
index b115536..5391192 100644 (file)
--- a/lisp/nnmaildir.el
+++ b/lisp/nnmaildir.el
@@ -43,8 +43,6 @@
 ;; Todo:
 ;; * 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 code readability.
 
@@ -547,6 +545,15 @@ by nnmaildir-request-article.")
 (defun nnmaildir--up2-1 (n)
   (if (zerop n) 1 (1- (lsh 1 (1+ (logb n))))))
 
+(defun nnmaildir--system-name ()
+  (gnus-replace-in-string
+   (gnus-replace-in-string
+    (gnus-replace-in-string
+     (system-name)
+     "\\\\" "\\134" 'literal)
+    "/" "\\057" 'literal)
+   ":" "\\072" 'literal))
+
 (defun nnmaildir-request-type (group &optional article)
   'mail)
 
@@ -792,11 +799,13 @@ by nnmaildir-request-article.")
            (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
                  dirs (if (zerop (length target-prefix))
                           dirs
-                        (remove-if (lambda (dir)
-                                     (and (>= (length dir) (length target-prefix))
-                                          (string= (substring dir 0 (length target-prefix))
-                                                   target-prefix)))
-                                   dirs))
+                        (gnus-remove-if
+                         (lambda (dir)
+                           (and (>= (length dir) (length target-prefix))
+                                (string= (substring dir 0
+                                                    (length target-prefix))
+                                         target-prefix)))
+                         dirs))
                  seen (nnmaildir--up2-1 (length dirs))
                  seen (make-vector seen 0))
            (mapcar
@@ -1310,7 +1319,7 @@ by nnmaildir-request-article.")
        (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 :
+           file (concat file "." (nnmaildir--system-name))
            tmpfile (concat (nnmaildir--tmp dir) file)
            curfile (concat (nnmaildir--cur dir) file ":2,"))
       (when (file-exists-p tmpfile)
@@ -1476,7 +1485,7 @@ by nnmaildir-request-article.")
        (file-coding-system-alist nil)
        del-mark del-action add-action set-action marksdir markfile nlist
        ranges begin end article all-marks todo-marks did-marks mdir mfile
-       pgname ls markfilenew deactivate-mark)
+       pgname ls permarkfile deactivate-mark)
     (setq del-mark
          (lambda (mark)
            (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
@@ -1488,20 +1497,19 @@ by nnmaildir-request-article.")
            (mapcar
             (lambda (mark)
               (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
+                    permarkfile (concat mdir ":")
                     mfile (concat mdir (nnmaildir--art-prefix article)))
               (unless (memq mark did-marks)
+                (setq did-marks (cons mark did-marks))
                 (nnmaildir--mkdir mdir)
-                (setq did-marks (cons mark did-marks)))
+                (unless (file-attributes permarkfile)
+                  (condition-case nil
+                      (add-name-to-file markfile permarkfile)
+                    (file-error
+                     ;; AFS can't make hard links in separate directories
+                     (write-region "" nil permarkfile nil 'no-message)))))
               (unless (file-exists-p mfile)
-                (condition-case nil
-                    (add-name-to-file markfile mfile)
-                  (file-error
-                   (unless (file-exists-p mfile)
-                     ;; too many links, maybe
-                     (write-region "" nil markfilenew nil 'no-message)
-                     (add-name-to-file markfilenew mfile
-                                       'ok-if-already-exists)
-                     (rename-file markfilenew markfile 'replace))))))
+                (add-name-to-file permarkfile mfile)))
             todo-marks))
          set-action (lambda (article)
                       (funcall add-action)
@@ -1522,7 +1530,6 @@ by nnmaildir-request-article.")
            marksdir (nnmaildir--srvgrp-dir marksdir gname)
            marksdir (nnmaildir--nndir marksdir)
            markfile (concat marksdir "markfile")
-           markfilenew (concat markfile "{new}")
            marksdir (nnmaildir--marks-dir marksdir)
            gname (nnmaildir--grp-name group)
             pgname (nnmaildir--pgname nnmaildir--cur-server gname)
@@ -1579,7 +1586,7 @@ by nnmaildir-request-article.")
               dir (file-name-as-directory (car dir)))
         (mapcar
          (lambda (file)
-           (unless (intern-soft file flist)
+           (unless (or (intern-soft file flist) (string= file ":"))
              (setq file (concat dir file))
              (delete-file file)))
          files))