elmo/elmo-maildir.el

   1 ;;; elmo-maildir.el -- Maildir interface for ELMO.
   2
   3 ;; Copyright 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 (require 'elmo-util)
  34 (require 'elmo-localdir)
  35
  36 (defvar elmo-maildir-sequence-number-internal 0
  37   "Sequence number for the pid part of unique filename.
  38 This variable should not be used in elsewhere.")
  39
  40 (defsubst elmo-maildir-get-folder-directory (spec)
  41   (if (file-name-absolute-p (nth 1 spec))
  42       (nth 1 spec) ; already full path.
  43     (expand-file-name (nth 1 spec)
  44                       elmo-maildir-folder-path)))
  45
  46 (defun elmo-maildir-number-to-filename (dir number loc-alist)
  47   (let ((location (cdr (assq number loc-alist))))
  48     (and location (elmo-maildir-get-filename location dir))))
  49
  50 (defun elmo-maildir-get-filename (location dir)
  51   "Get a filename that is corresponded to LOCATION in DIR."
  52   (expand-file-name
  53    (let ((file (file-name-completion (symbol-name location)
  54                                      (expand-file-name "cur" dir))))
  55      (if (eq file t) (symbol-name location) file))
  56    (expand-file-name "cur" dir)))
  57
  58 (defsubst elmo-maildir-list-location (dir &optional child-dir)
  59   (let* ((cur-dir (expand-file-name (or child-dir "cur") dir))
  60          (cur (directory-files cur-dir
  61                                nil "^[^.].*$" t))
  62          seen-list seen sym list)
  63     (setq list
  64           (mapcar
  65            (lambda (x)
  66              (if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
  67                  (progn
  68                    (setq seen nil)
  69                    (save-match-data
  70                      (if (string-match
  71                           "S"
  72                           (elmo-match-string 2 x))
  73                          (setq seen t)))
  74                    (setq sym (intern (elmo-match-string 1 x)))
  75                    (if seen
  76                        (setq seen-list (cons sym seen-list)))
  77                    sym)
  78                (intern x)))
  79            cur))
  80     (cons list seen-list)))
  81
  82 (defun elmo-maildir-msgdb-create-entity (dir number loc-alist)
  83   (elmo-localdir-msgdb-create-overview-entity-from-file
  84    number
  85    (elmo-maildir-number-to-filename dir number loc-alist)))
  86
  87 (defun elmo-maildir-cleanup-temporal (dir)
  88   ;; Delete files in the tmp dir which are not accessed
  89   ;; for more than 36 hours.
  90   (let ((cur-time (current-time))
  91         (count 0)
  92         last-accessed)
  93     (mapcar (function
  94              (lambda (file)
  95                (setq last-accessed (nth 4 (file-attributes file)))
  96                (when (or (> (- (car cur-time)(car last-accessed)) 1)
  97                          (and (eq (- (car cur-time)(car last-accessed)) 1)
  98                               (> (- (cadr cur-time)(cadr last-accessed))
  99                                  64064))) ; 36 hours.
 100                  (message "Maildir: %d tmp file(s) are cleared."
 101                           (setq count (1+ count)))
 102                  (delete-file file))))
 103             (directory-files (expand-file-name "tmp" dir)
 104                              t ; full
 105                              "^[^.].*$" t))))
 106
 107 (defun elmo-maildir-update-current (spec)
 108   "Move all new msgs to cur in the maildir."
 109   (let* ((maildir (elmo-maildir-get-folder-directory spec))
 110          (news (directory-files (expand-file-name "new"
 111                                                   maildir)
 112                                 nil
 113                                 "^[^.].*$" t)))
 114     ;; cleanup tmp directory.
 115     (elmo-maildir-cleanup-temporal maildir)
 116     ;; move new msgs to cur directory.
 117     (while news
 118       (rename-file
 119        (expand-file-name (car news) (expand-file-name "new" maildir))
 120        (expand-file-name (concat (car news) ":2,")
 121                          (expand-file-name "cur" maildir)))
 122       (setq news (cdr news)))))
 123
 124 (defun elmo-maildir-set-mark (filename mark)
 125   "Mark the FILENAME file in the maildir.  MARK is a character."
 126   (if (string-match "^\\([^:]+:[12],\\)\\(.*\\)$" filename)
 127       (let ((flaglist (string-to-char-list (elmo-match-string
 128                                             2 filename))))
 129         (unless (memq mark flaglist)
 130           (setq flaglist (sort (cons mark flaglist) '<))
 131           (rename-file filename
 132                        (concat (elmo-match-string 1 filename)
 133                                (char-list-to-string flaglist)))))
 134     ;; Rescue no info file in maildir.
 135     (rename-file filename
 136                  (concat filename ":2," (char-to-string mark)))))
 137
 138 (defun elmo-maildir-delete-mark (filename mark)
 139   "Mark the FILENAME file in the maildir.  MARK is a character."
 140   (if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
 141       (let ((flaglist (string-to-char-list (elmo-match-string
 142                                             2 filename))))
 143         (when (memq mark flaglist)
 144           (setq flaglist (delq mark flaglist))
 145           (rename-file filename
 146                        (concat (elmo-match-string 1 filename)
 147                                (if flaglist
 148                                    (char-list-to-string flaglist))))))))
 149
 150 (defsubst elmo-maildir-set-mark-msgs (spec mark msgs msgdb)
 151   (let ((dir (elmo-maildir-get-folder-directory spec))
 152         (locs (if msgdb
 153                   (elmo-msgdb-get-location msgdb)
 154                 (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
 155         file)
 156     (while msgs
 157       (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
 158           (elmo-maildir-set-mark file mark))
 159       (setq msgs (cdr msgs)))))
 160
 161 (defsubst elmo-maildir-delete-mark-msgs (spec mark msgs msgdb)
 162   (let ((dir (elmo-maildir-get-folder-directory spec))
 163         (locs (if msgdb
 164                   (elmo-msgdb-get-location msgdb)
 165                 (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
 166         file)
 167     (while msgs
 168       (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
 169           (elmo-maildir-delete-mark file mark))
 170       (setq msgs (cdr msgs)))))
 171
 172 (defun elmo-maildir-mark-as-important (spec msgs &optional msgdb)
 173   (elmo-maildir-set-mark-msgs spec ?F msgs msgdb))
 174
 175 (defun elmo-maildir-unmark-important (spec msgs &optional msgdb)
 176   (elmo-maildir-delete-mark-msgs spec ?F msgs msgdb))
 177
 178 (defun elmo-maildir-mark-as-read (spec msgs &optional msgdb)
 179   (elmo-maildir-set-mark-msgs spec ?S msgs msgdb))
 180
 181 (defun elmo-maildir-mark-as-unread (spec msgs &optional msgdb)
 182   (elmo-maildir-delete-mark-msgs spec ?S msgs msgdb))
 183
 184 (defun elmo-maildir-msgdb-create (spec numlist new-mark
 185                                        already-mark seen-mark
 186                                        important-mark
 187                                        seen-list
 188                                        &optional msgdb)
 189   (when numlist
 190     (let* ((dir (elmo-maildir-get-folder-directory spec))
 191            (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 192                         (elmo-msgdb-location-load (elmo-msgdb-expand-path
 193                                                    spec))))
 194            (loc-seen (elmo-maildir-list-location dir))
 195            (loc-list  (car loc-seen))
 196            (seen-list (cdr loc-seen))
 197            overview number-alist mark-alist entity
 198            i percent num location pair)
 199       (setq num (length numlist))
 200       (setq i 0)
 201       (message "Creating msgdb...")
 202       (while numlist
 203         (setq entity
 204               (elmo-maildir-msgdb-create-entity
 205                dir (car numlist) loc-alist))
 206         (if (null entity)
 207             ()
 208           (setq overview
 209                 (elmo-msgdb-append-element
 210                  overview entity))
 211           (setq number-alist
 212                 (elmo-msgdb-number-add number-alist
 213                                        (elmo-msgdb-overview-entity-get-number
 214                                         entity)
 215                                        (elmo-msgdb-overview-entity-get-id
 216                                         entity)))
 217           (setq location (cdr (assq (car numlist) loc-alist)))
 218           (unless (member location seen-list)
 219             (setq mark-alist
 220                   (elmo-msgdb-mark-append
 221                    mark-alist
 222                    (elmo-msgdb-overview-entity-get-number
 223                     entity)
 224                    (or (elmo-msgdb-global-mark-get
 225                         (elmo-msgdb-overview-entity-get-id
 226                          entity))
 227                        new-mark)))))
 228         (when (> num elmo-display-progress-threshold)
 229           (setq i (1+ i))
 230           (setq percent (/ (* i 100) num))
 231           (elmo-display-progress
 232            'elmo-maildir-msgdb-create "Creating msgdb..."
 233            percent))
 234         (setq numlist (cdr numlist)))
 235       (message "Creating msgdb...done")
 236       (elmo-msgdb-sort-by-date
 237        (list overview number-alist mark-alist loc-alist)))))
 238
 239 (defalias 'elmo-maildir-msgdb-create-as-numlist 'elmo-maildir-msgdb-create)
 240
 241 (defun elmo-maildir-list-folders (spec &optional hierarchy)
 242   (let ((elmo-localdir-folder-path elmo-maildir-folder-path)
 243         (elmo-localdir-list-folders-spec-string ".")
 244         (elmo-localdir-list-folders-filter-regexp
 245          "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$")
 246         elmo-have-link-count folders)
 247     (setq folders (elmo-localdir-list-folders spec hierarchy))
 248     (if (eq (length (nth 1 spec)) 0) ; top
 249         (setq folders (append
 250                        (list (concat elmo-localdir-list-folders-spec-string
 251                                      (nth 1 spec)))
 252                        folders)))
 253     (elmo-delete-if
 254      (function (lambda (folder)
 255                  (not (or (listp folder) (elmo-folder-exists-p folder)))))
 256      folders)))
 257
 258 (static-cond
 259  ((>= emacs-major-version 19)
 260   (defun elmo-maildir-make-unique-string ()
 261     "This function generates a string that can be used as a unique
 262 file name for maildir directories."
 263      (let ((cur-time (current-time)))
 264        (format "%.0f.%d_%d.%s"
 265               (+ (* (car cur-time)
 266                     (float 65536)) (cadr cur-time))
 267               (emacs-pid)
 268               (incf elmo-maildir-sequence-number-internal)
 269               (system-name)))))
 270  ((eq emacs-major-version 18)
 271   ;; A fake function for v18
 272   (defun elmo-maildir-make-unique-string ()
 273     "This function generates a string that can be used as a unique
 274 file name for maildir directories."
 275     (unless (fboundp 'float-to-string)
 276       (load-library "float"))
 277     (let ((time (current-time)))
 278       (format "%s%d.%d.%s"
 279               (substring
 280                (float-to-string
 281                 (f+ (f* (f (car time))
 282                         (f 65536))
 283                     (f (cadr time))))
 284                0 5)
 285               (cadr time)
 286               (% (abs (random t)) 10000); dummy pid
 287               (system-name))))))
 288
 289 (defun elmo-maildir-temporal-filename (basedir)
 290   (let ((filename (expand-file-name
 291                    (concat "tmp/" (elmo-maildir-make-unique-string))
 292                    basedir)))
 293     (unless (file-exists-p (file-name-directory filename))
 294       (make-directory (file-name-directory filename)))
 295     (while (file-exists-p filename)
 296 ;;; I don't want to wait.
 297 ;;;   (sleep-for 2)
 298       (setq filename
 299             (expand-file-name
 300              (concat "tmp/" (elmo-maildir-make-unique-string))
 301              basedir)))
 302     filename))
 303
 304 (defun elmo-maildir-append-msg (spec string &optional msg no-see)
 305   (let ((basedir (elmo-maildir-get-folder-directory spec))
 306         filename)
 307     (condition-case nil
 308         (with-temp-buffer
 309           (setq filename (elmo-maildir-temporal-filename basedir))
 310           (insert string)
 311           (as-binary-output-file
 312            (write-region (point-min) (point-max) filename nil 'no-msg))
 313           ;; add link from new.
 314           (elmo-add-name-to-file
 315            filename
 316            (expand-file-name
 317             (concat "new/" (file-name-nondirectory filename))
 318             basedir))
 319           t)
 320       ;; If an error occured, return nil.
 321       (error))))
 322
 323 (defun elmo-maildir-delete-msg (spec number loc-alist)
 324   (let ((dir (elmo-maildir-get-folder-directory spec))
 325         file)
 326     (setq file (elmo-maildir-number-to-filename dir number loc-alist))
 327     (if (and (file-writable-p file)
 328              (not (file-directory-p file)))
 329         (progn (delete-file file)
 330                t))))
 331
 332 (defun elmo-maildir-read-msg (spec number outbuf &optional msgdb)
 333   (save-excursion
 334     (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 335                         (elmo-msgdb-location-load (elmo-msgdb-expand-path
 336                                                    spec))))
 337            (dir (elmo-maildir-get-folder-directory spec))
 338            (file (elmo-maildir-number-to-filename dir number loc-alist)))
 339       (set-buffer outbuf)
 340       (erase-buffer)
 341       (when (file-exists-p file)
 342         (as-binary-input-file (insert-file-contents file))
 343         (elmo-delete-cr-get-content-type)))))
 344
 345 (defun elmo-maildir-delete-msgs (spec msgs &optional msgdb)
 346   (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 347                      (elmo-msgdb-location-load (elmo-msgdb-expand-path
 348                                                 spec)))))
 349     (mapcar '(lambda (msg) (elmo-maildir-delete-msg spec msg
 350                                                     loc-alist))
 351             msgs)))
 352
 353 (defsubst elmo-maildir-list-folder-subr (spec &optional nonsort)
 354   (let* ((dir (elmo-maildir-get-folder-directory spec))
 355          (flist (elmo-list-folder-by-location
 356                  spec
 357                  (car (elmo-maildir-list-location dir))))
 358          (killed (and elmo-use-killed-list
 359                       (elmo-msgdb-killed-list-load
 360                        (elmo-msgdb-expand-path spec))))
 361          (news (car (elmo-maildir-list-location dir "new")))
 362          numbers)
 363     (if nonsort
 364         (cons (+ (or (elmo-max-of-list flist) 0) (length news))
 365               (+ (length news)
 366                  (if killed
 367                      (- (length flist)
 368                         (elmo-msgdb-killed-list-length killed))
 369                    (length flist))))
 370       (setq numbers (sort flist '<))
 371       (elmo-living-messages numbers killed))))
 372
 373 (defun elmo-maildir-list-folder (spec)
 374   (elmo-maildir-update-current spec)
 375   (elmo-maildir-list-folder-subr spec))
 376
 377 (defun elmo-maildir-max-of-folder (spec)
 378   (elmo-maildir-list-folder-subr spec t))
 379
 380 (defalias 'elmo-maildir-check-validity 'elmo-localdir-check-validity)
 381
 382 (defalias 'elmo-maildir-sync-validity  'elmo-localdir-sync-validity)
 383
 384 (defun elmo-maildir-folder-exists-p (spec)
 385   (let ((basedir (elmo-maildir-get-folder-directory spec)))
 386     (and (file-directory-p (expand-file-name "new" basedir))
 387          (file-directory-p (expand-file-name "cur" basedir))
 388          (file-directory-p (expand-file-name "tmp" basedir)))))
 389
 390 (defun elmo-maildir-folder-creatable-p (spec)
 391   t)
 392
 393 (defun elmo-maildir-create-folder (spec)
 394   (let ((basedir (elmo-maildir-get-folder-directory spec)))
 395     (condition-case nil
 396         (progn
 397           (mapcar (function (lambda (dir)
 398                               (setq dir (expand-file-name dir basedir))
 399                               (or (file-directory-p dir)
 400                                   (progn
 401                                     (elmo-make-directory dir)
 402                                     (set-file-modes dir 448)))))
 403                   '("." "new" "cur" "tmp"))
 404           t)
 405       (error))))
 406
 407 (defun elmo-maildir-delete-folder (spec)
 408   (let ((basedir (elmo-maildir-get-folder-directory spec)))
 409     (condition-case nil
 410         (let ((tmp-files (directory-files
 411                           (expand-file-name "tmp" basedir)
 412                           t "[^.].*")))
 413           ;; Delete files in tmp.
 414           (and tmp-files (mapcar 'delete-file tmp-files))
 415           (mapcar
 416            (function
 417             (lambda (dir)
 418               (setq dir (expand-file-name dir basedir))
 419               (if (not (file-directory-p dir))
 420                   (error nil)
 421                 (elmo-delete-directory dir t))))
 422            '("new" "cur" "tmp" "."))
 423           t)
 424       (error nil))))
 425
 426 (defun elmo-maildir-search (spec condition &optional from-msgs msgdb)
 427   (save-excursion
 428     (let* ((msgs (or from-msgs (elmo-maildir-list-folder spec)))
 429            (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 430                         (elmo-msgdb-location-load (elmo-msgdb-expand-path
 431                                                    spec))))
 432            (dir (elmo-maildir-get-folder-directory spec))
 433            (i 0)
 434            case-fold-search ret-val
 435            percent num
 436            (num (length msgs))
 437            number-list msg-num)
 438       (setq number-list msgs)
 439       (while msgs
 440         (setq msg-num (car msgs))
 441         (if (elmo-file-field-condition-match
 442              (elmo-maildir-number-to-filename
 443               dir (car msgs) loc-alist)
 444              condition (car msgs) number-list)
 445             (setq ret-val (append ret-val (list msg-num))))
 446         (setq i (1+ i))
 447         (setq percent (/ (* i 100) num))
 448         (elmo-display-progress
 449          'elmo-maildir-search "Searching..."
 450          percent)
 451         (setq msgs (cdr msgs)))
 452       ret-val)))
 453
 454 ;;; (maildir) -> maildir
 455 (defun elmo-maildir-copy-msgs (dst-spec msgs src-spec
 456                                         &optional loc-alist same-number)
 457   (let (srcfile)
 458     (while msgs
 459       (setq srcfile
 460             (elmo-maildir-get-msg-filename src-spec (car msgs) loc-alist))
 461       (elmo-copy-file
 462        ;; src file
 463        srcfile
 464        ;; dst file
 465        (expand-file-name
 466         (file-name-nondirectory srcfile)
 467         (concat (elmo-maildir-get-folder-directory dst-spec) "/cur")))
 468       (setq msgs (cdr msgs))))
 469   t)
 470
 471 (defun elmo-maildir-use-cache-p (spec number)
 472   nil)
 473
 474 (defun elmo-maildir-local-file-p (spec number)
 475   t)
 476
 477 (defun elmo-maildir-get-msg-filename (spec number &optional loc-alist)
 478   (elmo-maildir-number-to-filename
 479    (elmo-maildir-get-folder-directory spec)
 480    number (or loc-alist (elmo-msgdb-location-load
 481                          (elmo-msgdb-expand-path
 482                           spec)))))
 483
 484 (defun elmo-maildir-pack-number (spec msgdb arg)
 485   (let ((old-number-alist (elmo-msgdb-get-number-alist msgdb))
 486         (old-overview (elmo-msgdb-get-overview msgdb))
 487         (old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
 488         (old-location (elmo-msgdb-get-location msgdb))
 489         old-number overview number-alist mark-alist location
 490         mark (number 1))
 491     (setq overview old-overview)
 492     (while old-overview
 493       (setq old-number
 494             (elmo-msgdb-overview-entity-get-number (car old-overview)))
 495       (elmo-msgdb-overview-entity-set-number (car old-overview) number)
 496       (setq number-alist
 497             (cons (cons number (cdr (assq old-number old-number-alist)))
 498                   number-alist))
 499       (when (setq mark (cadr (assq old-number old-mark-alist)))
 500         (setq mark-alist
 501               (elmo-msgdb-mark-append
 502                mark-alist number mark)))
 503       (setq location
 504             (cons (cons number (cdr (assq old-number old-location)))
 505                   location))
 506       (setq number (1+ number))
 507       (setq old-overview (cdr old-overview)))
 508     ;; XXX Should consider when folder is not persistent.
 509     (elmo-msgdb-location-save (elmo-msgdb-expand-path spec) location)
 510     (list overview
 511           (nreverse number-alist)
 512           (nreverse mark-alist)
 513           (nreverse location)
 514           (elmo-msgdb-make-overview-hashtb overview))))
 515
 516 (defalias 'elmo-maildir-sync-number-alist
 517   'elmo-generic-sync-number-alist)
 518 (defalias 'elmo-maildir-list-folder-unread
 519   'elmo-generic-list-folder-unread)
 520 (defalias 'elmo-maildir-list-folder-important
 521   'elmo-generic-list-folder-important)
 522 (defalias 'elmo-maildir-commit 'elmo-generic-commit)
 523 (defalias 'elmo-maildir-folder-diff 'elmo-generic-folder-diff)
 524
 525 (require 'product)
 526 (product-provide (provide 'elmo-maildir) (require 'elmo-version))
 527
 528 ;;; elmo-maildir.el ends here