elmo/elmo-maildir.el

   1 ;;; elmo-maildir.el --- Maildir interface for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31
  32 (eval-when-compile (require 'cl))
  33
  34 (require 'elmo-util)
  35 (require 'elmo)
  36 (require 'elmo-map)
  37
  38 (defcustom elmo-maildir-folder-path "~/Maildir"
  39   "*Maildir folder path."
  40   :type 'directory
  41   :group 'elmo)
  42
  43 (defconst elmo-maildir-flag-specs '((important ?F)
  44                                     (read ?S)
  45                                     (unread ?S 'remove)
  46                                     (answered ?R)))
  47
  48 ;; Decided at compile time.
  49 (defcustom elmo-maildir-separator
  50   (if (memq system-type '(windows-nt)) ?\- ?:)
  51   "Character separating the id section from the flags section.
  52 According to the maildir specification, this should be a colon (?:),
  53 but some file systems don't support colons in filenames."
  54   :type 'character
  55   :group 'elmo)
  56
  57 (defmacro elmo-maildir-adjust-separator (string)
  58   `(if (= elmo-maildir-separator ?:)
  59        ,string
  60      (elmo-replace-in-string
  61       ,string ":" (char-to-string elmo-maildir-separator))))
  62
  63 ;;; ELMO Maildir folder
  64 (eval-and-compile
  65   (luna-define-class elmo-maildir-folder
  66                      (elmo-map-folder)
  67                      (directory unread-locations
  68                                 flagged-locations
  69                                 answered-locations))
  70   (luna-define-internal-accessors 'elmo-maildir-folder))
  71
  72 (luna-define-method elmo-folder-initialize ((folder
  73                                              elmo-maildir-folder)
  74                                             name)
  75   (if (file-name-absolute-p name)
  76       (elmo-maildir-folder-set-directory-internal
  77        folder
  78        (expand-file-name name))
  79     (elmo-maildir-folder-set-directory-internal
  80      folder
  81      (expand-file-name
  82       name
  83       elmo-maildir-folder-path)))
  84   folder)
  85
  86 (luna-define-method elmo-folder-expand-msgdb-path ((folder
  87                                                     elmo-maildir-folder))
  88   (expand-file-name
  89    (elmo-replace-string-as-filename
  90     (elmo-maildir-folder-directory-internal folder))
  91    (expand-file-name
  92     "maildir"
  93     elmo-msgdb-directory)))
  94
  95 (defun elmo-maildir-message-file-name (folder location)
  96   "Get a file name of the message from FOLDER which corresponded to
  97 LOCATION."
  98   (let ((file (file-name-completion
  99                location
 100                (expand-file-name
 101                 "cur"
 102                 (elmo-maildir-folder-directory-internal folder)))))
 103     (if file
 104         (expand-file-name
 105          (if (eq file t) location file)
 106          (expand-file-name
 107           "cur"
 108           (elmo-maildir-folder-directory-internal folder))))))
 109
 110 (defsubst elmo-maildir-list-location (dir &optional child-dir)
 111   (let* ((cur-dir (expand-file-name (or child-dir "cur") dir))
 112          (cur (directory-files cur-dir
 113                                nil "^[^.].*$" t))
 114          unread-locations flagged-locations answered-locations
 115          sym locations flag-list)
 116     (setq locations
 117           (mapcar
 118            (lambda (x)
 119              (if (string-match
 120                   (elmo-maildir-adjust-separator "^\\([^:]+\\):\\([^:]+\\)$")
 121                   x)
 122                  (progn
 123                    (setq sym (elmo-match-string 1 x)
 124                          flag-list (string-to-char-list
 125                                     (elmo-match-string 2 x)))
 126                    (when (memq ?F flag-list)
 127                      (setq flagged-locations
 128                            (cons sym flagged-locations)))
 129                    (when (memq ?R flag-list)
 130                      (setq answered-locations
 131                            (cons sym answered-locations)))
 132                    (unless (memq ?S flag-list)
 133                      (setq unread-locations
 134                            (cons sym unread-locations)))
 135                    sym)
 136                x))
 137            cur))
 138     (list locations unread-locations flagged-locations answered-locations)))
 139
 140 (luna-define-method elmo-map-folder-list-message-locations
 141   ((folder elmo-maildir-folder))
 142   (elmo-maildir-update-current folder)
 143   (let ((locs (elmo-maildir-list-location
 144                (elmo-maildir-folder-directory-internal folder))))
 145     ;; 0: locations, 1: unread-locs, 2: flagged-locs 3: answered-locs
 146     (elmo-maildir-folder-set-unread-locations-internal folder (nth 1 locs))
 147     (elmo-maildir-folder-set-flagged-locations-internal folder (nth 2 locs))
 148     (elmo-maildir-folder-set-answered-locations-internal folder (nth 3 locs))
 149     (nth 0 locs)))
 150
 151 (luna-define-method elmo-map-folder-list-flagged ((folder elmo-maildir-folder)
 152                                                   flag)
 153   (case flag
 154     (unread
 155      (elmo-maildir-folder-unread-locations-internal folder))
 156     (important
 157      (elmo-maildir-folder-flagged-locations-internal folder))
 158     (answered
 159      (elmo-maildir-folder-answered-locations-internal folder))
 160     (otherwise
 161      t)))
 162
 163 (luna-define-method elmo-folder-msgdb-create ((folder elmo-maildir-folder)
 164                                               numbers flag-table)
 165   (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
 166          (flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
 167          (answered-list (elmo-maildir-folder-answered-locations-internal
 168                          folder))
 169          (len (length numbers))
 170          (new-msgdb (elmo-make-msgdb))
 171          (i 0)
 172          entity message-id flags location)
 173     (message "Creating msgdb...")
 174     (dolist (number numbers)
 175       (setq location (elmo-map-message-location folder number))
 176       (setq entity
 177             (elmo-msgdb-create-message-entity-from-file
 178              (elmo-msgdb-message-entity-handler new-msgdb)
 179              number
 180              (elmo-maildir-message-file-name folder location)))
 181       (when entity
 182         (setq message-id (elmo-message-entity-field entity 'message-id)
 183               ;; Precede flag-table to file-info.
 184               flags (copy-sequence
 185                      (elmo-flag-table-get flag-table message-id)))
 186
 187         ;; Already flagged on filename (precede it to flag-table).
 188         (when (member location flagged-list)
 189           (or (memq 'important flags)
 190               (setq flags (cons 'important flags))))
 191         (when (member location answered-list)
 192           (or (memq 'answered flags)
 193               (setq flags (cons 'answered flags))))
 194         (unless (member location unread-list)
 195           (and (memq 'unread flags)
 196                (setq flags (delq 'unread flags))))
 197
 198         ;; Update filename's info portion according to the flag-table.
 199         (when (and (memq 'important flags)
 200                    (not (member location flagged-list)))
 201           (elmo-maildir-set-mark
 202            (elmo-maildir-message-file-name folder location)
 203            ?F)
 204           ;; Append to flagged location list.
 205           (elmo-maildir-folder-set-flagged-locations-internal
 206            folder
 207            (cons location
 208                  (elmo-maildir-folder-flagged-locations-internal
 209                   folder)))
 210           (setq flags (delq 'unread flags)))
 211         (when (and (memq 'answered flags)
 212                    (not (member location answered-list)))
 213           (elmo-maildir-set-mark
 214            (elmo-maildir-message-file-name folder location)
 215            ?R)
 216           ;; Append to answered location list.
 217           (elmo-maildir-folder-set-answered-locations-internal
 218            folder
 219            (cons location
 220                  (elmo-maildir-folder-answered-locations-internal folder)))
 221           (setq flags (delq 'unread flags)))
 222         (when (and (not (memq 'unread flags))
 223                    (member location unread-list))
 224           (elmo-maildir-set-mark
 225            (elmo-maildir-message-file-name folder location)
 226            ?S)
 227           ;; Delete from unread locations.
 228           (elmo-maildir-folder-set-unread-locations-internal
 229            folder
 230            (delete location
 231                    (elmo-maildir-folder-unread-locations-internal
 232                     folder))))
 233         (unless (memq 'unread flags)
 234           (setq flags (delq 'new flags)))
 235         (elmo-global-flags-set flags folder number message-id)
 236         (elmo-msgdb-append-entity new-msgdb entity flags)
 237         (when (> len elmo-display-progress-threshold)
 238           (setq i (1+ i))
 239           (elmo-display-progress
 240            'elmo-maildir-msgdb-create "Creating msgdb..."
 241            (/ (* i 100) len)))))
 242     (message "Creating msgdb...done")
 243     (elmo-msgdb-sort-by-date new-msgdb)))
 244
 245 (defun elmo-maildir-cleanup-temporal (dir)
 246   ;; Delete files in the tmp dir which are not accessed
 247   ;; for more than 36 hours.
 248   (let ((cur-time (current-time))
 249         (count 0)
 250         last-accessed)
 251     (mapcar (function
 252              (lambda (file)
 253                (setq last-accessed (nth 4 (file-attributes file)))
 254                (when (or (> (- (car cur-time)(car last-accessed)) 1)
 255                          (and (eq (- (car cur-time)(car last-accessed)) 1)
 256                               (> (- (cadr cur-time)(cadr last-accessed))
 257                                  64064))) ; 36 hours.
 258                  (message "Maildir: %d tmp file(s) are cleared."
 259                           (setq count (1+ count)))
 260                  (delete-file file))))
 261             (directory-files (expand-file-name "tmp" dir)
 262                              t ; full
 263                              "^[^.].*$" t))))
 264
 265 (defun elmo-maildir-update-current (folder)
 266   "Move all new msgs to cur in the maildir."
 267   (let* ((maildir (elmo-maildir-folder-directory-internal folder))
 268          (news (directory-files (expand-file-name "new"
 269                                                   maildir)
 270                                 nil
 271                                 "^[^.].*$" t)))
 272     ;; cleanup tmp directory.
 273     (elmo-maildir-cleanup-temporal maildir)
 274     ;; move new msgs to cur directory.
 275     (while news
 276       (rename-file
 277        (expand-file-name (car news) (expand-file-name "new" maildir))
 278        (expand-file-name (concat
 279                           (car news)
 280                           (unless (string-match
 281                                    (elmo-maildir-adjust-separator ":2,[A-Z]*$")
 282                                    (car news))
 283                             (elmo-maildir-adjust-separator  ":2,")))
 284                          (expand-file-name "cur" maildir)))
 285       (setq news (cdr news)))))
 286
 287 (defun elmo-maildir-set-mark (filename mark)
 288   "Mark the FILENAME file in the maildir.  MARK is a character."
 289   (if (string-match
 290        (elmo-maildir-adjust-separator "^\\([^:]+:[12],\\)\\(.*\\)$")
 291        filename)
 292       (let ((flaglist (string-to-char-list (elmo-match-string
 293                                             2 filename))))
 294         (unless (memq mark flaglist)
 295           (setq flaglist (sort (cons mark flaglist) '<))
 296           (rename-file filename
 297                        (concat (elmo-match-string 1 filename)
 298                                (char-list-to-string flaglist)))))
 299     ;; Rescue no info file in maildir.
 300     (rename-file filename
 301                  (concat filename
 302                          (elmo-maildir-adjust-separator ":2,")
 303                          (char-to-string mark))))
 304   t)
 305
 306 (defun elmo-maildir-delete-mark (filename mark)
 307   "Mark the FILENAME file in the maildir.  MARK is a character."
 308   (if (string-match (elmo-maildir-adjust-separator "^\\([^:]+:2,\\)\\(.*\\)$")
 309                     filename)
 310       (let ((flaglist (string-to-char-list (elmo-match-string
 311                                             2 filename))))
 312         (when (memq mark flaglist)
 313           (setq flaglist (delq mark flaglist))
 314           (rename-file filename
 315                        (concat (elmo-match-string 1 filename)
 316                                (if flaglist
 317                                    (char-list-to-string flaglist))))))))
 318
 319 (defsubst elmo-maildir-set-mark-msgs (folder locs mark)
 320   (dolist (loc locs)
 321     (elmo-maildir-set-mark
 322      (elmo-maildir-message-file-name folder loc)
 323      mark))
 324   t)
 325
 326 (defsubst elmo-maildir-delete-mark-msgs (folder locs mark)
 327   (dolist (loc locs)
 328     (elmo-maildir-delete-mark
 329      (elmo-maildir-message-file-name folder loc)
 330      mark))
 331   t)
 332
 333 (defsubst elmo-maildir-set-mark-messages (folder locations mark remove)
 334   (when mark
 335     (if remove
 336         (elmo-maildir-delete-mark-msgs folder locations mark)
 337       (elmo-maildir-set-mark-msgs folder locations mark))))
 338
 339 (luna-define-method elmo-map-folder-set-flag ((folder elmo-maildir-folder)
 340                                               locations flag)
 341   (let ((spec (cdr (assq flag elmo-maildir-flag-specs))))
 342     (when spec
 343       (elmo-maildir-set-mark-messages folder locations
 344                                       (car spec) (nth 1 spec)))))
 345
 346 (luna-define-method elmo-map-folder-unset-flag ((folder elmo-maildir-folder)
 347                                                 locations flag)
 348   (let ((spec (cdr (assq flag elmo-maildir-flag-specs))))
 349     (when spec
 350       (elmo-maildir-set-mark-messages folder locations
 351                                       (car spec) (not (nth 1 spec))))))
 352
 353 (luna-define-method elmo-folder-list-subfolders
 354   ((folder elmo-maildir-folder) &optional one-level)
 355   (let ((prefix (concat (elmo-folder-name-internal folder)
 356                         (unless (string= (elmo-folder-prefix-internal folder)
 357                                          (elmo-folder-name-internal folder))
 358                           elmo-path-sep)))
 359         (elmo-list-subdirectories-ignore-regexp
 360          "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$")
 361         elmo-have-link-count)
 362     (append
 363      (list (elmo-folder-name-internal folder))
 364      (elmo-mapcar-list-of-list
 365       (function (lambda (x) (concat prefix x)))
 366       (elmo-list-subdirectories
 367        (elmo-maildir-folder-directory-internal folder)
 368        ""
 369        one-level)))))
 370
 371 (defvar elmo-maildir-sequence-number-internal 0)
 372
 373 (static-cond
 374  ((>= emacs-major-version 19)
 375   (defun elmo-maildir-make-unique-string ()
 376     "This function generates a string that can be used as a unique
 377 file name for maildir directories."
 378      (let ((cur-time (current-time)))
 379        (format "%.0f.%d_%d.%s"
 380               (+ (* (car cur-time)
 381                     (float 65536)) (cadr cur-time))
 382               (emacs-pid)
 383               (incf elmo-maildir-sequence-number-internal)
 384               (system-name)))))
 385  ((eq emacs-major-version 18)
 386   ;; A fake function for v18
 387   (defun elmo-maildir-make-unique-string ()
 388     "This function generates a string that can be used as a unique
 389 file name for maildir directories."
 390     (unless (fboundp 'float-to-string)
 391       (load-library "float"))
 392     (let ((time (current-time)))
 393       (format "%s%d.%d.%s"
 394               (substring
 395                (float-to-string
 396                 (f+ (f* (f (car time))
 397                         (f 65536))
 398                     (f (cadr time))))
 399                0 5)
 400               (cadr time)
 401               (% (abs (random t)) 10000); dummy pid
 402               (system-name))))))
 403
 404 (defun elmo-maildir-temporal-filename (basedir)
 405   (let ((filename (expand-file-name
 406                    (concat "tmp/" (elmo-maildir-make-unique-string))
 407                    basedir)))
 408     (unless (file-exists-p (file-name-directory filename))
 409       (make-directory (file-name-directory filename)))
 410     (while (file-exists-p filename)
 411 ;;; I don't want to wait.
 412 ;;;   (sleep-for 2)
 413       (setq filename
 414             (expand-file-name
 415              (concat "tmp/" (elmo-maildir-make-unique-string))
 416              basedir)))
 417     filename))
 418
 419 (defun elmo-maildir-move-file (src dst)
 420   (or (and (fboundp 'make-symbolic-link)
 421            ;; 1. If make-symbolic-link is defined, then assume the system has
 422            ;;    hardlinks and try add-link-to-file, then delete the original.
 423            ;;    This is safe on NFS.
 424            (condition-case nil
 425                (progn
 426                  (add-name-to-file src dst)
 427                  t)
 428              (error))
 429            ;; It's ok if the delete-file fails;
 430            ;; elmo-maildir-cleanup-temporal will catch it later.
 431            (progn
 432              (condition-case nil
 433                  (delete-file src)
 434                (error))
 435              ;; Exit this function anyway.
 436              t))
 437       ;; 2. Even on systems with hardlinks, some filesystems (like AFS)
 438       ;;    might not support them, so fall back on rename-file. This is
 439       ;;    our best shot at atomic when add-name-to-file fails.
 440       (rename-file src dst)))
 441
 442 (luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder)
 443                                                &optional flags number)
 444   (let ((basedir (elmo-maildir-folder-directory-internal folder))
 445         (src-buf (current-buffer))
 446         dst-buf filename)
 447     (condition-case nil
 448         (with-temp-buffer
 449           (setq filename (elmo-maildir-temporal-filename basedir))
 450           (setq dst-buf (current-buffer))
 451           (with-current-buffer src-buf
 452             (copy-to-buffer dst-buf (point-min) (point-max)))
 453           (as-binary-output-file
 454            (write-region (point-min) (point-max) filename nil 'no-msg))
 455           (elmo-maildir-move-file
 456            filename
 457            (expand-file-name
 458             (concat "new/" (file-name-nondirectory filename))
 459             basedir))
 460           (elmo-folder-preserve-flags
 461            folder (elmo-msgdb-get-message-id-from-buffer) flags)
 462           t)
 463       ;; If an error occured, return nil.
 464       (error))))
 465
 466 (luna-define-method elmo-folder-message-file-p ((folder elmo-maildir-folder))
 467   t)
 468
 469 (luna-define-method elmo-message-file-name ((folder elmo-maildir-folder)
 470                                             number)
 471   (elmo-maildir-message-file-name
 472    folder
 473    (elmo-map-message-location folder number)))
 474
 475 (luna-define-method elmo-folder-message-make-temp-file-p
 476   ((folder elmo-maildir-folder))
 477   t)
 478
 479 (luna-define-method elmo-folder-message-make-temp-files ((folder
 480                                                           elmo-maildir-folder)
 481                                                          numbers
 482                                                          &optional
 483                                                          start-number)
 484   (let ((temp-dir (elmo-folder-make-temporary-directory folder))
 485         (cur-number (if start-number 0)))
 486     (dolist (number numbers)
 487       (elmo-copy-file
 488        (elmo-message-file-name folder number)
 489        (expand-file-name
 490         (int-to-string (if start-number (incf cur-number) number))
 491         temp-dir)))
 492     temp-dir))
 493
 494 (luna-define-method elmo-folder-append-messages :around
 495   ((folder elmo-maildir-folder)
 496    src-folder numbers &optional same-number)
 497   (if (elmo-folder-message-file-p src-folder)
 498       (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
 499             (dir (elmo-maildir-folder-directory-internal folder))
 500             (table (elmo-folder-flag-table folder))
 501             (succeeds numbers)
 502             filename flags id)
 503         (dolist (number numbers)
 504           (setq flags (elmo-message-flags src-folder (car numbers))
 505                 filename (elmo-maildir-temporal-filename dir))
 506           (elmo-copy-file
 507            (elmo-message-file-name src-folder number)
 508            filename)
 509           (elmo-maildir-move-file
 510            filename
 511            (expand-file-name
 512             (concat "new/" (file-name-nondirectory filename))
 513             dir))
 514           ;; src folder's msgdb is loaded.
 515           (when (setq id (and src-msgdb-exists
 516                               (elmo-message-field src-folder (car numbers)
 517                                                   'message-id)))
 518             (elmo-flag-table-set table id flags))
 519           (elmo-progress-notify 'elmo-folder-move-messages))
 520         (when (elmo-folder-persistent-p folder)
 521           (elmo-folder-close-flag-table folder))
 522         succeeds)
 523     (luna-call-next-method)))
 524
 525 (luna-define-method elmo-map-folder-delete-messages
 526   ((folder elmo-maildir-folder) locations)
 527   (let (file)
 528     (dolist (location locations)
 529       (setq file (elmo-maildir-message-file-name folder location))
 530       (if (and file
 531                (file-writable-p file)
 532                (not (file-directory-p file)))
 533           (delete-file file))))
 534   t)
 535
 536 (luna-define-method elmo-map-message-fetch ((folder elmo-maildir-folder)
 537                                             location strategy
 538                                             &optional section unseen)
 539   (let ((file (elmo-maildir-message-file-name folder location)))
 540     (when (file-exists-p file)
 541       (insert-file-contents-as-binary file)
 542       (unless unseen
 543         (elmo-map-folder-set-flag folder (list location) 'read))
 544       t)))
 545
 546 (luna-define-method elmo-folder-exists-p ((folder elmo-maildir-folder))
 547   (let ((basedir (elmo-maildir-folder-directory-internal folder)))
 548     (and (file-directory-p (expand-file-name "new" basedir))
 549          (file-directory-p (expand-file-name "cur" basedir))
 550          (file-directory-p (expand-file-name "tmp" basedir)))))
 551
 552 (luna-define-method elmo-folder-diff ((folder elmo-maildir-folder))
 553   (let* ((dir (elmo-maildir-folder-directory-internal folder))
 554          (new-len (length (car (elmo-maildir-list-location dir "new"))))
 555          (cur-len (length (car (elmo-maildir-list-location dir "cur")))))
 556     (cons new-len (+ new-len cur-len))))
 557
 558 (luna-define-method elmo-folder-creatable-p ((folder elmo-maildir-folder))
 559   t)
 560
 561 (luna-define-method elmo-folder-writable-p ((folder elmo-maildir-folder))
 562   t)
 563
 564 (luna-define-method elmo-folder-create ((folder elmo-maildir-folder))
 565   (let ((basedir (elmo-maildir-folder-directory-internal folder)))
 566     (condition-case nil
 567         (progn
 568           (dolist (dir '("." "new" "cur" "tmp"))
 569             (setq dir (expand-file-name dir basedir))
 570             (or (file-directory-p dir)
 571                 (progn
 572                   (elmo-make-directory dir)
 573                   (set-file-modes dir 448))))
 574           t)
 575       (error))))
 576
 577 (luna-define-method elmo-folder-delete ((folder elmo-maildir-folder))
 578   (let ((msgs (and (elmo-folder-exists-p folder)
 579                    (elmo-folder-list-messages folder))))
 580     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
 581                                (if (> (length msgs) 0)
 582                                    (format "%d msg(s) exists. " (length msgs))
 583                                  "")
 584                                (elmo-folder-name-internal folder)))
 585       (let ((basedir (elmo-maildir-folder-directory-internal folder)))
 586         (condition-case nil
 587             (let ((tmp-files (directory-files
 588                               (expand-file-name "tmp" basedir)
 589                               t "[^.].*")))
 590               ;; Delete files in tmp.
 591               (dolist (file tmp-files)
 592                 (delete-file file))
 593               (dolist (dir '("new" "cur" "tmp" "."))
 594                 (setq dir (expand-file-name dir basedir))
 595                 (if (not (file-directory-p dir))
 596                     (error nil)
 597                   (elmo-delete-directory dir t))))
 598           (error nil)))
 599       (elmo-msgdb-delete-path folder)
 600       t)))
 601
 602 (luna-define-method elmo-folder-rename-internal ((folder elmo-maildir-folder)
 603                                                  new-folder)
 604   (let* ((old (elmo-maildir-folder-directory-internal folder))
 605          (new (elmo-maildir-folder-directory-internal new-folder))
 606          (new-dir (directory-file-name (file-name-directory new))))
 607     (unless (file-directory-p old)
 608       (error "No such directory: %s" old))
 609     (when (file-exists-p new)
 610       (error "Already exists directory: %s" new))
 611     (unless (file-directory-p new-dir)
 612       (elmo-make-directory new-dir))
 613     (rename-file old new)
 614     t))
 615
 616 (require 'product)
 617 (product-provide (provide 'elmo-maildir) (require 'elmo-version))
 618
 619 ;;; elmo-maildir.el ends here