elmo/elmo-access.el

   1 ;;; elmo-access.el --- Auto Collect Multiple Folder Interface for ELMO.
   2
   3 ;; Copyright (C) 2005 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   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 (require 'elmo)
  32 (require 'elmo-multi)
  33
  34 (defvar elmo-access-folder-list-filename "flist"
  35   "Folder list cache.")
  36
  37 (eval-and-compile
  38   (luna-define-class elmo-access-folder (elmo-multi-folder)
  39                      (base-folder))
  40   (luna-define-internal-accessors 'elmo-access-folder))
  41
  42 (luna-define-method elmo-folder-initialize ((folder elmo-access-folder) name)
  43   (elmo-access-folder-set-base-folder-internal
  44    folder
  45    (elmo-make-folder name))
  46   (elmo-multi-folder-set-children-internal
  47    folder
  48    (mapcar #'elmo-make-folder
  49            (elmo-object-load
  50             (expand-file-name elmo-access-folder-list-filename
  51                               (elmo-folder-msgdb-path folder)))))
  52   (elmo-multi-folder-set-divide-number-internal
  53    folder
  54    elmo-multi-divide-number)
  55   (elmo-access-folder-update-children folder)
  56   folder)
  57
  58 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-access-folder))
  59   (expand-file-name (elmo-replace-string-as-filename
  60                      (elmo-folder-name-internal folder))
  61                     (expand-file-name "access" elmo-msgdb-directory)))
  62
  63 (defvar elmo-access-substitute-folder nil)
  64
  65 (defun elmo-access-substitute-folder ()
  66   (or elmo-access-substitute-folder
  67       (setq elmo-access-substitute-folder
  68             (elmo-make-folder "'null"))))
  69
  70 (defun elmo-access-folder-update-children (folder &optional open expunge)
  71   (elmo-multi-folder-set-children-internal
  72    folder
  73    (if (elmo-folder-plugged-p
  74         (elmo-access-folder-base-folder-internal folder))
  75        (let ((subfolders (elmo-folder-list-subfolders
  76                           (elmo-access-folder-base-folder-internal folder)))
  77              children)
  78          (dolist (child (elmo-multi-folder-children-internal folder))
  79            (let ((name (elmo-folder-name-internal child)))
  80              (cond ((member name subfolders)
  81                     (setq children (nconc children (list child))))
  82                    (expunge)
  83                    (t
  84                     (setq children
  85                           (nconc children
  86                                  (list (elmo-access-substitute-folder))))))
  87              (setq subfolders (delete name subfolders))))
  88          (if subfolders
  89              (nconc children
  90                     (mapcar (lambda (name)
  91                               (let ((folder (elmo-make-folder name)))
  92                                 (when open
  93                                   (elmo-folder-open-internal folder))
  94                                 folder))
  95                             subfolders))
  96            children))
  97      (mapcar (lambda (f)
  98                (if (elmo-folder-exists-p f)
  99                    f
 100                  (elmo-access-substitute-folder)))
 101              (elmo-multi-folder-children-internal folder)))))
 102
 103 (luna-define-method elmo-folder-open-internal
 104   :before ((folder elmo-access-folder))
 105   (elmo-access-folder-update-children folder))
 106
 107 (luna-define-method elmo-folder-commit :after ((folder elmo-access-folder))
 108   (when (elmo-folder-persistent-p folder)
 109     (elmo-object-save
 110      (expand-file-name elmo-access-folder-list-filename
 111                        (elmo-folder-msgdb-path folder))
 112      (mapcar (lambda (f) (elmo-folder-name-internal f))
 113              (elmo-multi-folder-children-internal folder)))))
 114
 115 (luna-define-method elmo-folder-check :before ((folder elmo-access-folder))
 116   (elmo-access-folder-update-children folder 'open))
 117
 118 (luna-define-method elmo-folder-synchronize :before
 119   ((folder elmo-access-folder)
 120    &optional disable-killed ignore-msgdb no-check mask)
 121   (when (or ignore-msgdb
 122             (not no-check))
 123     (elmo-access-folder-update-children folder 'open ignore-msgdb)))
 124
 125 (luna-define-method elmo-folder-creatable-p ((folder elmo-access-folder))
 126   nil)
 127
 128 (require 'product)
 129 (product-provide (provide 'elmo-access) (require 'elmo-version))
 130
 131 ;;; elmo-access.el.el ends here