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-get-folder name))
  46   (elmo-multi-folder-set-children-internal
  47    folder
  48    (mapcar #'elmo-get-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   (elmo-multi-connect-signals folder)
  57   folder)
  58
  59 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-access-folder))
  60   (expand-file-name (elmo-replace-string-as-filename
  61                      (elmo-folder-name-internal folder))
  62                     (expand-file-name "access" elmo-msgdb-directory)))
  63
  64 (defvar elmo-access-substitute-folder nil)
  65
  66 (defun elmo-access-substitute-folder ()
  67   (or elmo-access-substitute-folder
  68       (setq elmo-access-substitute-folder
  69             (elmo-make-folder "'null"))))
  70
  71 (defun elmo-access-folder-update-children (folder &optional open expunge)
  72   (elmo-multi-folder-set-children-internal
  73    folder
  74    (if (elmo-folder-plugged-p
  75         (elmo-access-folder-base-folder-internal folder))
  76        (let ((subfolders (elmo-folder-list-subfolders
  77                           (elmo-access-folder-base-folder-internal folder)))
  78              children)
  79          (dolist (child (elmo-multi-folder-children-internal folder))
  80            (let ((name (elmo-folder-name-internal child)))
  81              (cond ((member name subfolders)
  82                     (setq children (nconc children (list child))))
  83                    (expunge)
  84                    (t
  85                     (setq children
  86                           (nconc children
  87                                  (list (elmo-access-substitute-folder))))))
  88              (setq subfolders (delete name subfolders))))
  89          (if subfolders
  90              (nconc children
  91                     (mapcar (lambda (name)
  92                               (let ((folder (elmo-get-folder name)))
  93                                 (when open
  94                                   (elmo-folder-open-internal folder))
  95                                 folder))
  96                             subfolders))
  97            children))
  98      (mapcar (lambda (f)
  99                (if (elmo-folder-exists-p f)
 100                    f
 101                  (elmo-access-substitute-folder)))
 102              (elmo-multi-folder-children-internal folder)))))
 103
 104 (luna-define-method elmo-folder-open-internal
 105   :before ((folder elmo-access-folder))
 106   (elmo-access-folder-update-children folder))
 107
 108 (luna-define-method elmo-folder-commit :after ((folder elmo-access-folder))
 109   (when (elmo-folder-persistent-p folder)
 110     (elmo-object-save
 111      (expand-file-name elmo-access-folder-list-filename
 112                        (elmo-folder-msgdb-path folder))
 113      (mapcar (lambda (f) (elmo-folder-name-internal f))
 114              (elmo-multi-folder-children-internal folder)))))
 115
 116 (luna-define-method elmo-folder-check :before ((folder elmo-access-folder))
 117   (elmo-access-folder-update-children folder 'open))
 118
 119 (luna-define-method elmo-folder-synchronize :before
 120   ((folder elmo-access-folder)
 121    &optional disable-killed ignore-msgdb no-check mask)
 122   (when (or ignore-msgdb
 123             (not no-check))
 124     (elmo-access-folder-update-children folder 'open ignore-msgdb)))
 125
 126 (luna-define-method elmo-folder-creatable-p ((folder elmo-access-folder))
 127   nil)
 128
 129 (require 'product)
 130 (product-provide (provide 'elmo-access) (require 'elmo-version))
 131
 132 ;;; elmo-access.el.el ends here