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 elmo-file-tag)
  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   (let* ((dir-name (elmo-localdir-folder-dir-name-internal folder))
  90          (path (mapconcat
  91                 'identity
  92                 (delete ""
  93                         (mapcar
  94                          'elmo-replace-string-as-filename
  95                          (split-string
  96                           (if (file-name-absolute-p dir-name)
  97                               (expand-file-name dir-name)
  98                             dir-name)
  99                           "/")))
 100                 "/")))
 101     (expand-file-name
 102      path
 103      (expand-file-name ;;"localdir" or "localdir-abs"
 104       (concat
 105        (symbol-name (elmo-folder-type-internal folder))
 106        (when (file-name-absolute-p dir-name) "-abs"))
 107       elmo-msgdb-directory))))
 108
 109 (luna-define-method elmo-message-file-name ((folder
 110                                              elmo-localdir-folder)
 111                                             number)
 112   (expand-file-name (int-to-string number)
 113                     (elmo-localdir-folder-directory-internal folder)))
 114
 115 (luna-define-method elmo-folder-message-file-number-p ((folder
 116                                                         elmo-localdir-folder))
 117   t)
 118
 119 (luna-define-method elmo-folder-message-file-directory ((folder
 120                                                          elmo-localdir-folder))
 121   (elmo-localdir-folder-directory-internal folder))
 122
 123 (luna-define-method elmo-folder-message-make-temp-file-p
 124   ((folder elmo-localdir-folder))
 125   t)
 126
 127 (luna-define-method elmo-folder-message-make-temp-files ((folder
 128                                                           elmo-localdir-folder)
 129                                                          numbers
 130                                                          &optional
 131                                                          start-number)
 132   (let ((temp-dir (elmo-folder-make-temporary-directory folder))
 133         (cur-number (or start-number 0)))
 134     (dolist (number numbers)
 135       (elmo-copy-file
 136        (expand-file-name
 137         (int-to-string number)
 138         (elmo-localdir-folder-directory-internal folder))
 139        (expand-file-name
 140         (int-to-string (if start-number cur-number number))
 141         temp-dir))
 142       (incf cur-number))
 143     temp-dir))
 144
 145 (defun elmo-localdir-msgdb-create-entity (msgdb dir number)
 146   (elmo-msgdb-create-message-entity-from-file
 147    (elmo-msgdb-message-entity-handler msgdb)
 148    number (expand-file-name (int-to-string number) dir)))
 149
 150 (luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
 151                                               numbers
 152                                               flag-table)
 153   (when numbers
 154     (let ((dir (elmo-localdir-folder-directory-internal folder))
 155           (new-msgdb (elmo-make-msgdb))
 156           entity message-id flags)
 157       (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
 158           "Creating msgdb"
 159         (dolist (number numbers)
 160           (setq entity (elmo-localdir-msgdb-create-entity
 161                         new-msgdb dir number))
 162           (when entity
 163             (setq message-id (elmo-message-entity-field entity 'message-id)
 164                   flags (elmo-flag-table-get flag-table message-id))
 165             (elmo-global-flags-set flags folder number message-id)
 166             (elmo-msgdb-append-entity new-msgdb entity flags))
 167           (elmo-progress-notify 'elmo-folder-msgdb-create)))
 168       new-msgdb)))
 169
 170 (luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
 171                                                  &optional one-level)
 172   (elmo-mapcar-list-of-list
 173    (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
 174    (elmo-list-subdirectories
 175     (elmo-localdir-folder-path folder)
 176     (or (elmo-localdir-folder-dir-name-internal folder) "")
 177     one-level)))
 178
 179 (defsubst elmo-localdir-list-subr (folder &optional nonsort)
 180   (let ((flist (mapcar 'string-to-number
 181                        (directory-files
 182                         (elmo-localdir-folder-directory-internal folder)
 183                         nil "^[0-9]+$" t)))
 184         (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
 185     (if nonsort
 186         (cons (or (elmo-max-of-list flist) 0)
 187               (if killed
 188                   (- (length flist)
 189                      (elmo-msgdb-killed-list-length killed))
 190                 (length flist)))
 191       (sort flist '<))))
 192
 193 (luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
 194                                                &optional flags number)
 195   (let ((filename (elmo-message-file-name
 196                    folder
 197                    (or number
 198                        (1+ (car (elmo-folder-status folder)))))))
 199     (when (and (file-writable-p filename)
 200                (not (file-exists-p filename)))
 201       (write-region-as-binary
 202        (point-min) (point-max) filename nil 'no-msg)
 203       (elmo-folder-preserve-flags
 204        folder (elmo-msgdb-get-message-id-from-buffer) flags)
 205       t)))
 206
 207 (defun elmo-folder-append-messages-*-localdir (folder
 208                                                src-folder
 209                                                numbers
 210                                                same-number)
 211   (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
 212         (dir (elmo-localdir-folder-directory-internal folder))
 213         (table (elmo-folder-flag-table folder))
 214         (succeeds numbers)
 215         (next-num (1+ (car (elmo-folder-status folder))))
 216         flags id)
 217     (while numbers
 218       (setq flags (elmo-message-flags src-folder (car numbers)))
 219       (elmo-copy-file
 220        (elmo-message-file-name src-folder (car numbers))
 221        (expand-file-name
 222         (int-to-string
 223          (if same-number (car numbers) next-num))
 224         dir))
 225       ;; save flag-table only when src folder's msgdb is loaded.
 226       (when (setq id (and src-msgdb-exists
 227                           (elmo-message-field src-folder (car numbers)
 228                                               'message-id)))
 229         (elmo-flag-table-set table id flags))
 230       (elmo-progress-notify 'elmo-folder-move-messages)
 231       (if (and (setq numbers (cdr numbers))
 232                (not same-number))
 233           (setq next-num
 234                 (if (elmo-localdir-locked-p)
 235                     ;; MDA is running.
 236                     (1+ (car (elmo-folder-status folder)))
 237                   (1+ next-num)))))
 238     (when (elmo-folder-persistent-p folder)
 239       (elmo-folder-close-flag-table folder))
 240     succeeds))
 241
 242 (luna-define-method elmo-folder-delete-messages-internal
 243   ((folder elmo-localdir-folder) numbers)
 244   (dolist (number numbers)
 245     (elmo-localdir-delete-message folder number))
 246   t)
 247
 248 (defun elmo-localdir-delete-message (folder number)
 249   "Delete message in the FOLDER with NUMBER."
 250   (let ((filename (elmo-message-file-name folder number)))
 251     (when (and (string-match "[0-9]+" filename) ; for safety.
 252                (file-exists-p filename)
 253                (file-writable-p filename)
 254                (not (file-directory-p filename)))
 255       (delete-file filename)
 256       t)))
 257
 258 (luna-define-method elmo-message-fetch-internal ((folder elmo-localdir-folder)
 259                                                  number strategy
 260                                                  &optional section unread)
 261   (let ((filename (elmo-message-file-name folder number)))
 262     (when (file-exists-p filename)
 263       (insert-file-contents-as-raw-text filename))))
 264
 265 (luna-define-method elmo-folder-list-messages-internal
 266   ((folder elmo-localdir-folder) &optional nohide)
 267   (elmo-localdir-list-subr folder))
 268
 269 (luna-define-method elmo-folder-status ((folder elmo-localdir-folder))
 270   (elmo-localdir-list-subr folder t))
 271
 272 (luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder))
 273   t)
 274
 275 (luna-define-method elmo-folder-writable-p ((folder elmo-localdir-folder))
 276   t)
 277
 278 (luna-define-method elmo-folder-create ((folder elmo-localdir-folder))
 279   (let ((dir (elmo-localdir-folder-directory-internal folder)))
 280     (if (file-directory-p dir)
 281         ()
 282       (if (file-exists-p dir)
 283           (error "Create folder failed")
 284         (elmo-make-directory dir))
 285       t)))
 286
 287 (luna-define-method elmo-folder-delete ((folder elmo-localdir-folder))
 288   (let ((msgs (and (elmo-folder-exists-p folder)
 289                    (elmo-folder-list-messages folder))))
 290     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
 291                                (if (> (length msgs) 0)
 292                                    (format "%d msg(s) exists. " (length msgs))
 293                                  "")
 294                                (elmo-folder-name-internal folder)))
 295       (let ((dir (elmo-localdir-folder-directory-internal folder)))
 296         (if (not (file-directory-p dir))
 297             (error "No such directory: %s" dir)
 298           (elmo-delete-match-files dir "[0-9]+" t)))
 299       (elmo-msgdb-delete-path folder)
 300       t)))
 301
 302 (luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder)
 303                                                  new-folder)
 304   (let* ((old (elmo-localdir-folder-directory-internal folder))
 305          (new (elmo-localdir-folder-directory-internal new-folder))
 306          (new-dir (directory-file-name (file-name-directory new))))
 307     (unless (file-directory-p old)
 308       (error "No such directory: %s" old))
 309     (when (file-exists-p new)
 310       (error "Already exists directory: %s" new))
 311     (unless (file-directory-p new-dir)
 312       (elmo-make-directory new-dir))
 313     (rename-file old new)
 314     t))
 315
 316 (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
 317   (let* ((dir (elmo-localdir-folder-directory-internal folder))
 318          (msgdb (elmo-folder-msgdb folder))
 319          (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
 320          (numbers (sort (elmo-folder-list-messages
 321                          folder
 322                          nil
 323                          (not elmo-pack-number-check-strict))
 324                         '<))
 325          (new-number 1)           ; first ordinal position in localdir
 326          entity)
 327     (elmo-with-progress-display (elmo-folder-pack-numbers (length numbers))
 328         "Packing"
 329       (dolist (old-number numbers)
 330         (setq entity (elmo-msgdb-message-entity msgdb old-number))
 331         (when (not (eq old-number new-number)) ; why \=() is wrong..
 332           (elmo-bind-directory
 333            dir
 334            ;; xxx  nfs,hardlink
 335            (rename-file (int-to-string old-number)
 336                         (int-to-string new-number) t))
 337           (elmo-message-entity-set-number entity new-number))
 338         (elmo-msgdb-append-entity new-msgdb entity
 339                                   (elmo-msgdb-flags msgdb old-number))
 340         (elmo-emit-signal 'message-number-changed folder old-number new-number)
 341         (setq new-number (1+ new-number))))
 342     (message "Packing...done")
 343     (elmo-folder-set-msgdb-internal folder new-msgdb)))
 344
 345 (luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
 346   t)
 347
 348 (defun elmo-localdir-locked-p ()
 349   (if elmo-localdir-lockfile-list
 350       (let ((lock elmo-localdir-lockfile-list))
 351         (catch 'found
 352           (while lock
 353             (if (file-exists-p (car lock))
 354                 (throw 'found t))
 355             (setq lock (cdr lock)))))))
 356
 357 (autoload 'elmo-global-flags-set "elmo-flag")
 358
 359 (require 'product)
 360 (product-provide (provide 'elmo-localdir) (require 'elmo-version))
 361
 362 ;;; elmo-localdir.el ends here