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