1;;; nnmaildir.el --- maildir backend for Gnus 2;; Public domain. 3 4;; Author: Paul Jarc <prj@po.cwru.edu> 5 6;; This file is part of GNU Emacs. 7 8;; GNU Emacs is free software; you can redistribute it and/or modify 9;; it under the terms of the GNU General Public License as published by 10;; the Free Software Foundation; either version 2, or (at your option) 11;; any later version. 12 13;; GNU Emacs is distributed in the hope that it will be useful, 14;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16;; GNU General Public License for more details. 17 18;; You should have received a copy of the GNU General Public License 19;; along with GNU Emacs; see the file COPYING. If not, write to the 20;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 21;; Boston, MA 02110-1301, USA. 22 23;;; Commentary: 24 25;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html> 26;; and in the maildir(5) man page from qmail (available at 27;; <URL:http://www.qmail.org/man/man5/maildir.html>). nnmaildir also stores 28;; extra information in the .nnmaildir/ directory within a maildir. 29;; 30;; Some goals of nnmaildir: 31;; * Everything Just Works, and correctly. E.g., NOV data is automatically 32;; regenerated when stale; no need for manually running 33;; *-generate-nov-databases. 34;; * Perfect reliability: [C-g] will never corrupt its data in memory, and 35;; SIGKILL will never corrupt its data in the filesystem. 36;; * Allow concurrent operation as much as possible. If files change out 37;; from under us, adapt to the changes or degrade gracefully. 38;; * We use the filesystem as a database, so that, e.g., it's easy to 39;; manipulate marks from outside Gnus. 40;; * All information about a group is stored in the maildir, for easy backup, 41;; copying, restoring, etc. 42;; 43;; Todo: 44;; * Add a hook for when moving messages from new/ to cur/, to support 45;; nnmail's duplicate detection. 46;; * Improve generated Xrefs, so crossposts are detectable. 47;; * Improve code readability. 48 49;;; Code: 50 51;; eval this before editing 52[(progn 53 (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0) 54 (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0) 55 (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0) 56 (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0) 57 ) 58] 59 60(eval-and-compile 61 (require 'nnheader) 62 (require 'gnus) 63 (require 'gnus-util) 64 (require 'gnus-range) 65 (require 'gnus-start) 66 (require 'gnus-int) 67 (require 'message)) 68(eval-when-compile 69 (require 'cl) 70 (require 'nnmail)) 71 72(defconst nnmaildir-version "Gnus") 73 74(defvar nnmaildir-article-file-name nil 75 "*The filename of the most recently requested article. This variable is set 76by nnmaildir-request-article.") 77 78;; The filename of the article being moved/copied: 79(defvar nnmaildir--file nil) 80 81;; Variables to generate filenames of messages being delivered: 82(defvar nnmaildir--delivery-time "") 83(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid)))) 84(defvar nnmaildir--delivery-count nil) 85 86;; An obarry containing symbols whose names are server names and whose values 87;; are servers: 88(defvar nnmaildir--servers (make-vector 3 0)) 89;; The current server: 90(defvar nnmaildir--cur-server nil) 91 92;; A copy of nnmail-extra-headers 93(defvar nnmaildir--extra nil) 94 95;; A NOV structure looks like this (must be prin1-able, so no defstruct): 96["subject\tfrom\tdate" 97 "references\tchars\lines" 98 "To: you\tIn-Reply-To: <your.mess@ge>" 99 (12345 67890) ;; modtime of the corresponding article file 100 (to in-reply-to)] ;; contemporary value of nnmail-extra-headers 101(defconst nnmaildir--novlen 5) 102(defmacro nnmaildir--nov-new (beg mid end mtime extra) 103 `(vector ,beg ,mid ,end ,mtime ,extra)) 104(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0)) 105(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1)) 106(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2)) 107(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3)) 108(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4)) 109(defmacro nnmaildir--nov-set-beg (nov value) `(aset ,nov 0 ,value)) 110(defmacro nnmaildir--nov-set-mid (nov value) `(aset ,nov 1 ,value)) 111(defmacro nnmaildir--nov-set-end (nov value) `(aset ,nov 2 ,value)) 112(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value)) 113(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value)) 114 115(defstruct nnmaildir--art 116 (prefix nil :type string) ;; "time.pid.host" 117 (suffix nil :type string) ;; ":2,flags" 118 (num nil :type natnum) ;; article number 119 (msgid nil :type string) ;; "<mess.age@id>" 120 (nov nil :type vector)) ;; cached nov structure, or nil 121 122(defstruct nnmaildir--grp 123 (name nil :type string) ;; "group.name" 124 (new nil :type list) ;; new/ modtime 125 (cur nil :type list) ;; cur/ modtime 126 (min 1 :type natnum) ;; minimum article number 127 (count 0 :type natnum) ;; count of articles 128 (nlist nil :type list) ;; list of articles, ordered descending by number 129 (flist nil :type vector) ;; obarray mapping filename prefix->article 130 (mlist nil :type vector) ;; obarray mapping message-id->article 131 (cache nil :type vector) ;; nov cache 132 (index nil :type natnum) ;; index of next cache entry to replace 133 (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime 134 ; ("Mark Mod Time Hash") 135 136(defstruct nnmaildir--srv 137 (address nil :type string) ;; server address string 138 (method nil :type list) ;; (nnmaildir "address" ...) 139 (prefix nil :type string) ;; "nnmaildir+address:" 140 (dir nil :type string) ;; "/expanded/path/to/server/dir/" 141 (ls nil :type function) ;; directory-files function 142 (groups nil :type vector) ;; obarray mapping group name->group 143 (curgrp nil :type nnmaildir--grp) ;; current group, or nil 144 (error nil :type string) ;; last error message, or nil 145 (mtime nil :type list) ;; modtime of dir 146 (gnm nil) ;; flag: split from mail-sources? 147 (target-prefix nil :type string)) ;; symlink target prefix 148 149(defun nnmaildir--expired-article (group article) 150 (setf (nnmaildir--art-nov article) nil) 151 (let ((flist (nnmaildir--grp-flist group)) 152 (mlist (nnmaildir--grp-mlist group)) 153 (min (nnmaildir--grp-min group)) 154 (count (1- (nnmaildir--grp-count group))) 155 (prefix (nnmaildir--art-prefix article)) 156 (msgid (nnmaildir--art-msgid article)) 157 (new-nlist nil) 158 (nlist-pre '(nil . nil)) 159 nlist-post num) 160 (unless (zerop count) 161 (setq nlist-post (nnmaildir--grp-nlist group) 162 num (nnmaildir--art-num article)) 163 (if (eq num (caar nlist-post)) 164 (setq new-nlist (cdr nlist-post)) 165 (setq new-nlist nlist-post 166 nlist-pre nlist-post 167 nlist-post (cdr nlist-post)) 168 (while (/= num (caar nlist-post)) 169 (setq nlist-pre nlist-post 170 nlist-post (cdr nlist-post))) 171 (setq nlist-post (cdr nlist-post)) 172 (if (eq num min) 173 (setq min (caar nlist-pre))))) 174 (let ((inhibit-quit t)) 175 (setf (nnmaildir--grp-min group) min) 176 (setf (nnmaildir--grp-count group) count) 177 (setf (nnmaildir--grp-nlist group) new-nlist) 178 (setcdr nlist-pre nlist-post) 179 (unintern prefix flist) 180 (unintern msgid mlist)))) 181 182(defun nnmaildir--nlist-art (group num) 183 (let ((entry (assq num (nnmaildir--grp-nlist group)))) 184 (if entry 185 (cdr entry)))) 186(defmacro nnmaildir--flist-art (list file) 187 `(symbol-value (intern-soft ,file ,list))) 188(defmacro nnmaildir--mlist-art (list msgid) 189 `(symbol-value (intern-soft ,msgid ,list))) 190 191(defun nnmaildir--pgname (server gname) 192 (let ((prefix (nnmaildir--srv-prefix server))) 193 (if prefix (concat prefix gname) 194 (setq gname (gnus-group-prefixed-name gname 195 (nnmaildir--srv-method server))) 196 (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname)) 197 gname))) 198 199(defun nnmaildir--param (pgname param) 200 (setq param (gnus-group-find-parameter pgname param 'allow-list)) 201 (if (vectorp param) (setq param (aref param 0))) 202 (eval param)) 203 204(defmacro nnmaildir--with-nntp-buffer (&rest body) 205 `(save-excursion 206 (set-buffer nntp-server-buffer) 207 ,@body)) 208(defmacro nnmaildir--with-work-buffer (&rest body) 209 `(save-excursion 210 (set-buffer (get-buffer-create " *nnmaildir work*")) 211 ,@body)) 212(defmacro nnmaildir--with-nov-buffer (&rest body) 213 `(save-excursion 214 (set-buffer (get-buffer-create " *nnmaildir nov*")) 215 ,@body)) 216(defmacro nnmaildir--with-move-buffer (&rest body) 217 `(save-excursion 218 (set-buffer (get-buffer-create " *nnmaildir move*")) 219 ,@body)) 220 221(defmacro nnmaildir--subdir (dir subdir) 222 `(file-name-as-directory (concat ,dir ,subdir))) 223(defmacro nnmaildir--srvgrp-dir (srv-dir gname) 224 `(nnmaildir--subdir ,srv-dir ,gname)) 225(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp")) 226(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new")) 227(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur")) 228(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir")) 229(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov")) 230(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks")) 231(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num")) 232(defmacro nnmaildir--num-file (dir) `(concat ,dir ":")) 233 234(defmacro nnmaildir--unlink (file-arg) 235 `(let ((file ,file-arg)) 236 (if (file-attributes file) (delete-file file)))) 237(defun nnmaildir--mkdir (dir) 238 (or (file-exists-p (file-name-as-directory dir)) 239 (make-directory-internal (directory-file-name dir)))) 240(defun nnmaildir--delete-dir-files (dir ls) 241 (when (file-attributes dir) 242 (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort)) 243 (delete-directory dir))) 244 245(defun nnmaildir--group-maxnum (server group) 246 (if (zerop (nnmaildir--grp-count group)) 0 247 (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server) 248 (nnmaildir--grp-name group)))) 249 (setq x (nnmaildir--nndir x) 250 x (nnmaildir--num-dir x) 251 x (nnmaildir--num-file x) 252 x (file-attributes x)) 253 (if x (1- (nth 1 x)) 0)))) 254 255;; Make the given server, if non-nil, be the current server. Then make the 256;; given group, if non-nil, be the current group of the current server. Then 257;; return the group object for the current group. 258(defun nnmaildir--prepare (server group) 259 (let (x groups) 260 (catch 'return 261 (if (null server) 262 (unless (setq server nnmaildir--cur-server) 263 (throw 'return nil)) 264 (unless (setq server (intern-soft server nnmaildir--servers)) 265 (throw 'return nil)) 266 (setq server (symbol-value server) 267 nnmaildir--cur-server server)) 268 (unless (setq groups (nnmaildir--srv-groups server)) 269 (throw 'return nil)) 270 (unless (nnmaildir--srv-method server) 271 (setq x (concat "nnmaildir:" (nnmaildir--srv-address server)) 272 x (gnus-server-to-method x)) 273 (unless x (throw 'return nil)) 274 (setf (nnmaildir--srv-method server) x)) 275 (if (null group) 276 (unless (setq group (nnmaildir--srv-curgrp server)) 277 (throw 'return nil)) 278 (unless (setq group (intern-soft group groups)) 279 (throw 'return nil)) 280 (setq group (symbol-value group))) 281 group))) 282 283(defun nnmaildir--tab-to-space (string) 284 (let ((pos 0)) 285 (while (string-match "\t" string pos) 286 (aset string (match-beginning 0) ? ) 287 (setq pos (match-end 0)))) 288 string) 289 290(defun nnmaildir--update-nov (server group article) 291 (let ((nnheader-file-coding-system 'binary) 292 (srv-dir (nnmaildir--srv-dir server)) 293 (storage-version 1) ;; [version article-number msgid [...nov...]] 294 dir gname pgname msgdir prefix suffix file attr mtime novdir novfile 295 nov msgid nov-beg nov-mid nov-end field val old-extra num numdir 296 deactivate-mark) 297 (catch 'return 298 (setq gname (nnmaildir--grp-name group) 299 pgname (nnmaildir--pgname server gname) 300 dir (nnmaildir--srvgrp-dir srv-dir gname) 301 msgdir (if (nnmaildir--param pgname 'read-only) 302 (nnmaildir--new dir) (nnmaildir--cur dir)) 303 prefix (nnmaildir--art-prefix article) 304 suffix (nnmaildir--art-suffix article) 305 file (concat msgdir prefix suffix) 306 attr (file-attributes file)) 307 (unless attr 308 (nnmaildir--expired-article group article) 309 (throw 'return nil)) 310 (setq mtime (nth 5 attr) 311 attr (nth 7 attr) 312 nov (nnmaildir--art-nov article) 313 dir (nnmaildir--nndir dir) 314 novdir (nnmaildir--nov-dir dir) 315 novfile (concat novdir prefix)) 316 (unless (equal nnmaildir--extra nnmail-extra-headers) 317 (setq nnmaildir--extra (copy-sequence nnmail-extra-headers))) 318 (nnmaildir--with-nov-buffer 319 ;; First we'll check for already-parsed NOV data. 320 (cond ((not (file-exists-p novfile)) 321 ;; The NOV file doesn't exist; we have to parse the message. 322 (setq nov nil)) 323 ((not nov) 324 ;; The file exists, but the data isn't in memory; read the file. 325 (erase-buffer) 326 (nnheader-insert-file-contents novfile) 327 (setq nov (read (current-buffer))) 328 (if (not (and (vectorp nov) 329 (/= 0 (length nov)) 330 (equal storage-version (aref nov 0)))) 331 ;; This NOV data seems to be in the wrong format. 332 (setq nov nil) 333 (unless (nnmaildir--art-num article) 334 (setf (nnmaildir--art-num article) (aref nov 1))) 335 (unless (nnmaildir--art-msgid article) 336 (setf (nnmaildir--art-msgid article) (aref nov 2))) 337 (setq nov (aref nov 3))))) 338 ;; Now check whether the already-parsed data (if we have any) is 339 ;; usable: if the message has been edited or if nnmail-extra-headers 340 ;; has been augmented since this data was parsed from the message, 341 ;; then we have to reparse. Otherwise it's up-to-date. 342 (when (and nov (equal mtime (nnmaildir--nov-get-mtime nov))) 343 ;; The timestamp matches. Now check nnmail-extra-headers. 344 (setq old-extra (nnmaildir--nov-get-extra nov)) 345 (when (equal nnmaildir--extra old-extra) ;; common case 346 ;; Save memory; use a single copy of the list value. 347 (nnmaildir--nov-set-extra nov nnmaildir--extra) 348 (throw 'return nov)) 349 ;; They're not equal, but maybe the new is a subset of the old. 350 (if (null nnmaildir--extra) 351 ;; The empty set is a subset of every set. 352 (throw 'return nov)) 353 (if (not (memq nil (mapcar (lambda (e) (memq e old-extra)) 354 nnmaildir--extra))) 355 (throw 'return nov))) 356 ;; Parse the NOV data out of the message. 357 (erase-buffer) 358 (nnheader-insert-file-contents file) 359 (insert "\n") 360 (goto-char (point-min)) 361 (save-restriction 362 (if (search-forward "\n\n" nil 'noerror) 363 (progn 364 (setq nov-mid (count-lines (point) (point-max))) 365 (narrow-to-region (point-min) (1- (point)))) 366 (setq nov-mid 0)) 367 (goto-char (point-min)) 368 (delete-char 1) 369 (setq nov (nnheader-parse-naked-head) 370 field (or (mail-header-lines nov) 0))) 371 (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) 372 (setq nov-mid field)) 373 (setq nov-mid (number-to-string nov-mid) 374 nov-mid (concat (number-to-string attr) "\t" nov-mid)) 375 (save-match-data 376 (setq field (or (mail-header-references nov) "")) 377 (nnmaildir--tab-to-space field) 378 (setq nov-mid (concat field "\t" nov-mid) 379 nov-beg (mapconcat 380 (lambda (f) (nnmaildir--tab-to-space (or f ""))) 381 (list (mail-header-subject nov) 382 (mail-header-from nov) 383 (mail-header-date nov)) "\t") 384 nov-end (mapconcat 385 (lambda (extra) 386 (setq field (symbol-name (car extra)) 387 val (cdr extra)) 388 (nnmaildir--tab-to-space field) 389 (nnmaildir--tab-to-space val) 390 (concat field ": " val)) 391 (mail-header-extra nov) "\t"))) 392 (setq msgid (mail-header-id nov)) 393 (if (or (null msgid) (nnheader-fake-message-id-p msgid)) 394 (setq msgid (concat "<" prefix "@nnmaildir>"))) 395 (nnmaildir--tab-to-space msgid) 396 ;; The data is parsed; create an nnmaildir NOV structure. 397 (setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime 398 nnmaildir--extra) 399 num (nnmaildir--art-num article)) 400 (unless num 401 ;; Allocate a new article number. 402 (erase-buffer) 403 (setq numdir (nnmaildir--num-dir dir) 404 file (nnmaildir--num-file numdir) 405 num -1) 406 (nnmaildir--mkdir numdir) 407 (write-region "" nil file nil 'no-message) 408 (while file 409 ;; Get the number of links to file. 410 (setq attr (nth 1 (file-attributes file))) 411 (if (= attr num) 412 ;; We've already tried this number, in the previous loop 413 ;; iteration, and failed. 414 (signal 'error `("Corrupt internal nnmaildir data" ,numdir))) 415 ;; If attr is 123, try to link file to "123". This atomically 416 ;; increases the link count and creates the "123" link, failing 417 ;; if that link was already created by another Gnus, just after 418 ;; we stat()ed file. 419 (condition-case nil 420 (progn 421 (add-name-to-file file (concat numdir (format "%x" attr))) 422 (setq file nil)) ;; Stop looping. 423 (file-already-exists nil)) 424 (setq num attr)) 425 (setf (nnmaildir--art-num article) num)) 426 ;; Store this new NOV data in a file 427 (erase-buffer) 428 (prin1 (vector storage-version num msgid nov) (current-buffer)) 429 (setq file (concat novfile ":")) 430 (nnmaildir--unlink file) 431 (gmm-write-region (point-min) (point-max) file nil 'no-message nil 432 'excl)) 433 (rename-file file novfile 'replace) 434 (setf (nnmaildir--art-msgid article) msgid) 435 nov))) 436 437(defun nnmaildir--cache-nov (group article nov) 438 (let ((cache (nnmaildir--grp-cache group)) 439 (index (nnmaildir--grp-index group)) 440 goner) 441 (unless (nnmaildir--art-nov article) 442 (setq goner (aref cache index)) 443 (if goner (setf (nnmaildir--art-nov goner) nil)) 444 (aset cache index article) 445 (setf (nnmaildir--grp-index group) (% (1+ index) (length cache)))) 446 (setf (nnmaildir--art-nov article) nov))) 447 448(defun nnmaildir--grp-add-art (server group article) 449 (let ((nov (nnmaildir--update-nov server group article)) 450 count num min nlist nlist-cdr insert-nlist) 451 (when nov 452 (setq count (1+ (nnmaildir--grp-count group)) 453 num (nnmaildir--art-num article) 454 min (if (= count 1) num 455 (min num (nnmaildir--grp-min group))) 456 nlist (nnmaildir--grp-nlist group)) 457 (if (or (null nlist) (> num (caar nlist))) 458 (setq nlist (cons (cons num article) nlist)) 459 (setq insert-nlist t 460 nlist-cdr (cdr nlist)) 461 (while (and nlist-cdr (< num (caar nlist-cdr))) 462 (setq nlist nlist-cdr 463 nlist-cdr (cdr nlist)))) 464 (let ((inhibit-quit t)) 465 (setf (nnmaildir--grp-count group) count) 466 (setf (nnmaildir--grp-min group) min) 467 (if insert-nlist 468 (setcdr nlist (cons (cons num article) nlist-cdr)) 469 (setf (nnmaildir--grp-nlist group) nlist)) 470 (set (intern (nnmaildir--art-prefix article) 471 (nnmaildir--grp-flist group)) 472 article) 473 (set (intern (nnmaildir--art-msgid article) 474 (nnmaildir--grp-mlist group)) 475 article) 476 (set (intern (nnmaildir--grp-name group) 477 (nnmaildir--srv-groups server)) 478 group)) 479 (nnmaildir--cache-nov group article nov) 480 t))) 481 482(defun nnmaildir--group-ls (server pgname) 483 (or (nnmaildir--param pgname 'directory-files) 484 (nnmaildir--srv-ls server))) 485 486(defun nnmaildir-article-number-to-file-name 487 (number group-name server-address-string) 488 (let ((group (nnmaildir--prepare server-address-string group-name)) 489 article dir pgname) 490 (catch 'return 491 (unless group 492 ;; The given group or server does not exist. 493 (throw 'return nil)) 494 (setq article (nnmaildir--nlist-art group number)) 495 (unless article 496 ;; The given article number does not exist in this group. 497 (throw 'return nil)) 498 (setq pgname (nnmaildir--pgname nnmaildir--cur-server group-name) 499 dir (nnmaildir--srv-dir nnmaildir--cur-server) 500 dir (nnmaildir--srvgrp-dir dir group-name) 501 dir (if (nnmaildir--param pgname 'read-only) 502 (nnmaildir--new dir) (nnmaildir--cur dir))) 503 (concat dir (nnmaildir--art-prefix article) 504 (nnmaildir--art-suffix article))))) 505 506(defun nnmaildir-article-number-to-base-name 507 (number group-name server-address-string) 508 (let ((x (nnmaildir--prepare server-address-string group-name))) 509 (when x 510 (setq x (nnmaildir--nlist-art x number)) 511 (and x (cons (nnmaildir--art-prefix x) 512 (nnmaildir--art-suffix x)))))) 513 514(defun nnmaildir-base-name-to-article-number 515 (base-name group-name server-address-string) 516 (let ((x (nnmaildir--prepare server-address-string group-name))) 517 (when x 518 (setq x (nnmaildir--grp-flist x) 519 x (nnmaildir--flist-art x base-name)) 520 (and x (nnmaildir--art-num x))))) 521 522(defun nnmaildir--nlist-iterate (nlist ranges func) 523 (let (entry high low nlist2) 524 (if (eq ranges 'all) 525 (setq ranges `((1 . ,(caar nlist))))) 526 (while ranges 527 (setq entry (car ranges) ranges (cdr ranges)) 528 (while (and ranges (eq entry (car ranges))) 529 (setq ranges (cdr ranges))) ;; skip duplicates 530 (if (numberp entry) 531 (setq low entry 532 high entry) 533 (setq low (car entry) 534 high (cdr entry))) 535 (setq nlist2 nlist) ;; Don't assume any sorting of ranges 536 (catch 'iterate-loop 537 (while nlist2 538 (if (<= (caar nlist2) high) (throw 'iterate-loop nil)) 539 (setq nlist2 (cdr nlist2)))) 540 (catch 'iterate-loop 541 (while nlist2 542 (setq entry (car nlist2) nlist2 (cdr nlist2)) 543 (if (< (car entry) low) (throw 'iterate-loop nil)) 544 (funcall func (cdr entry))))))) 545 546(defun nnmaildir--up2-1 (n) 547 (if (zerop n) 1 (1- (lsh 1 (1+ (logb n)))))) 548 549(defun nnmaildir--system-name () 550 (gnus-replace-in-string 551 (gnus-replace-in-string 552 (gnus-replace-in-string 553 (system-name) 554 "\\\\" "\\134" 'literal) 555 "/" "\\057" 'literal) 556 ":" "\\072" 'literal)) 557 558(defun nnmaildir-request-type (group &optional article) 559 'mail) 560 561(defun nnmaildir-status-message (&optional server) 562 (nnmaildir--prepare server nil) 563 (nnmaildir--srv-error nnmaildir--cur-server)) 564 565(defun nnmaildir-server-opened (&optional server) 566 (and nnmaildir--cur-server 567 (if server 568 (string-equal server (nnmaildir--srv-address nnmaildir--cur-server)) 569 t) 570 (nnmaildir--srv-groups nnmaildir--cur-server) 571 t)) 572 573(defun nnmaildir-open-server (server &optional defs) 574 (let ((x server) 575 dir size) 576 (catch 'return 577 (setq server (intern-soft x nnmaildir--servers)) 578 (if server 579 (and (setq server (symbol-value server)) 580 (nnmaildir--srv-groups server) 581 (setq nnmaildir--cur-server server) 582 (throw 'return t)) 583 (setq server (make-nnmaildir--srv :address x)) 584 (let ((inhibit-quit t)) 585 (set (intern x nnmaildir--servers) server))) 586 (setq dir (assq 'directory defs)) 587 (unless dir 588 (setf (nnmaildir--srv-error server) 589 "You must set \"directory\" in the select method") 590 (throw 'return nil)) 591 (setq dir (cadr dir) 592 dir (eval dir) 593 dir (expand-file-name dir) 594 dir (file-name-as-directory dir)) 595 (unless (file-exists-p dir) 596 (setf (nnmaildir--srv-error server) (concat "No such directory: " dir)) 597 (throw 'return nil)) 598 (setf (nnmaildir--srv-dir server) dir) 599 (setq x (assq 'directory-files defs)) 600 (if (null x) 601 (setq x (if nnheader-directory-files-is-safe 'directory-files 602 'nnheader-directory-files-safe)) 603 (setq x (cadr x)) 604 (unless (functionp x) 605 (setf (nnmaildir--srv-error server) 606 (concat "Not a function: " (prin1-to-string x))) 607 (throw 'return nil))) 608 (setf (nnmaildir--srv-ls server) x) 609 (setq size (length (funcall x dir nil "\\`[^.]" 'nosort)) 610 size (nnmaildir--up2-1 size)) 611 (and (setq x (assq 'get-new-mail defs)) 612 (setq x (cdr x)) 613 (car x) 614 (setf (nnmaildir--srv-gnm server) t) 615 (require 'nnmail)) 616 (setq x (assq 'target-prefix defs)) 617 (if x 618 (progn 619 (setq x (cadr x) 620 x (eval x)) 621 (setf (nnmaildir--srv-target-prefix server) x)) 622 (setq x (assq 'create-directory defs)) 623 (if x 624 (progn 625 (setq x (cadr x) 626 x (eval x) 627 x (file-name-as-directory x)) 628 (setf (nnmaildir--srv-target-prefix server) x)) 629 (setf (nnmaildir--srv-target-prefix server) ""))) 630 (setf (nnmaildir--srv-groups server) (make-vector size 0)) 631 (setq nnmaildir--cur-server server) 632 t))) 633 634(defun nnmaildir--parse-filename (file) 635 (let ((prefix (car file)) 636 timestamp len) 637 (if (string-match "\\`\\([0-9]+\\)\\(\\..*\\)\\'" prefix) 638 (progn 639 (setq timestamp (concat "0000" (match-string 1 prefix)) 640 len (- (length timestamp) 4)) 641 (vector (string-to-number (substring timestamp 0 len)) 642 (string-to-number (substring timestamp len)) 643 (match-string 2 prefix) 644 file)) 645 file))) 646 647(defun nnmaildir--sort-files (a b) 648 (catch 'return 649 (if (consp a) 650 (throw 'return (and (consp b) (string-lessp (car a) (car b))))) 651 (if (consp b) (throw 'return t)) 652 (if (< (aref a 0) (aref b 0)) (throw 'return t)) 653 (if (> (aref a 0) (aref b 0)) (throw 'return nil)) 654 (if (< (aref a 1) (aref b 1)) (throw 'return t)) 655 (if (> (aref a 1) (aref b 1)) (throw 'return nil)) 656 (string-lessp (aref a 2) (aref b 2)))) 657 658(defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls) 659 (catch 'return 660 (let ((36h-ago (- (car (current-time)) 2)) 661 absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls 662 files num dir flist group x) 663 (setq absdir (nnmaildir--srvgrp-dir srv-dir gname) 664 nndir (nnmaildir--nndir absdir)) 665 (unless (file-exists-p absdir) 666 (setf (nnmaildir--srv-error nnmaildir--cur-server) 667 (concat "No such directory: " absdir)) 668 (throw 'return nil)) 669 (setq tdir (nnmaildir--tmp absdir) 670 ndir (nnmaildir--new absdir) 671 cdir (nnmaildir--cur absdir) 672 nattr (file-attributes ndir) 673 cattr (file-attributes cdir)) 674 (unless (and (file-exists-p tdir) nattr cattr) 675 (setf (nnmaildir--srv-error nnmaildir--cur-server) 676 (concat "Not a maildir: " absdir)) 677 (throw 'return nil)) 678 (setq group (nnmaildir--prepare nil gname) 679 pgname (nnmaildir--pgname nnmaildir--cur-server gname)) 680 (if group 681 (setq isnew nil) 682 (setq isnew t 683 group (make-nnmaildir--grp :name gname :index 0)) 684 (nnmaildir--mkdir nndir) 685 (nnmaildir--mkdir (nnmaildir--nov-dir nndir)) 686 (nnmaildir--mkdir (nnmaildir--marks-dir nndir)) 687 (write-region "" nil (concat nndir "markfile") nil 'no-message)) 688 (setq read-only (nnmaildir--param pgname 'read-only) 689 ls (or (nnmaildir--param pgname 'directory-files) srv-ls)) 690 (unless read-only 691 (setq x (nth 11 (file-attributes tdir))) 692 (unless (and (= x (nth 11 nattr)) (= x (nth 11 cattr))) 693 (setf (nnmaildir--srv-error nnmaildir--cur-server) 694 (concat "Maildir spans filesystems: " absdir)) 695 (throw 'return nil)) 696 (mapcar 697 (lambda (file) 698 (setq x (file-attributes file)) 699 (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago)) 700 (delete-file file))) 701 (funcall ls tdir 'full "\\`[^.]" 'nosort))) 702 (or scan-msgs 703 isnew 704 (throw 'return t)) 705 (setq nattr (nth 5 nattr)) 706 (if (equal nattr (nnmaildir--grp-new group)) 707 (setq nattr nil)) 708 (if read-only (setq dir (and (or isnew nattr) ndir)) 709 (when (or isnew nattr) 710 (mapcar 711 (lambda (file) 712 (let ((path (concat ndir file))) 713 (and (time-less-p (nth 5 (file-attributes path)) (current-time)) 714 (rename-file path (concat cdir file ":2,"))))) 715 (funcall ls ndir nil "\\`[^.]" 'nosort)) 716 (setf (nnmaildir--grp-new group) nattr)) 717 (setq cattr (nth 5 (file-attributes cdir))) 718 (if (equal cattr (nnmaildir--grp-cur group)) 719 (setq cattr nil)) 720 (setq dir (and (or isnew cattr) cdir))) 721 (unless dir (throw 'return t)) 722 (setq files (funcall ls dir nil "\\`[^.]" 'nosort) 723 files (save-match-data 724 (mapcar 725 (lambda (f) 726 (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" f) 727 (cons (match-string 1 f) (match-string 2 f))) 728 files))) 729 (when isnew 730 (setq num (nnmaildir--up2-1 (length files))) 731 (setf (nnmaildir--grp-flist group) (make-vector num 0)) 732 (setf (nnmaildir--grp-mlist group) (make-vector num 0)) 733 (setf (nnmaildir--grp-mmth group) (make-vector 1 0)) 734 (setq num (nnmaildir--param pgname 'nov-cache-size)) 735 (if (numberp num) (if (< num 1) (setq num 1)) 736 (setq num 16 737 cdir (nnmaildir--marks-dir nndir) 738 ndir (nnmaildir--subdir cdir "tick") 739 cdir (nnmaildir--subdir cdir "read")) 740 (mapcar 741 (lambda (file) 742 (setq file (car file)) 743 (if (or (not (file-exists-p (concat cdir file))) 744 (file-exists-p (concat ndir file))) 745 (setq num (1+ num)))) 746 files)) 747 (setf (nnmaildir--grp-cache group) (make-vector num nil)) 748 (let ((inhibit-quit t)) 749 (set (intern gname groups) group)) 750 (or scan-msgs (throw 'return t))) 751 (setq flist (nnmaildir--grp-flist group) 752 files (mapcar 753 (lambda (file) 754 (and (null (nnmaildir--flist-art flist (car file))) 755 file)) 756 files) 757 files (delq nil files) 758 files (mapcar 'nnmaildir--parse-filename files) 759 files (sort files 'nnmaildir--sort-files)) 760 (mapcar 761 (lambda (file) 762 (setq file (if (consp file) file (aref file 3)) 763 x (make-nnmaildir--art :prefix (car file) :suffix (cdr file))) 764 (nnmaildir--grp-add-art nnmaildir--cur-server group x)) 765 files) 766 (if read-only (setf (nnmaildir--grp-new group) nattr) 767 (setf (nnmaildir--grp-cur group) cattr))) 768 t)) 769 770(defun nnmaildir-request-scan (&optional scan-group server) 771 (let ((coding-system-for-write nnheader-file-coding-system) 772 (buffer-file-coding-system nil) 773 (file-coding-system-alist nil) 774 (nnmaildir-get-new-mail t) 775 (nnmaildir-group-alist nil) 776 (nnmaildir-active-file nil) 777 x srv-ls srv-dir method groups target-prefix group dirs grp-dir seen 778 deactivate-mark) 779 (nnmaildir--prepare server nil) 780 (setq srv-ls (nnmaildir--srv-ls nnmaildir--cur-server) 781 srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) 782 method (nnmaildir--srv-method nnmaildir--cur-server) 783 groups (nnmaildir--srv-groups nnmaildir--cur-server) 784 target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server)) 785 (nnmaildir--with-work-buffer 786 (save-match-data 787 (if (stringp scan-group) 788 (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls) 789 (if (nnmaildir--srv-gnm nnmaildir--cur-server) 790 (nnmail-get-new-mail 'nnmaildir nil nil scan-group)) 791 (unintern scan-group groups)) 792 (setq x (nth 5 (file-attributes srv-dir)) 793 scan-group (null scan-group)) 794 (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server)) 795 (if scan-group 796 (mapatoms (lambda (sym) 797 (nnmaildir--scan (symbol-name sym) t groups 798 method srv-dir srv-ls)) 799 groups)) 800 (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort) 801 dirs (if (zerop (length target-prefix)) 802 dirs 803 (gnus-remove-if 804 (lambda (dir) 805 (and (>= (length dir) (length target-prefix)) 806 (string= (substring dir 0 807 (length target-prefix)) 808 target-prefix))) 809 dirs)) 810 seen (nnmaildir--up2-1 (length dirs)) 811 seen (make-vector seen 0)) 812 (mapcar 813 (lambda (grp-dir) 814 (if (nnmaildir--scan grp-dir scan-group groups method srv-dir 815 srv-ls) 816 (intern grp-dir seen))) 817 dirs) 818 (setq x nil) 819 (mapatoms (lambda (group) 820 (setq group (symbol-name group)) 821 (unless (intern-soft group seen) 822 (setq x (cons group x)))) 823 groups) 824 (mapcar (lambda (grp) (unintern grp groups)) x) 825 (setf (nnmaildir--srv-mtime nnmaildir--cur-server) 826 (nth 5 (file-attributes srv-dir)))) 827 (and scan-group 828 (nnmaildir--srv-gnm nnmaildir--cur-server) 829 (nnmail-get-new-mail 'nnmaildir nil nil)))))) 830 t) 831 832(defun nnmaildir-request-list (&optional server) 833 (nnmaildir-request-scan 'find-new-groups server) 834 (let (pgname ro deactivate-mark) 835 (nnmaildir--prepare server nil) 836 (nnmaildir--with-nntp-buffer 837 (erase-buffer) 838 (mapatoms (lambda (group) 839 (setq pgname (symbol-name group) 840 pgname (nnmaildir--pgname nnmaildir--cur-server pgname) 841 group (symbol-value group) 842 ro (nnmaildir--param pgname 'read-only)) 843 (insert (nnmaildir--grp-name group) " ") 844 (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) 845 nntp-server-buffer) 846 (insert " ") 847 (princ (nnmaildir--grp-min group) nntp-server-buffer) 848 (insert " " (if ro "n" "y") "\n")) 849 (nnmaildir--srv-groups nnmaildir--cur-server)))) 850 t) 851 852(defun nnmaildir-request-newgroups (date &optional server) 853 (nnmaildir-request-list server)) 854 855(defun nnmaildir-retrieve-groups (groups &optional server) 856 (let (group deactivate-mark) 857 (nnmaildir--prepare server nil) 858 (nnmaildir--with-nntp-buffer 859 (erase-buffer) 860 (mapcar 861 (lambda (gname) 862 (setq group (nnmaildir--prepare nil gname)) 863 (if (null group) (insert "411 no such news group\n") 864 (insert "211 ") 865 (princ (nnmaildir--grp-count group) nntp-server-buffer) 866 (insert " ") 867 (princ (nnmaildir--grp-min group) nntp-server-buffer) 868 (insert " ") 869 (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) 870 nntp-server-buffer) 871 (insert " " gname "\n"))) 872 groups))) 873 'group) 874 875(defun nnmaildir-request-update-info (gname info &optional server) 876 (let ((group (nnmaildir--prepare server gname)) 877 pgname flist always-marks never-marks old-marks dotfile num dir 878 markdirs marks mark ranges markdir article read end new-marks ls 879 old-mmth new-mmth mtime mark-sym existing missing deactivate-mark) 880 (catch 'return 881 (unless group 882 (setf (nnmaildir--srv-error nnmaildir--cur-server) 883 (concat "No such group: " gname)) 884 (throw 'return nil)) 885 (setq gname (nnmaildir--grp-name group) 886 pgname (nnmaildir--pgname nnmaildir--cur-server gname) 887 flist (nnmaildir--grp-flist group)) 888 (when (zerop (nnmaildir--grp-count group)) 889 (gnus-info-set-read info nil) 890 (gnus-info-set-marks info nil 'extend) 891 (throw 'return info)) 892 (setq old-marks (cons 'read (gnus-info-read info)) 893 old-marks (cons old-marks (gnus-info-marks info)) 894 always-marks (nnmaildir--param pgname 'always-marks) 895 never-marks (nnmaildir--param pgname 'never-marks) 896 existing (nnmaildir--grp-nlist group) 897 existing (mapcar 'car existing) 898 existing (nreverse existing) 899 existing (gnus-compress-sequence existing 'always-list) 900 missing (list (cons 1 (nnmaildir--group-maxnum 901 nnmaildir--cur-server group))) 902 missing (gnus-range-difference missing existing) 903 dir (nnmaildir--srv-dir nnmaildir--cur-server) 904 dir (nnmaildir--srvgrp-dir dir gname) 905 dir (nnmaildir--nndir dir) 906 dir (nnmaildir--marks-dir dir) 907 ls (nnmaildir--group-ls nnmaildir--cur-server pgname) 908 markdirs (funcall ls dir nil "\\`[^.]" 'nosort) 909 new-mmth (nnmaildir--up2-1 (length markdirs)) 910 new-mmth (make-vector new-mmth 0) 911 old-mmth (nnmaildir--grp-mmth group)) 912 (mapcar 913 (lambda (mark) 914 (setq markdir (nnmaildir--subdir dir mark) 915 mark-sym (intern mark) 916 ranges nil) 917 (catch 'got-ranges 918 (if (memq mark-sym never-marks) (throw 'got-ranges nil)) 919 (when (memq mark-sym always-marks) 920 (setq ranges existing) 921 (throw 'got-ranges nil)) 922 (setq mtime (nth 5 (file-attributes markdir))) 923 (set (intern mark new-mmth) mtime) 924 (when (equal mtime (symbol-value (intern-soft mark old-mmth))) 925 (setq ranges (assq mark-sym old-marks)) 926 (if ranges (setq ranges (cdr ranges))) 927 (throw 'got-ranges nil)) 928 (mapcar 929 (lambda (prefix) 930 (setq article (nnmaildir--flist-art flist prefix)) 931 (if article 932 (setq ranges 933 (gnus-add-to-range ranges 934 `(,(nnmaildir--art-num article)))))) 935 (funcall ls markdir nil "\\`[^.]" 'nosort))) 936 (if (eq mark-sym 'read) (setq read ranges) 937 (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) 938 markdirs) 939 (gnus-info-set-read info (gnus-range-add read missing)) 940 (gnus-info-set-marks info marks 'extend) 941 (setf (nnmaildir--grp-mmth group) new-mmth) 942 info))) 943 944(defun nnmaildir-request-group (gname &optional server fast) 945 (let ((group (nnmaildir--prepare server gname)) 946 deactivate-mark) 947 (catch 'return 948 (unless group 949 ;; (insert "411 no such news group\n") 950 (setf (nnmaildir--srv-error nnmaildir--cur-server) 951 (concat "No such group: " gname)) 952 (throw 'return nil)) 953 (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group) 954 (if fast (throw 'return t)) 955 (nnmaildir--with-nntp-buffer 956 (erase-buffer) 957 (insert "211 ") 958 (princ (nnmaildir--grp-count group) nntp-server-buffer) 959 (insert " ") 960 (princ (nnmaildir--grp-min group) nntp-server-buffer) 961 (insert " ") 962 (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) 963 nntp-server-buffer) 964 (insert " " gname "\n") 965 t)))) 966 967(defun nnmaildir-request-create-group (gname &optional server args) 968 (nnmaildir--prepare server nil) 969 (catch 'return 970 (let ((target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server)) 971 srv-dir dir groups) 972 (when (zerop (length gname)) 973 (setf (nnmaildir--srv-error nnmaildir--cur-server) 974 "Invalid (empty) group name") 975 (throw 'return nil)) 976 (when (eq (aref "." 0) (aref gname 0)) 977 (setf (nnmaildir--srv-error nnmaildir--cur-server) 978 "Group names may not start with \".\"") 979 (throw 'return nil)) 980 (when (save-match-data (string-match "[\0/\t]" gname)) 981 (setf (nnmaildir--srv-error nnmaildir--cur-server) 982 (concat "Invalid characters (null, tab, or /) in group name: " 983 gname)) 984 (throw 'return nil)) 985 (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)) 986 (when (intern-soft gname groups) 987 (setf (nnmaildir--srv-error nnmaildir--cur-server) 988 (concat "Group already exists: " gname)) 989 (throw 'return nil)) 990 (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)) 991 (if (file-name-absolute-p target-prefix) 992 (setq dir (expand-file-name target-prefix)) 993 (setq dir srv-dir 994 dir (file-truename dir) 995 dir (concat dir target-prefix))) 996 (setq dir (nnmaildir--subdir dir gname)) 997 (nnmaildir--mkdir dir) 998 (nnmaildir--mkdir (nnmaildir--tmp dir)) 999 (nnmaildir--mkdir (nnmaildir--new dir)) 1000 (nnmaildir--mkdir (nnmaildir--cur dir)) 1001 (unless (string= target-prefix "") 1002 (make-symbolic-link (concat target-prefix gname) 1003 (concat srv-dir gname))) 1004 (nnmaildir-request-scan 'find-new-groups)))) 1005 1006(defun nnmaildir-request-rename-group (gname new-name &optional server) 1007 (let ((group (nnmaildir--prepare server gname)) 1008 (coding-system-for-write nnheader-file-coding-system) 1009 (buffer-file-coding-system nil) 1010 (file-coding-system-alist nil) 1011 srv-dir x groups) 1012 (catch 'return 1013 (unless group 1014 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1015 (concat "No such group: " gname)) 1016 (throw 'return nil)) 1017 (when (zerop (length new-name)) 1018 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1019 "Invalid (empty) group name") 1020 (throw 'return nil)) 1021 (when (eq (aref "." 0) (aref new-name 0)) 1022 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1023 "Group names may not start with \".\"") 1024 (throw 'return nil)) 1025 (when (save-match-data (string-match "[\0/\t]" new-name)) 1026 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1027 (concat "Invalid characters (null, tab, or /) in group name: " 1028 new-name)) 1029 (throw 'return nil)) 1030 (if (string-equal gname new-name) (throw 'return t)) 1031 (when (intern-soft new-name 1032 (nnmaildir--srv-groups nnmaildir--cur-server)) 1033 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1034 (concat "Group already exists: " new-name)) 1035 (throw 'return nil)) 1036 (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)) 1037 (condition-case err 1038 (rename-file (concat srv-dir gname) 1039 (concat srv-dir new-name)) 1040 (error 1041 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1042 (concat "Error renaming link: " (prin1-to-string err))) 1043 (throw 'return nil))) 1044 (setq x (nnmaildir--srv-groups nnmaildir--cur-server) 1045 groups (make-vector (length x) 0)) 1046 (mapatoms (lambda (sym) 1047 (unless (eq (symbol-value sym) group) 1048 (set (intern (symbol-name sym) groups) 1049 (symbol-value sym)))) 1050 x) 1051 (setq group (copy-sequence group)) 1052 (setf (nnmaildir--grp-name group) new-name) 1053 (set (intern new-name groups) group) 1054 (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups) 1055 t))) 1056 1057(defun nnmaildir-request-delete-group (gname force &optional server) 1058 (let ((group (nnmaildir--prepare server gname)) 1059 pgname grp-dir target dir ls deactivate-mark) 1060 (catch 'return 1061 (unless group 1062 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1063 (concat "No such group: " gname)) 1064 (throw 'return nil)) 1065 (setq gname (nnmaildir--grp-name group) 1066 pgname (nnmaildir--pgname nnmaildir--cur-server gname) 1067 grp-dir (nnmaildir--srv-dir nnmaildir--cur-server) 1068 target (car (file-attributes (concat grp-dir gname))) 1069 grp-dir (nnmaildir--srvgrp-dir grp-dir gname)) 1070 (unless (or force (stringp target)) 1071 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1072 (concat "Not a symlink: " gname)) 1073 (throw 'return nil)) 1074 (if (eq group (nnmaildir--srv-curgrp nnmaildir--cur-server)) 1075 (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) nil)) 1076 (unintern gname (nnmaildir--srv-groups nnmaildir--cur-server)) 1077 (if (not force) 1078 (progn 1079 (setq grp-dir (directory-file-name grp-dir)) 1080 (nnmaildir--unlink grp-dir)) 1081 (setq ls (nnmaildir--group-ls nnmaildir--cur-server pgname)) 1082 (if (nnmaildir--param pgname 'read-only) 1083 (progn (delete-directory (nnmaildir--tmp grp-dir)) 1084 (nnmaildir--unlink (nnmaildir--new grp-dir)) 1085 (delete-directory (nnmaildir--cur grp-dir))) 1086 (nnmaildir--delete-dir-files (nnmaildir--tmp grp-dir) ls) 1087 (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls) 1088 (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls)) 1089 (setq dir (nnmaildir--nndir grp-dir)) 1090 (mapcar (lambda (subdir) (nnmaildir--delete-dir-files subdir ls)) 1091 `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir) 1092 ,@(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]" 1093 'nosort))) 1094 (setq dir (nnmaildir--nndir grp-dir)) 1095 (nnmaildir--unlink (concat dir "markfile")) 1096 (nnmaildir--unlink (concat dir "markfile{new}")) 1097 (delete-directory (nnmaildir--marks-dir dir)) 1098 (delete-directory dir) 1099 (if (not (stringp target)) 1100 (delete-directory grp-dir) 1101 (setq grp-dir (directory-file-name grp-dir) 1102 dir target) 1103 (unless (eq (aref "/" 0) (aref dir 0)) 1104 (setq dir (concat (file-truename 1105 (nnmaildir--srv-dir nnmaildir--cur-server)) 1106 dir))) 1107 (delete-directory dir) 1108 (nnmaildir--unlink grp-dir))) 1109 t))) 1110 1111(defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old) 1112 (let ((group (nnmaildir--prepare server gname)) 1113 srv-dir dir nlist mlist article num start stop nov nlist2 insert-nov 1114 deactivate-mark) 1115 (setq insert-nov 1116 (lambda (article) 1117 (setq nov (nnmaildir--update-nov nnmaildir--cur-server group 1118 article)) 1119 (when nov 1120 (nnmaildir--cache-nov group article nov) 1121 (setq num (nnmaildir--art-num article)) 1122 (princ num nntp-server-buffer) 1123 (insert "\t" (nnmaildir--nov-get-beg nov) "\t" 1124 (nnmaildir--art-msgid article) "\t" 1125 (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " 1126 gname ":") 1127 (princ num nntp-server-buffer) 1128 (insert "\t" (nnmaildir--nov-get-end nov) "\n")))) 1129 (catch 'return 1130 (unless group 1131 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1132 (if gname (concat "No such group: " gname) "No current group")) 1133 (throw 'return nil)) 1134 (nnmaildir--with-nntp-buffer 1135 (erase-buffer) 1136 (setq mlist (nnmaildir--grp-mlist group) 1137 nlist (nnmaildir--grp-nlist group) 1138 gname (nnmaildir--grp-name group) 1139 srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) 1140 dir (nnmaildir--srvgrp-dir srv-dir gname)) 1141 (cond 1142 ((null nlist)) 1143 ((and fetch-old (not (numberp fetch-old))) 1144 (nnmaildir--nlist-iterate nlist 'all insert-nov)) 1145 ((null articles)) 1146 ((stringp (car articles)) 1147 (mapcar 1148 (lambda (msgid) 1149 (setq article (nnmaildir--mlist-art mlist msgid)) 1150 (if article (funcall insert-nov article))) 1151 articles)) 1152 (t 1153 (if fetch-old 1154 ;; Assume the article range list is sorted ascending 1155 (setq stop (car articles) 1156 start (car (last articles)) 1157 stop (if (numberp stop) stop (car stop)) 1158 start (if (numberp start) start (cdr start)) 1159 stop (- stop fetch-old) 1160 stop (if (< stop 1) 1 stop) 1161 articles (list (cons stop start)))) 1162 (nnmaildir--nlist-iterate nlist articles insert-nov))) 1163 (sort-numeric-fields 1 (point-min) (point-max)) 1164 'nov)))) 1165 1166(defun nnmaildir-request-article (num-msgid &optional gname server to-buffer) 1167 (let ((group (nnmaildir--prepare server gname)) 1168 (case-fold-search t) 1169 list article dir pgname deactivate-mark) 1170 (catch 'return 1171 (unless group 1172 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1173 (if gname (concat "No such group: " gname) "No current group")) 1174 (throw 'return nil)) 1175 (if (numberp num-msgid) 1176 (setq article (nnmaildir--nlist-art group num-msgid)) 1177 (setq list (nnmaildir--grp-mlist group) 1178 article (nnmaildir--mlist-art list num-msgid)) 1179 (if article (setq num-msgid (nnmaildir--art-num article)) 1180 (catch 'found 1181 (mapatoms 1182 (lambda (group-sym) 1183 (setq group (symbol-value group-sym) 1184 list (nnmaildir--grp-mlist group) 1185 article (nnmaildir--mlist-art list num-msgid)) 1186 (when article 1187 (setq num-msgid (nnmaildir--art-num article)) 1188 (throw 'found nil))) 1189 (nnmaildir--srv-groups nnmaildir--cur-server)))) 1190 (unless article 1191 (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article") 1192 (throw 'return nil))) 1193 (setq gname (nnmaildir--grp-name group) 1194 pgname (nnmaildir--pgname nnmaildir--cur-server gname) 1195 dir (nnmaildir--srv-dir nnmaildir--cur-server) 1196 dir (nnmaildir--srvgrp-dir dir gname) 1197 dir (if (nnmaildir--param pgname 'read-only) 1198 (nnmaildir--new dir) (nnmaildir--cur dir)) 1199 nnmaildir-article-file-name 1200 (concat dir 1201 (nnmaildir--art-prefix article) 1202 (nnmaildir--art-suffix article))) 1203 (unless (file-exists-p nnmaildir-article-file-name) 1204 (nnmaildir--expired-article group article) 1205 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1206 "Article has expired") 1207 (throw 'return nil)) 1208 (save-excursion 1209 (set-buffer (or to-buffer nntp-server-buffer)) 1210 (erase-buffer) 1211 (nnheader-insert-file-contents nnmaildir-article-file-name)) 1212 (cons gname num-msgid)))) 1213 1214(defun nnmaildir-request-post (&optional server) 1215 (let (message-required-mail-headers) 1216 (funcall message-send-mail-function))) 1217 1218(defun nnmaildir-request-replace-article (number gname buffer) 1219 (let ((group (nnmaildir--prepare nil gname)) 1220 (coding-system-for-write nnheader-file-coding-system) 1221 (buffer-file-coding-system nil) 1222 (file-coding-system-alist nil) 1223 dir file article suffix tmpfile deactivate-mark) 1224 (catch 'return 1225 (unless group 1226 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1227 (concat "No such group: " gname)) 1228 (throw 'return nil)) 1229 (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname) 1230 'read-only) 1231 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1232 (concat "Read-only group: " group)) 1233 (throw 'return nil)) 1234 (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) 1235 dir (nnmaildir--srvgrp-dir dir gname) 1236 article (nnmaildir--nlist-art group number)) 1237 (unless article 1238 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1239 (concat "No such article: " (number-to-string number))) 1240 (throw 'return nil)) 1241 (setq suffix (nnmaildir--art-suffix article) 1242 file (nnmaildir--art-prefix article) 1243 tmpfile (concat (nnmaildir--tmp dir) file)) 1244 (when (file-exists-p tmpfile) 1245 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1246 (concat "File exists: " tmpfile)) 1247 (throw 'return nil)) 1248 (save-excursion 1249 (set-buffer buffer) 1250 (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil 1251 'excl)) 1252 (unix-sync) ;; no fsync :( 1253 (rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace) 1254 t))) 1255 1256(defun nnmaildir-request-move-article (article gname server accept-form 1257 &optional last) 1258 (let ((group (nnmaildir--prepare server gname)) 1259 pgname suffix result nnmaildir--file deactivate-mark) 1260 (catch 'return 1261 (unless group 1262 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1263 (concat "No such group: " gname)) 1264 (throw 'return nil)) 1265 (setq gname (nnmaildir--grp-name group) 1266 pgname (nnmaildir--pgname nnmaildir--cur-server gname) 1267 article (nnmaildir--nlist-art group article)) 1268 (unless article 1269 (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article") 1270 (throw 'return nil)) 1271 (setq suffix (nnmaildir--art-suffix article) 1272 nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server) 1273 nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname) 1274 nnmaildir--file (if (nnmaildir--param pgname 'read-only) 1275 (nnmaildir--new nnmaildir--file) 1276 (nnmaildir--cur nnmaildir--file)) 1277 nnmaildir--file (concat nnmaildir--file 1278 (nnmaildir--art-prefix article) 1279 suffix)) 1280 (unless (file-exists-p nnmaildir--file) 1281 (nnmaildir--expired-article group article) 1282 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1283 "Article has expired") 1284 (throw 'return nil)) 1285 (nnmaildir--with-move-buffer 1286 (erase-buffer) 1287 (nnheader-insert-file-contents nnmaildir--file) 1288 (setq result (eval accept-form))) 1289 (unless (or (null result) (nnmaildir--param pgname 'read-only)) 1290 (nnmaildir--unlink nnmaildir--file) 1291 (nnmaildir--expired-article group article)) 1292 result))) 1293 1294(defun nnmaildir-request-accept-article (gname &optional server last) 1295 (let ((group (nnmaildir--prepare server gname)) 1296 (coding-system-for-write nnheader-file-coding-system) 1297 (buffer-file-coding-system nil) 1298 (file-coding-system-alist nil) 1299 srv-dir dir file time tmpfile curfile 24h article) 1300 (catch 'return 1301 (unless group 1302 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1303 (concat "No such group: " gname)) 1304 (throw 'return nil)) 1305 (setq gname (nnmaildir--grp-name group)) 1306 (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname) 1307 'read-only) 1308 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1309 (concat "Read-only group: " gname)) 1310 (throw 'return nil)) 1311 (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) 1312 dir (nnmaildir--srvgrp-dir srv-dir gname) 1313 time (current-time) 1314 file (format-time-string "%s." time)) 1315 (unless (string-equal nnmaildir--delivery-time file) 1316 (setq nnmaildir--delivery-time file 1317 nnmaildir--delivery-count 0)) 1318 (when (and (consp (cdr time)) 1319 (consp (cddr time))) 1320 (setq file (concat file "M" (number-to-string (caddr time))))) 1321 (setq file (concat file nnmaildir--delivery-pid) 1322 file (concat file "Q" (number-to-string nnmaildir--delivery-count)) 1323 file (concat file "." (nnmaildir--system-name)) 1324 tmpfile (concat (nnmaildir--tmp dir) file) 1325 curfile (concat (nnmaildir--cur dir) file ":2,")) 1326 (when (file-exists-p tmpfile) 1327 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1328 (concat "File exists: " tmpfile)) 1329 (throw 'return nil)) 1330 (when (file-exists-p curfile) 1331 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1332 (concat "File exists: " curfile)) 1333 (throw 'return nil)) 1334 (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count) 1335 24h (run-with-timer 86400 nil 1336 (lambda () 1337 (nnmaildir--unlink tmpfile) 1338 (setf (nnmaildir--srv-error 1339 nnmaildir--cur-server) 1340 "24-hour timer expired") 1341 (throw 'return nil)))) 1342 (condition-case nil 1343 (add-name-to-file nnmaildir--file tmpfile) 1344 (error 1345 (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil 1346 'excl) 1347 (unix-sync))) ;; no fsync :( 1348 (nnheader-cancel-timer 24h) 1349 (condition-case err 1350 (add-name-to-file tmpfile curfile) 1351 (error 1352 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1353 (concat "Error linking: " (prin1-to-string err))) 1354 (nnmaildir--unlink tmpfile) 1355 (throw 'return nil))) 1356 (nnmaildir--unlink tmpfile) 1357 (setq article (make-nnmaildir--art :prefix file :suffix ":2,")) 1358 (if (nnmaildir--grp-add-art nnmaildir--cur-server group article) 1359 (cons gname (nnmaildir--art-num article)))))) 1360 1361(defun nnmaildir-save-mail (group-art) 1362 (catch 'return 1363 (unless group-art 1364 (throw 'return nil)) 1365 (let (ga gname x groups nnmaildir--file deactivate-mark) 1366 (save-excursion 1367 (goto-char (point-min)) 1368 (save-match-data 1369 (while (looking-at "From ") 1370 (replace-match "X-From-Line: ") 1371 (forward-line 1)))) 1372 (setq groups (nnmaildir--srv-groups nnmaildir--cur-server) 1373 ga (car group-art) group-art (cdr group-art) 1374 gname (car ga)) 1375 (or (intern-soft gname groups) 1376 (nnmaildir-request-create-group gname) 1377 (throw 'return nil)) ;; not that nnmail bothers to check :( 1378 (unless (nnmaildir-request-accept-article gname) 1379 (throw 'return nil)) 1380 (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server) 1381 nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname) 1382 x (nnmaildir--prepare nil gname) 1383 x (nnmaildir--grp-nlist x) 1384 x (cdar x) 1385 nnmaildir--file (concat nnmaildir--file 1386 (nnmaildir--art-prefix x) 1387 (nnmaildir--art-suffix x))) 1388 (delq nil 1389 (mapcar 1390 (lambda (ga) 1391 (setq gname (car ga)) 1392 (and (or (intern-soft gname groups) 1393 (nnmaildir-request-create-group gname)) 1394 (nnmaildir-request-accept-article gname) 1395 ga)) 1396 group-art))))) 1397 1398(defun nnmaildir-active-number (gname) 1399 0) 1400 1401(defun nnmaildir-request-expire-articles (ranges &optional gname server force) 1402 (let ((no-force (not force)) 1403 (group (nnmaildir--prepare server gname)) 1404 pgname time boundary bound-iter high low target dir nlist nlist2 1405 stop article didnt nnmaildir--file nnmaildir-article-file-name 1406 deactivate-mark) 1407 (catch 'return 1408 (unless group 1409 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1410 (if gname (concat "No such group: " gname) "No current group")) 1411 (throw 'return (gnus-uncompress-range ranges))) 1412 (setq gname (nnmaildir--grp-name group) 1413 pgname (nnmaildir--pgname nnmaildir--cur-server gname)) 1414 (if (nnmaildir--param pgname 'read-only) 1415 (throw 'return (gnus-uncompress-range ranges))) 1416 (setq time (nnmaildir--param pgname 'expire-age)) 1417 (unless time 1418 (setq time (or (and nnmail-expiry-wait-function 1419 (funcall nnmail-expiry-wait-function gname)) 1420 nnmail-expiry-wait)) 1421 (if (eq time 'immediate) 1422 (setq time 0) 1423 (if (numberp time) 1424 (setq time (* time 86400))))) 1425 (when no-force 1426 (unless (integerp time) ;; handle 'never 1427 (throw 'return (gnus-uncompress-range ranges))) 1428 (setq boundary (current-time) 1429 high (- (car boundary) (/ time 65536)) 1430 low (- (cadr boundary) (% time 65536))) 1431 (if (< low 0) 1432 (setq low (+ low 65536) 1433 high (1- high))) 1434 (setcar (cdr boundary) low) 1435 (setcar boundary high)) 1436 (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) 1437 dir (nnmaildir--srvgrp-dir dir gname) 1438 dir (nnmaildir--cur dir) 1439 nlist (nnmaildir--grp-nlist group) 1440 ranges (reverse ranges)) 1441 (nnmaildir--with-move-buffer 1442 (nnmaildir--nlist-iterate 1443 nlist ranges 1444 (lambda (article) 1445 (setq nnmaildir--file (nnmaildir--art-prefix article) 1446 nnmaildir--file (concat dir nnmaildir--file 1447 (nnmaildir--art-suffix article)) 1448 time (file-attributes nnmaildir--file)) 1449 (cond 1450 ((null time) 1451 (nnmaildir--expired-article group article)) 1452 ((and no-force 1453 (progn 1454 (setq time (nth 5 time) 1455 bound-iter boundary) 1456 (while (and bound-iter time 1457 (= (car bound-iter) (car time))) 1458 (setq bound-iter (cdr bound-iter) 1459 time (cdr time))) 1460 (and bound-iter time 1461 (car-less-than-car bound-iter time)))) 1462 (setq didnt (cons (nnmaildir--art-num article) didnt))) 1463 (t 1464 (setq nnmaildir-article-file-name nnmaildir--file 1465 target (if force nil 1466 (save-excursion 1467 (save-restriction 1468 (nnmaildir--param pgname 'expire-group))))) 1469 (when (and (stringp target) 1470 (not (string-equal target pgname))) ;; Move it. 1471 (erase-buffer) 1472 (nnheader-insert-file-contents nnmaildir--file) 1473 (gnus-request-accept-article target nil nil 'no-encode)) 1474 (if (equal target pgname) 1475 ;; Leave it here. 1476 (setq didnt (cons (nnmaildir--art-num article) didnt)) 1477 (nnmaildir--unlink nnmaildir--file) 1478 (nnmaildir--expired-article group article)))))) 1479 (erase-buffer)) 1480 didnt))) 1481 1482(defun nnmaildir-request-set-mark (gname actions &optional server) 1483 (let ((group (nnmaildir--prepare server gname)) 1484 (coding-system-for-write nnheader-file-coding-system) 1485 (buffer-file-coding-system nil) 1486 (file-coding-system-alist nil) 1487 del-mark del-action add-action set-action marksdir markfile nlist 1488 ranges begin end article all-marks todo-marks did-marks mdir mfile 1489 pgname ls permarkfile deactivate-mark) 1490 (setq del-mark 1491 (lambda (mark) 1492 (setq mfile (nnmaildir--subdir marksdir (symbol-name mark)) 1493 mfile (concat mfile (nnmaildir--art-prefix article))) 1494 (nnmaildir--unlink mfile)) 1495 del-action (lambda (article) (mapcar del-mark todo-marks)) 1496 add-action 1497 (lambda (article) 1498 (mapcar 1499 (lambda (mark) 1500 (setq mdir (nnmaildir--subdir marksdir (symbol-name mark)) 1501 permarkfile (concat mdir ":") 1502 mfile (concat mdir (nnmaildir--art-prefix article))) 1503 (unless (memq mark did-marks) 1504 (setq did-marks (cons mark did-marks)) 1505 (nnmaildir--mkdir mdir) 1506 (unless (file-attributes permarkfile) 1507 (condition-case nil 1508 (add-name-to-file markfile permarkfile) 1509 (file-error 1510 ;; AFS can't make hard links in separate directories 1511 (write-region "" nil permarkfile nil 'no-message))))) 1512 (unless (file-exists-p mfile) 1513 (add-name-to-file permarkfile mfile))) 1514 todo-marks)) 1515 set-action (lambda (article) 1516 (funcall add-action) 1517 (mapcar (lambda (mark) 1518 (unless (memq mark todo-marks) 1519 (funcall del-mark mark))) 1520 all-marks))) 1521 (catch 'return 1522 (unless group 1523 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1524 (concat "No such group: " gname)) 1525 (mapcar (lambda (action) 1526 (setq ranges (gnus-range-add ranges (car action)))) 1527 actions) 1528 (throw 'return ranges)) 1529 (setq nlist (nnmaildir--grp-nlist group) 1530 marksdir (nnmaildir--srv-dir nnmaildir--cur-server) 1531 marksdir (nnmaildir--srvgrp-dir marksdir gname) 1532 marksdir (nnmaildir--nndir marksdir) 1533 markfile (concat marksdir "markfile") 1534 marksdir (nnmaildir--marks-dir marksdir) 1535 gname (nnmaildir--grp-name group) 1536 pgname (nnmaildir--pgname nnmaildir--cur-server gname) 1537 ls (nnmaildir--group-ls nnmaildir--cur-server pgname) 1538 all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort) 1539 all-marks (mapcar 'intern all-marks)) 1540 (mapcar 1541 (lambda (action) 1542 (setq ranges (car action) 1543 todo-marks (caddr action)) 1544 (mapcar (lambda (mark) (add-to-list 'all-marks mark)) todo-marks) 1545 (if (numberp (cdr ranges)) (setq ranges (list ranges))) 1546 (nnmaildir--nlist-iterate nlist ranges 1547 (cond ((eq 'del (cadr action)) del-action) 1548 ((eq 'add (cadr action)) add-action) 1549 (t set-action)))) 1550 actions) 1551 nil))) 1552 1553(defun nnmaildir-close-group (gname &optional server) 1554 (let ((group (nnmaildir--prepare server gname)) 1555 pgname ls dir msgdir files flist dirs) 1556 (if (null group) 1557 (progn 1558 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1559 (concat "No such group: " gname)) 1560 nil) 1561 (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname) 1562 ls (nnmaildir--group-ls nnmaildir--cur-server pgname) 1563 dir (nnmaildir--srv-dir nnmaildir--cur-server) 1564 dir (nnmaildir--srvgrp-dir dir gname) 1565 msgdir (if (nnmaildir--param pgname 'read-only) 1566 (nnmaildir--new dir) (nnmaildir--cur dir)) 1567 dir (nnmaildir--nndir dir) 1568 dirs (cons (nnmaildir--nov-dir dir) 1569 (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]" 1570 'nosort)) 1571 dirs (mapcar 1572 (lambda (dir) 1573 (cons dir (funcall ls dir nil "\\`[^.]" 'nosort))) 1574 dirs) 1575 files (funcall ls msgdir nil "\\`[^.]" 'nosort) 1576 flist (nnmaildir--up2-1 (length files)) 1577 flist (make-vector flist 0)) 1578 (save-match-data 1579 (mapcar 1580 (lambda (file) 1581 (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) 1582 (intern (match-string 1 file) flist)) 1583 files)) 1584 (mapcar 1585 (lambda (dir) 1586 (setq files (cdr dir) 1587 dir (file-name-as-directory (car dir))) 1588 (mapcar 1589 (lambda (file) 1590 (unless (or (intern-soft file flist) (string= file ":")) 1591 (setq file (concat dir file)) 1592 (delete-file file))) 1593 files)) 1594 dirs) 1595 t))) 1596 1597(defun nnmaildir-close-server (&optional server) 1598 (let (flist ls dirs dir files file x) 1599 (nnmaildir--prepare server nil) 1600 (when nnmaildir--cur-server 1601 (setq server nnmaildir--cur-server 1602 nnmaildir--cur-server nil) 1603 (unintern (nnmaildir--srv-address server) nnmaildir--servers))) 1604 t) 1605 1606(defun nnmaildir-request-close () 1607 (let (servers buffer) 1608 (mapatoms (lambda (server) 1609 (setq servers (cons (symbol-name server) servers))) 1610 nnmaildir--servers) 1611 (mapcar 'nnmaildir-close-server servers) 1612 (setq buffer (get-buffer " *nnmaildir work*")) 1613 (if buffer (kill-buffer buffer)) 1614 (setq buffer (get-buffer " *nnmaildir nov*")) 1615 (if buffer (kill-buffer buffer)) 1616 (setq buffer (get-buffer " *nnmaildir move*")) 1617 (if buffer (kill-buffer buffer))) 1618 t) 1619 1620(provide 'nnmaildir) 1621 1622;; Local Variables: 1623;; indent-tabs-mode: t 1624;; fill-column: 77 1625;; End: 1626 1627;;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849 1628;;; nnmaildir.el ends here 1629