elmo/elmo-localdir.el

   1 ;;; elmo-localdir.el --- Localdir Interface for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
   5 ;; Copyright (C) 1999,2000      Kenichi OKADA  <okada@opaopa.org>
   6
   7 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   8 ;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
   9 ;;      Kenichi OKADA <okada@opaopa.org>
  10 ;; Keywords: mail, net news
  11
  12 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  13
  14 ;; This program is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28 ;;
  29
  30 ;;; Commentary:
  31 ;;
  32
  33 ;;; Code:
  34 ;;
  35 (eval-when-compile (require 'cl))
  36
  37 (require 'elmo-msgdb)
  38 (require 'elmo)
  39
  40 (defcustom elmo-localdir-folder-path "~/Mail"
  41   "*Local mail directory (MH format) path."
  42   :type 'directory
  43   :group 'elmo)
  44
  45 (defvar elmo-localdir-lockfile-list nil)
  46
  47 ;;; ELMO Local directory folder
  48 (eval-and-compile
  49   (luna-define-class elmo-localdir-folder (elmo-folder)
  50                      (dir-name directory))
  51   (luna-define-internal-accessors 'elmo-localdir-folder))
  52
  53 ;;; elmo-localdir specific methods.
  54 (luna-define-generic elmo-localdir-folder-path (folder)
  55   "Return local directory path of the FOLDER.")
  56
  57 (luna-define-generic elmo-localdir-folder-name (folder name)
  58   "Return directory NAME for FOLDER.")
  59
  60 (luna-define-method elmo-localdir-folder-path ((folder elmo-localdir-folder))
  61   elmo-localdir-folder-path)
  62
  63 (luna-define-method elmo-localdir-folder-name ((folder elmo-localdir-folder)
  64                                                name)
  65   name)
  66
  67 (luna-define-method elmo-folder-initialize ((folder
  68                                              elmo-localdir-folder)
  69                                             name)
  70   (elmo-localdir-folder-set-dir-name-internal folder name)
  71   (if (file-name-absolute-p name)
  72       (elmo-localdir-folder-set-directory-internal
  73        folder
  74        (expand-file-name name))
  75     (elmo-localdir-folder-set-directory-internal
  76      folder
  77      (expand-file-name
  78       (elmo-localdir-folder-name folder name)
  79       (elmo-localdir-folder-path folder))))
  80   folder)
  81
  82 ;; open, check, commit, and close are generic.
  83
  84 (luna-define-method elmo-folder-exists-p ((folder elmo-localdir-folder))
  85   (file-directory-p (elmo-localdir-folder-directory-internal folder)))
  86
  87 (luna-define-method elmo-folder-expand-msgdb-path ((folder
  88                                                     elmo-localdir-folder))
  89   (expand-file-name
  90    (mapconcat
  91     'identity
  92     (mapcar
  93      'elmo-replace-string-as-filename
  94      (split-string
  95       (let ((dir-name (elmo-localdir-folder-dir-name-internal folder)))
  96         (if (file-name-absolute-p dir-name)
  97             (expand-file-name dir-name)
  98           dir-name))
  99       "/"))
 100     "/")
 101    (expand-file-name ;;"localdir"
 102     (symbol-name (elmo-folder-type-internal folder))
 103     elmo-msgdb-directory)))
 104
 105 (luna-define-method elmo-message-file-name ((folder
 106                                              elmo-localdir-folder)
 107                                             number)
 108   (expand-file-name (int-to-string number)
 109                     (elmo-localdir-folder-directory-internal folder)))
 110
 111 (luna-define-method elmo-folder-message-file-number-p ((folder
 112                                                         elmo-localdir-folder))
 113   t)
 114
 115 (luna-define-method elmo-folder-message-file-directory ((folder
 116                                                          elmo-localdir-folder))
 117   (elmo-localdir-folder-directory-internal folder))
 118
 119 (luna-define-method elmo-folder-message-make-temp-file-p
 120   ((folder elmo-localdir-folder))
 121   t)
 122
 123 (luna-define-method elmo-folder-message-make-temp-files ((folder
 124                                                           elmo-localdir-folder)
 125                                                          numbers
 126                                                          &optional
 127                                                          start-number)
 128   (let ((temp-dir (elmo-folder-make-temporary-directory folder))
 129         (cur-number (or start-number 0)))
 130     (dolist (number numbers)
 131       (elmo-copy-file
 132        (expand-file-name
 133         (int-to-string number)
 134         (elmo-localdir-folder-directory-internal folder))
 135        (expand-file-name
 136         (int-to-string (if start-number cur-number number))
 137         temp-dir))
 138       (incf cur-number))
 139     temp-dir))
 140
 141 (defun elmo-localdir-msgdb-create-entity (dir number)
 142   (elmo-msgdb-create-overview-entity-from-file
 143    number (expand-file-name (int-to-string number) dir)))
 144
 145 (luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
 146                                               numbers
 147                                               flag-table)
 148   (when numbers
 149     (let ((dir (elmo-localdir-folder-directory-internal folder))
 150           overview number-alist mark-alist entity message-id
 151           num gmark
 152           (i 0)
 153           (len (length numbers)))
 154       (message "Creating msgdb...")
 155       (while numbers
 156         (setq entity
 157               (elmo-localdir-msgdb-create-entity
 158                dir (car numbers)))
 159         (if (null entity)
 160             ()
 161           (setq num (elmo-msgdb-overview-entity-get-number entity))
 162           (setq overview
 163                 (elmo-msgdb-append-element
 164                  overview entity))
 165           (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 166           (setq number-alist
 167                 (elmo-msgdb-number-add number-alist
 168                                        num
 169                                        message-id))
 170           (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 171                               (elmo-msgdb-mark
 172                                (elmo-flag-table-get flag-table message-id)
 173                                (elmo-file-cache-status
 174                                 (elmo-file-cache-get message-id))
 175                                'new)))
 176               (setq mark-alist
 177                     (elmo-msgdb-mark-append
 178                      mark-alist
 179                      num
 180                      gmark))))
 181         (when (> len elmo-display-progress-threshold)
 182           (setq i (1+ i))
 183           (elmo-display-progress
 184            'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..."
 185            (/ (* i 100) len)))
 186         (setq numbers (cdr numbers)))
 187       (message "Creating msgdb...done")
 188       (list overview number-alist mark-alist))))
 189
 190 (luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
 191                                                  &optional one-level)
 192   (elmo-mapcar-list-of-list
 193    (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
 194    (elmo-list-subdirectories
 195     (elmo-localdir-folder-path folder)
 196     (or (elmo-localdir-folder-dir-name-internal folder) "")
 197     one-level)))
 198
 199 (defsubst elmo-localdir-list-subr (folder &optional nonsort)
 200   (let ((flist (mapcar 'string-to-int
 201                        (directory-files
 202                         (elmo-localdir-folder-directory-internal folder)
 203                         nil "^[0-9]+$" t)))
 204         (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
 205     (if nonsort
 206         (cons (or (elmo-max-of-list flist) 0)
 207               (if killed
 208                   (- (length flist)
 209                      (elmo-msgdb-killed-list-length killed))
 210                 (length flist)))
 211       (sort flist '<))))
 212
 213 (luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
 214                                                unread
 215                                                &optional number)
 216   (let ((filename (elmo-message-file-name
 217                    folder
 218                    (or number
 219                        (1+ (car (elmo-folder-status folder)))))))
 220     (when (file-writable-p filename)
 221       (write-region-as-binary
 222        (point-min) (point-max) filename nil 'no-msg)
 223       t)))
 224
 225 (luna-define-method elmo-folder-append-messages :around
 226   ((folder elmo-localdir-folder)
 227    src-folder numbers &optional same-number)
 228   (if (elmo-folder-message-file-p src-folder)
 229       (let ((dir (elmo-localdir-folder-directory-internal folder))
 230             (table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
 231             (succeeds numbers)
 232             (next-num (1+ (car (elmo-folder-status folder))))
 233             mark flag)
 234         (while numbers
 235           (setq mark (elmo-message-mark src-folder (car numbers))
 236                 flag (cond
 237                       ((null mark) nil)
 238                       ((member mark (elmo-msgdb-answered-marks))
 239                        'answered)
 240                       ;;
 241                       ((not (member mark (elmo-msgdb-unread-marks)))
 242                        'read)))
 243           (elmo-copy-file
 244            (elmo-message-file-name src-folder (car numbers))
 245            (expand-file-name
 246             (int-to-string
 247              (if same-number (car numbers) next-num))
 248             dir))
 249           (elmo-flag-table-set table
 250                                (elmo-message-field
 251                                 src-folder (car numbers)
 252                                 'message-id)
 253                                flag)
 254           (elmo-progress-notify 'elmo-folder-move-messages)
 255           (if (and (setq numbers (cdr numbers))
 256                    (not same-number))
 257               (setq next-num
 258                     (if (elmo-localdir-locked-p)
 259                         ;; MDA is running.
 260                         (1+ (car (elmo-folder-status folder)))
 261                       (1+ next-num)))))
 262         (when (elmo-folder-persistent-p folder)
 263           (elmo-flag-table-save (elmo-folder-msgdb-path folder) table))
 264         succeeds)
 265     (luna-call-next-method)))
 266
 267 (luna-define-method elmo-folder-delete-messages ((folder elmo-localdir-folder)
 268                                                  numbers)
 269   (dolist (number numbers)
 270     (elmo-localdir-delete-message folder number))
 271   t)
 272
 273 (defun elmo-localdir-delete-message (folder number)
 274   "Delete message in the FOLDER with NUMBER."
 275   (let ((filename (elmo-message-file-name folder number)))
 276     (when (and (string-match "[0-9]+" filename) ; for safety.
 277                (file-exists-p filename)
 278                (file-writable-p filename)
 279                (not (file-directory-p filename)))
 280       (delete-file filename)
 281       t)))
 282
 283 (luna-define-method elmo-message-fetch-internal ((folder elmo-localdir-folder)
 284                                                  number strategy
 285                                                  &optional section unread)
 286   (when (file-exists-p (elmo-message-file-name folder number))
 287     (insert-file-contents-as-binary
 288      (elmo-message-file-name folder number))))
 289
 290 (luna-define-method elmo-folder-list-messages-internal
 291   ((folder elmo-localdir-folder) &optional nohide)
 292   (elmo-localdir-list-subr folder))
 293
 294 (luna-define-method elmo-folder-status ((folder elmo-localdir-folder))
 295   (elmo-localdir-list-subr folder t))
 296
 297 (luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder))
 298   t)
 299
 300 (luna-define-method elmo-folder-writable-p ((folder elmo-localdir-folder))
 301   t)
 302
 303 (luna-define-method elmo-folder-create ((folder elmo-localdir-folder))
 304   (let ((dir (elmo-localdir-folder-directory-internal folder)))
 305     (if (file-directory-p dir)
 306         ()
 307       (if (file-exists-p dir)
 308           (error "Create folder failed")
 309         (elmo-make-directory dir))
 310       t)))
 311
 312 (luna-define-method elmo-folder-delete ((folder elmo-localdir-folder))
 313   (let ((msgs (and (elmo-folder-exists-p folder)
 314                    (elmo-folder-list-messages folder))))
 315     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
 316                                (if (> (length msgs) 0)
 317                                    (format "%d msg(s) exists. " (length msgs))
 318                                  "")
 319                                (elmo-folder-name-internal folder)))
 320       (let ((dir (elmo-localdir-folder-directory-internal folder)))
 321         (if (not (file-directory-p dir))
 322             (error "No such directory: %s" dir)
 323           (elmo-delete-match-files dir "[0-9]+" t)))
 324       (elmo-msgdb-delete-path folder)
 325       t)))
 326
 327 (luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder)
 328                                                  new-folder)
 329   (let* ((old (elmo-localdir-folder-directory-internal folder))
 330          (new (elmo-localdir-folder-directory-internal new-folder))
 331          (new-dir (directory-file-name (file-name-directory new))))
 332     (unless (file-directory-p old)
 333       (error "No such directory: %s" old))
 334     (when (file-exists-p new)
 335       (error "Already exists directory: %s" new))
 336     (unless (file-directory-p new-dir)
 337       (elmo-make-directory new-dir))
 338     (rename-file old new)
 339     t))
 340
 341 (defsubst elmo-localdir-field-condition-match (folder condition
 342                                                       number number-list)
 343   (elmo-file-field-condition-match
 344    (expand-file-name (int-to-string number)
 345                      (elmo-localdir-folder-directory-internal folder))
 346    condition number number-list))
 347
 348 (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
 349   (let* ((dir (elmo-localdir-folder-directory-internal folder))
 350          (msgdb (elmo-folder-msgdb folder))
 351          (onum-alist (elmo-msgdb-get-number-alist msgdb))
 352          (omark-alist (elmo-msgdb-get-mark-alist msgdb))
 353          (new-number 1)                 ; first ordinal position in localdir
 354          flist onum mark new-mark-alist total)
 355     (setq flist
 356           (if elmo-pack-number-check-strict
 357               (elmo-folder-list-messages folder) ; allow localnews
 358             (mapcar 'car onum-alist)))
 359     (setq total (length flist))
 360     (while flist
 361       (when (> total elmo-display-progress-threshold)
 362         (elmo-display-progress
 363          'elmo-folder-pack-numbers "Packing..."
 364          (/ (* new-number 100) total)))
 365       (setq onum (car flist))
 366       (when (not (eq onum new-number))          ; why \=() is wrong..
 367         (elmo-bind-directory
 368          dir
 369          ;; xxx  nfs,hardlink
 370          (rename-file (int-to-string onum) (int-to-string new-number) t))
 371         ;; update overview
 372         (elmo-msgdb-overview-entity-set-number
 373          (elmo-msgdb-overview-get-entity onum msgdb)
 374          new-number)
 375         ;; update number-alist
 376         (and (assq onum onum-alist)
 377              (setcar (assq onum onum-alist) new-number)))
 378       ;; update mark-alist
 379       (when (setq mark (cadr (assq onum omark-alist)))
 380         (setq new-mark-alist
 381               (elmo-msgdb-mark-append
 382                new-mark-alist
 383                new-number mark)))
 384       (setq new-number (1+ new-number))
 385       (setq flist (cdr flist)))
 386     (message "Packing...done")
 387     (elmo-folder-set-msgdb-internal
 388      folder
 389      (elmo-make-msgdb
 390       (elmo-msgdb-get-overview msgdb)
 391       onum-alist
 392       new-mark-alist))))
 393
 394 (luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
 395   t)
 396
 397 (luna-define-method elmo-message-file-name ((folder elmo-localdir-folder)
 398                                             number)
 399   (expand-file-name
 400    (int-to-string number)
 401    (elmo-localdir-folder-directory-internal folder)))
 402
 403 (defun elmo-localdir-locked-p ()
 404   (if elmo-localdir-lockfile-list
 405       (let ((lock elmo-localdir-lockfile-list))
 406         (catch 'found
 407           (while lock
 408             (if (file-exists-p (car lock))
 409                 (throw 'found t))
 410             (setq lock (cdr lock)))))))
 411
 412 (require 'product)
 413 (product-provide (provide 'elmo-localdir) (require 'elmo-version))
 414
 415 ;;; elmo-localdir.el ends here