elmo/elmo-internal.el

   1 ;;; elmo-internal.el -- Internal Interface for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   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-localdir)
  32
  33 (defsubst elmo-internal-list-folder-subr (spec &optional nonsort)
  34   (let* ((directive (nth 1 spec))
  35          (arg (nth 2 spec))
  36          (flist (elmo-list-folder-by-location
  37                  spec
  38                  (elmo-internal-list-location directive arg)))
  39          (killed (and elmo-use-killed-list
  40                       (elmo-msgdb-killed-list-load
  41                        (elmo-msgdb-expand-path spec))))
  42          numbers)
  43     (if nonsort
  44         (cons (or (elmo-max-of-list flist) 0)
  45               (if killed
  46                   (- (length flist)
  47                      (elmo-msgdb-killed-list-length killed))
  48                 (length flist)))
  49       (setq numbers (sort flist '<))
  50       (elmo-living-messages numbers killed))))
  51
  52 (defun elmo-internal-list-folder (spec &optional nohide)
  53   (elmo-internal-list-folder-subr spec))
  54
  55 (defun elmo-internal-list-folder-by-location (spec location &optional msgdb)
  56   (let* ((path (elmo-msgdb-expand-path spec))
  57          (location-alist
  58           (if msgdb
  59               (elmo-msgdb-get-location msgdb)
  60             (elmo-msgdb-location-load path)))
  61          (i 0)
  62          result pair
  63          location-max modified)
  64     (setq location-max
  65           (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
  66     (when location-max
  67       (while location
  68         (if (setq pair (rassoc (car location) location-alist))
  69             (setq result
  70                   (append result
  71                           (list (cons (car pair) (car location)))))
  72           (setq i (1+ i))
  73           (setq result (append result
  74                                (list
  75                                 (cons (+ location-max i) (car location))))))
  76         (setq location (cdr location))))
  77     (setq result (sort result '(lambda (x y)
  78                                  (< (car x)(car y)))))
  79     (if (not (equal result location-alist))
  80         (setq modified t))
  81     (if modified
  82         (elmo-msgdb-location-save path result))
  83     (mapcar 'car result)))
  84
  85 (defun elmo-internal-list-location (directive arg)
  86   (let ((mark-alist
  87          (or elmo-msgdb-global-mark-alist
  88              (setq elmo-msgdb-global-mark-alist
  89                    (elmo-object-load (expand-file-name
  90                                       elmo-msgdb-global-mark-filename
  91                                       elmo-msgdb-dir)))))
  92         result)
  93     (mapcar (function (lambda (x)
  94                         (setq result (cons (car x) result))))
  95             mark-alist)
  96     (nreverse result)))
  97
  98 (defun elmo-internal-msgdb-create-entity (number loc-alist)
  99   (elmo-localdir-msgdb-create-overview-entity-from-file
 100    number
 101    (elmo-cache-get-path (cdr (assq number loc-alist)))))
 102
 103 (defun elmo-internal-msgdb-create (spec numlist new-mark
 104                                        already-mark seen-mark
 105                                        important-mark
 106                                        seen-list
 107                                        &optional msgdb)
 108   (when numlist
 109     (let* ((directive (nth 1 spec))
 110            (arg       (nth 2 spec))
 111            (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 112                         (elmo-msgdb-location-load (elmo-msgdb-expand-path
 113                                                    spec))))
 114            (loc-list (elmo-internal-list-location directive arg))
 115            overview number-alist mark-alist entity
 116            i percent num location pair)
 117       (setq num (length numlist))
 118       (setq i 0)
 119       (message "Creating msgdb...")
 120       (while numlist
 121         (setq entity
 122               (elmo-internal-msgdb-create-entity
 123                (car numlist) loc-alist))
 124         (if (null entity)
 125             ()
 126           (setq overview
 127                 (elmo-msgdb-append-element
 128                  overview entity))
 129           (setq number-alist
 130                 (elmo-msgdb-number-add number-alist
 131                                        (elmo-msgdb-overview-entity-get-number
 132                                         entity)
 133                                        (elmo-msgdb-overview-entity-get-id
 134                                         entity)))
 135           (setq location (cdr (assq (car numlist) loc-alist)))
 136           (unless (memq location seen-list)
 137             (setq mark-alist
 138                   (elmo-msgdb-mark-append
 139                    mark-alist
 140                    (elmo-msgdb-overview-entity-get-number
 141                     entity)
 142 ;;;                (nth 0 entity)
 143                    (or (elmo-msgdb-global-mark-get
 144                         (elmo-msgdb-overview-entity-get-id
 145                          entity))
 146                        (if (elmo-cache-exists-p
 147                             (elmo-msgdb-overview-entity-get-id
 148                              entity))
 149                            already-mark
 150                          new-mark))))))
 151         (when (> num elmo-display-progress-threshold)
 152           (setq i (1+ i))
 153           (setq percent (/ (* i 100) num))
 154           (elmo-display-progress
 155            'elmo-internal-msgdb-create "Creating msgdb..."
 156            percent))
 157         (setq numlist (cdr numlist)))
 158       (message "Creating msgdb...done")
 159       (list overview number-alist mark-alist loc-alist))))
 160
 161 (defalias 'elmo-internal-msgdb-create-as-numlist 'elmo-internal-msgdb-create)
 162
 163 (defun elmo-internal-list-folders (spec &optional hierarchy)
 164   ;; XXX hard cording.
 165   (unless (nth 1 spec) ; toplevel.
 166     (list (list "'cache") "'mark")))
 167
 168 (defvar elmo-internal-mark "$")
 169
 170 (defun elmo-internal-append-msg (spec string &optional msg no-see)
 171   (elmo-set-work-buf
 172    (insert string)
 173    (let* ((msgid (elmo-field-body "message-id"))
 174           (path (elmo-cache-get-path msgid))
 175           dir)
 176      (when path
 177        (setq dir (directory-file-name (file-name-directory path)))
 178        (if (not (file-exists-p dir))
 179            (elmo-make-directory dir))
 180        (as-binary-output-file (write-region (point-min) (point-max)
 181                                             path nil 'no-msg)))
 182      (elmo-msgdb-global-mark-set msgid elmo-internal-mark))))
 183
 184 (defun elmo-internal-delete-msgs (spec msgs &optional msgdb)
 185   (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 186                      (elmo-msgdb-location-load (elmo-msgdb-expand-path
 187                                                 spec)))))
 188     (mapcar '(lambda (msg) (elmo-internal-delete-msg spec msg
 189                                                      loc-alist))
 190             msgs)))
 191
 192 (defun elmo-internal-delete-msg (spec number loc-alist)
 193   (let ((pair (assq number loc-alist)))
 194     (elmo-msgdb-global-mark-delete (cdr pair))))
 195
 196 (defun elmo-internal-read-msg (spec number outbuf &optional msgdb unread)
 197   (save-excursion
 198     (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 199                         (elmo-msgdb-location-load (elmo-msgdb-expand-path
 200                                                    spec))))
 201            (file (elmo-cache-get-path (cdr (assq number loc-alist)))))
 202       (set-buffer outbuf)
 203       (erase-buffer)
 204       (when (file-exists-p file)
 205         (as-binary-input-file (insert-file-contents file))
 206         (elmo-delete-cr-get-content-type)))))
 207
 208 (defun elmo-internal-max-of-folder (spec)
 209   (elmo-internal-list-folder-subr spec t))
 210
 211 (defun elmo-internal-check-validity (spec)
 212   nil)
 213
 214 (defun elmo-internal-sync-validity (spec)
 215   nil)
 216
 217 (defun elmo-internal-folder-exists-p (spec)
 218   t)
 219
 220 (defun elmo-internal-folder-creatable-p (spec)
 221   nil)
 222
 223 (defun elmo-internal-create-folder (spec)
 224   nil)
 225
 226 (defun elmo-internal-search (spec condition &optional from-msgs msgdb)
 227   (let* ((msgs (or from-msgs (elmo-internal-list-folder spec)))
 228          (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
 229                       (elmo-msgdb-location-load (elmo-msgdb-expand-path
 230                                                  spec))))
 231          (number-list (mapcar 'car loc-alist))
 232          (i 0)
 233          (num (length msgs))
 234          cache-file
 235          matched
 236          case-fold-search)
 237     (setq num (length msgs))
 238     (while msgs
 239       (if (and (setq cache-file (elmo-cache-get-path (cdr (assq (car msgs)
 240                                                                 loc-alist))))
 241                (file-exists-p cache-file)
 242                (elmo-file-field-condition-match cache-file
 243                                                 condition
 244                                                 (car msgs)
 245                                                 number-list))
 246           (setq matched (nconc matched (list (car msgs)))))
 247       (elmo-display-progress
 248        'elmo-internal-search "Searching..."
 249        (/ (* (setq i (1+ i)) 100) num))
 250       (setq msgs (cdr msgs)))
 251     matched))
 252
 253 (defun elmo-internal-use-cache-p (spec number)
 254   nil)
 255
 256 (defun elmo-internal-local-file-p (spec number)
 257   nil ;; XXXX
 258   )
 259
 260 (defalias 'elmo-internal-sync-number-alist 'elmo-generic-sync-number-alist)
 261 (defalias 'elmo-internal-list-folder-unread
 262   'elmo-generic-list-folder-unread)
 263 (defalias 'elmo-internal-list-folder-important
 264   'elmo-generic-list-folder-important)
 265 (defalias 'elmo-internal-commit 'elmo-generic-commit)
 266 (defalias 'elmo-internal-folder-diff 'elmo-generic-folder-diff)
 267
 268 (require 'product)
 269 (product-provide (provide 'elmo-internal) (require 'elmo-version))
 270
 271 ;;; elmo-internal.el ends here