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 ;;; ELMO Local directory folder
  46 (eval-and-compile
  47   (luna-define-class elmo-localdir-folder (elmo-folder)
  48                      (dir-name directory))
  49   (luna-define-internal-accessors 'elmo-localdir-folder))
  50
  51 ;;; elmo-localdir specific methods.
  52 (luna-define-generic elmo-localdir-folder-path (folder)
  53   "Return local directory path of the FOLDER.")
  54
  55 (luna-define-generic elmo-localdir-folder-name (folder name)
  56   "Return directory NAME for FOLDER.")
  57
  58 (luna-define-method elmo-localdir-folder-path ((folder elmo-localdir-folder))
  59   elmo-localdir-folder-path)
  60
  61 (luna-define-method elmo-localdir-folder-name ((folder elmo-localdir-folder)
  62                                                name)
  63   name)
  64
  65 (luna-define-method elmo-folder-initialize ((folder
  66                                              elmo-localdir-folder)
  67                                             name)
  68   (elmo-localdir-folder-set-dir-name-internal folder name)
  69   (if (file-name-absolute-p name)
  70       (elmo-localdir-folder-set-directory-internal
  71        folder
  72        (expand-file-name name))
  73     (elmo-localdir-folder-set-directory-internal
  74      folder
  75      (expand-file-name
  76       (elmo-localdir-folder-name folder name)
  77       (elmo-localdir-folder-path folder))))
  78   folder)
  79
  80 ;; open, check, commit, and close are generic.
  81
  82 (luna-define-method elmo-folder-exists-p ((folder elmo-localdir-folder))
  83   (file-directory-p (elmo-localdir-folder-directory-internal folder)))
  84
  85 (luna-define-method elmo-folder-expand-msgdb-path ((folder
  86                                                     elmo-localdir-folder))
  87   (expand-file-name
  88    (elmo-replace-string-as-filename
  89     (elmo-localdir-folder-dir-name-internal folder))
  90    (expand-file-name ;;"localdir"
  91     (symbol-name (elmo-folder-type-internal folder))
  92     elmo-msgdb-dir)))
  93
  94 (luna-define-method elmo-message-file-name ((folder
  95                                              elmo-localdir-folder)
  96                                             number)
  97   (expand-file-name (int-to-string number)
  98                     (elmo-localdir-folder-directory-internal folder)))
  99
 100 (luna-define-method elmo-folder-message-file-number-p ((folder
 101                                                         elmo-localdir-folder))
 102   t)
 103
 104 (luna-define-method elmo-folder-message-file-directory ((folder
 105                                                          elmo-localdir-folder))
 106   (elmo-localdir-folder-directory-internal folder))
 107
 108 (luna-define-method elmo-folder-message-make-temp-file-p
 109   ((folder elmo-localdir-folder))
 110   t)
 111
 112 (luna-define-method elmo-folder-message-make-temp-files ((folder
 113                                                           elmo-localdir-folder)
 114                                                          numbers
 115                                                          &optional
 116                                                          start-number)
 117   (let ((temp-dir (elmo-folder-make-temp-dir folder))
 118         (cur-number (if start-number 0)))
 119     (dolist (number numbers)
 120       (elmo-add-name-to-file
 121        (expand-file-name
 122         (int-to-string number)
 123         (elmo-localdir-folder-directory-internal folder))
 124        (expand-file-name
 125         (int-to-string (if start-number (incf cur-number) number))
 126         temp-dir)))
 127     temp-dir))
 128
 129 (defun elmo-localdir-msgdb-create-entity (dir number)
 130   (elmo-msgdb-create-overview-entity-from-file
 131    number (expand-file-name (int-to-string number) dir)))
 132
 133 (luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
 134                                               numbers
 135                                               new-mark
 136                                               already-mark
 137                                               seen-mark
 138                                               important-mark
 139                                               seen-list)
 140   (when numbers
 141     (let ((dir (elmo-localdir-folder-directory-internal folder))
 142           overview number-alist mark-alist entity message-id
 143           num seen gmark
 144           (i 0)
 145           (len (length numbers)))
 146       (message "Creating msgdb...")
 147       (while numbers
 148         (setq entity
 149               (elmo-localdir-msgdb-create-entity
 150                dir (car numbers)))
 151         (if (null entity)
 152             ()
 153           (setq num (elmo-msgdb-overview-entity-get-number entity))
 154           (setq overview
 155                 (elmo-msgdb-append-element
 156                  overview entity))
 157           (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 158           (setq number-alist
 159                 (elmo-msgdb-number-add number-alist
 160                                        num
 161                                        message-id))
 162           (setq seen (member message-id seen-list))
 163           (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 164                               (if (elmo-file-cache-exists-p message-id) ; XXX
 165                                   (if seen
 166                                       nil
 167                                     already-mark)
 168                                 (if seen
 169                                     nil ;;seen-mark
 170                                   new-mark))))
 171               (setq mark-alist
 172                     (elmo-msgdb-mark-append
 173                      mark-alist
 174                      num
 175                      gmark))))
 176         (when (> len elmo-display-progress-threshold)
 177           (setq i (1+ i))
 178           (elmo-display-progress
 179            'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..."
 180            (/ (* i 100) len)))
 181         (setq numbers (cdr numbers)))
 182       (message "Creating msgdb...done")
 183       (list overview number-alist mark-alist))))
 184
 185 (luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
 186                                                  &optional one-level)
 187   (mapcar
 188    (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
 189    (elmo-list-subdirectories
 190     (elmo-localdir-folder-path folder)
 191     (or (elmo-localdir-folder-dir-name-internal folder) "")
 192     one-level)))
 193
 194 (defsubst elmo-localdir-list-subr (folder &optional nonsort)
 195   (let ((flist (mapcar 'string-to-int
 196                        (directory-files
 197                         (elmo-localdir-folder-directory-internal folder)
 198                         nil "^[0-9]+$" t)))
 199         (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
 200     (if nonsort
 201         (cons (or (elmo-max-of-list flist) 0)
 202               (if killed
 203                   (- (length flist)
 204                      (elmo-msgdb-killed-list-length killed))
 205                 (length flist)))
 206       (sort flist '<))))
 207
 208 (luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
 209                                                unread
 210                                                &optional number)
 211   (let ((filename (elmo-message-file-name
 212                    folder
 213                    (or number
 214                        (1+ (car (elmo-folder-status folder)))))))
 215     (if (file-writable-p filename)
 216         (write-region-as-binary
 217          (point-min) (point-max) filename nil 'no-msg)
 218       t)))
 219
 220 (luna-define-method elmo-folder-append-messages :around ((folder elmo-localdir-folder)
 221                                                          src-folder numbers
 222                                                          unread-marks
 223                                                          &optional same-number)
 224   (if (elmo-folder-message-file-p src-folder)
 225       (let ((dir (elmo-localdir-folder-directory-internal folder))
 226             (succeeds numbers)
 227             (next-num (1+ (car (elmo-folder-status folder)))))
 228         (while numbers
 229           (elmo-copy-file
 230            (elmo-message-file-name src-folder (car numbers))
 231            (expand-file-name
 232             (int-to-string
 233              (if same-number (car numbers) next-num))
 234             dir))
 235           (if (and (setq numbers (cdr numbers))
 236                    (not same-number))
 237               (setq next-num
 238                     (if (elmo-localdir-locked-p)
 239                         ;; MDA is running.
 240                         (1+ (car (elmo-folder-status folder)))
 241                       (1+ next-num)))))
 242         succeeds)
 243     (luna-call-next-method)))
 244
 245 (luna-define-method elmo-folder-delete-messages ((folder elmo-localdir-folder)
 246                                                  numbers)
 247   (dolist (number numbers)
 248     (elmo-localdir-delete-message folder number))
 249   t)
 250
 251 (defun elmo-localdir-delete-message (folder number)
 252   "Delete message in the FOLDER with NUMBER."
 253   (let ((filename (elmo-message-file-name folder number)))
 254     (when (and (string-match "[0-9]+" filename) ; for safety.
 255                (file-exists-p filename)
 256                (file-writable-p filename)
 257                (not (file-directory-p filename)))
 258       (delete-file filename)
 259       t)))
 260
 261 (luna-define-method elmo-message-fetch ((folder elmo-localdir-folder)
 262                                         number strategy
 263                                         &optional section outbuf unseen)
 264   ;; strategy, section, unseen is ignored.
 265   (if outbuf
 266       (with-current-buffer outbuf
 267         (erase-buffer)
 268         (when (file-exists-p (elmo-message-file-name folder number))
 269           (insert-file-contents-as-binary
 270            (elmo-message-file-name folder number))
 271           (elmo-delete-cr-buffer))
 272         t)
 273     (with-temp-buffer
 274       (when (file-exists-p (elmo-message-file-name folder number))
 275         (insert-file-contents-as-binary (elmo-message-file-name folder number))
 276         (elmo-delete-cr-buffer))
 277       (buffer-string))))
 278
 279 (luna-define-method elmo-folder-list-messages-internal
 280   ((folder elmo-localdir-folder))
 281   (elmo-localdir-list-subr folder))
 282
 283 (luna-define-method elmo-folder-status ((folder elmo-localdir-folder))
 284   (elmo-localdir-list-subr folder t))
 285
 286 (luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder))
 287   t)
 288
 289 (luna-define-method elmo-folder-create ((folder elmo-localdir-folder))
 290   (let ((dir (elmo-localdir-folder-directory-internal folder)))
 291     (if (file-directory-p dir)
 292         ()
 293       (if (file-exists-p dir)
 294           (error "Create folder failed")
 295         (elmo-make-directory dir))
 296       t)))
 297
 298 (luna-define-method elmo-folder-delete ((folder elmo-localdir-folder))
 299   (let ((dir (elmo-localdir-folder-directory-internal folder)))
 300     (if (not (file-directory-p dir))
 301         (error "No such directory: %s" dir)
 302       (elmo-delete-directory dir t)
 303       t)))
 304
 305 (luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder)
 306                                                  new-folder)
 307   (let* ((old (elmo-localdir-folder-directory-internal folder))
 308          (new (elmo-localdir-folder-directory-internal folder))
 309          (new-dir (directory-file-name (file-name-directory new))))
 310     (if (not (file-directory-p old))
 311         (error "No such directory: %s" old)
 312       (if (file-exists-p new)
 313           (error "Already exists directory: %s" new)
 314         (if (not (file-exists-p new-dir))
 315             (elmo-make-directory new-dir))
 316         (rename-file old new)
 317         t))))
 318
 319 (defsubst elmo-localdir-field-condition-match (folder condition
 320                                                       number number-list)
 321   (elmo-file-field-condition-match
 322    (expand-file-name (int-to-string number)
 323                      (elmo-localdir-folder-directory-internal folder))
 324    condition number number-list))
 325
 326 (luna-define-method elmo-folder-search ((folder elmo-localdir-folder)
 327                                         condition &optional numbers)
 328   (let* ((msgs (or numbers (elmo-folder-list-messages folder)))
 329          (num (length msgs))
 330          (i 0)
 331          number-list case-fold-search ret-val)
 332     (setq number-list msgs)
 333     (while msgs
 334       (if (elmo-localdir-field-condition-match folder condition
 335                                                (car msgs) number-list)
 336           (setq ret-val (cons (car msgs) ret-val)))
 337       (when (> num elmo-display-progress-threshold)
 338         (setq i (1+ i))
 339         (elmo-display-progress
 340          'elmo-localdir-search "Searching..."
 341          (/ (* i 100) num)))
 342       (setq msgs (cdr msgs)))
 343     (nreverse ret-val)))
 344
 345 (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
 346   (let* ((dir (elmo-localdir-folder-directory-internal folder))
 347          (msgdb (elmo-folder-msgdb folder))
 348          (onum-alist (elmo-msgdb-get-number-alist msgdb))
 349          (omark-alist (elmo-msgdb-get-mark-alist (elmo-folder-msgdb msgdb)))
 350          (new-number 1)                 ; first ordinal position in localdir
 351          flist onum mark new-mark-alist total)
 352     (setq flist
 353           (if elmo-pack-number-check-strict
 354               (elmo-folder-list-messages folder) ; allow localnews
 355             (mapcar 'car onum-alist)))
 356     (setq total (length flist))
 357     (while flist
 358       (when (> total elmo-display-progress-threshold)
 359         (elmo-display-progress
 360          'elmo-folder-pack-numbers "Packing..."
 361          (/ (* new-number 100) total)))
 362       (setq onum (car flist))
 363       (when (not (eq onum new-number))          ; why \=() is wrong..
 364         (elmo-bind-directory
 365          dir
 366          ;; xxx  nfs,hardlink
 367          (rename-file (int-to-string onum) (int-to-string new-number) t))
 368         ;; update overview
 369         (elmo-msgdb-overview-entity-set-number
 370          (elmo-msgdb-overview-get-entity onum msgdb)
 371          new-number)
 372         ;; update number-alist
 373         (setcar (assq onum onum-alist) new-number))
 374       ;; update mark-alist
 375       (when (setq mark (cadr (assq onum omark-alist)))
 376         (setq new-mark-alist
 377               (elmo-msgdb-mark-append
 378                new-mark-alist
 379                new-number mark)))
 380       (setq new-number (1+ new-number))
 381       (setq flist (cdr flist)))
 382     (message "Packing...done")
 383     (elmo-folder-set-msgdb-internal
 384      folder
 385      (list (elmo-msgdb-get-overview msgdb)
 386            onum-alist
 387            new-mark-alist
 388            ;; remake hash table
 389            (elmo-msgdb-make-overview-hashtb
 390             (elmo-msgdb-get-overview msgdb))))))
 391
 392 (luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
 393   t)
 394
 395 (luna-define-method elmo-message-file-name ((folder elmo-localdir-folder)
 396                                             number)
 397   (expand-file-name
 398    (int-to-string number)
 399    (elmo-localdir-folder-directory-internal folder)))
 400
 401 (defun elmo-localdir-locked-p ()
 402   (if elmo-localdir-lockfile-list
 403       (let ((lock elmo-localdir-lockfile-list))
 404         (catch 'found
 405           (while lock
 406             (if (file-exists-p (car lock))
 407                 (throw 'found t))
 408             (setq lock (cdr lock)))))))
 409
 410 (require 'product)
 411 (product-provide (provide 'elmo-localdir) (require 'elmo-version))
 412
 413 ;;; elmo-localdir.el ends here