elmo/elmo.el

   1 ;;; elmo.el -- Elisp Library for Message Orchestration
   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
  32 (require 'luna)
  33
  34 (require 'elmo-version)                 ; reduce recursive-load-depth
  35 (require 'elmo-vars)
  36 (require 'elmo-util)
  37 (require 'elmo-msgdb)
  38
  39 (eval-when-compile (require 'cl))
  40
  41 (if (or (featurep 'dbm)
  42         (featurep 'gnudbm)
  43         (featurep 'berkdb)
  44         (featurep 'berkeley-db))
  45     (require 'elmo-database))
  46
  47 (defcustom elmo-message-fetch-threshold 30000
  48   "Fetch threshold."
  49   :type 'integer
  50   :group 'elmo)
  51
  52 (defcustom elmo-message-fetch-confirm t
  53   "Confirm fetching if message size is larger than `elmo-fetch-threshold'.
  54 Otherwise, entire fetching of the message is aborted without confirmation."
  55   :type 'boolean
  56   :group 'elmo)
  57
  58 (defcustom elmo-folder-update-threshold 500
  59   "Update threshold."
  60   :type 'integer
  61   :group 'elmo)
  62
  63 (defcustom elmo-folder-update-confirm t
  64   "Confirm if update number exceeds `elmo-folder-update-threshold'."
  65   :type 'boolean
  66   :group 'elmo)
  67
  68 ;;; internal
  69 (defvar elmo-folder-type-alist nil)
  70
  71 (defvar elmo-newsgroups-hashtb nil)
  72
  73 (elmo-define-error 'elmo-error "Error" 'error)
  74 (elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error)
  75 (elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error)
  76 (elmo-define-error 'elmo-imap4-bye-error "IMAP4 BYE response" 'elmo-open-error)
  77
  78 (defun elmo-define-folder (prefix backend)
  79   "Define a folder.
  80 If a folder name begins with PREFIX, use BACKEND."
  81   (let ((pair (assq prefix elmo-folder-type-alist)))
  82     (if pair
  83         (progn
  84           (setcar pair prefix)
  85           (setcdr pair backend))
  86       (setq elmo-folder-type-alist (cons (cons prefix backend)
  87                                          elmo-folder-type-alist)))))
  88
  89 (defmacro elmo-folder-type (name)
  90   "Get folder type from NAME string."
  91   (` (and (stringp (, name))
  92           (cdr (assoc (string-to-char (, name)) elmo-folder-type-alist)))))
  93
  94 ;;; ELMO folder
  95 ;; A elmo folder provides uniformed (orchestrated) access
  96 ;; to the internet messages.
  97 (eval-and-compile
  98   (luna-define-class elmo-folder () (type   ; folder type symbol.
  99                                      name   ; orignal folder name string.
 100                                      prefix ; prefix for folder name
 101                                      path   ; directory path for msgdb.
 102                                      msgdb  ; msgdb (may be nil).
 103                                      killed-list  ; killed list.
 104                                      persistent   ; non-nil if persistent.
 105                                      message-modified ; message is modified.
 106                                      mark-modified    ; mark is modified.
 107                                      ))
 108   (luna-define-internal-accessors 'elmo-folder))
 109
 110 (luna-define-generic elmo-folder-initialize (folder name)
 111   ;; Initialize a FOLDER structure with NAME."
 112   )
 113
 114 (defmacro elmo-folder-send (folder message &rest args)
 115   "Let FOLDER receive the MESSAGE with ARGS."
 116   (` (luna-send (, folder) (, message) (, folder) (,@ args))))
 117
 118 ;;;###autoload
 119 (defun elmo-make-folder (name &optional non-persistent)
 120   "Make an ELMO folder structure specified by NAME.
 121 If optional argument NON-PERSISTENT is non-nil, folder is treated as
 122  non-persistent."
 123   (let ((type (elmo-folder-type name))
 124         prefix split class folder original)
 125     (setq original (elmo-string name))
 126     (if type
 127         (progn
 128           (setq prefix (substring name 0 1))
 129           (setq name (substring name 1)))
 130       (setq type (intern (car (setq split (split-string name ":")))))
 131       (setq name (substring name (+ 1 (length (car split)))))
 132       (setq prefix (concat (car split) ":")))
 133     (setq class (format "elmo-%s" (symbol-name type)))
 134     (require (intern class))
 135     (setq folder (luna-make-entity (intern (concat class "-folder"))
 136                                    :type   type
 137                                    :prefix prefix
 138                                    :name original
 139                                    :persistent (not non-persistent)))
 140     (save-match-data
 141       (elmo-folder-send folder 'elmo-folder-initialize name))))
 142
 143 (luna-define-generic elmo-folder-open (folder)
 144   "Open and setup (load saved status) FOLDER.")
 145
 146 (luna-define-generic elmo-folder-open-internal (folder)
 147   "Open FOLDER (without loading saved folder status).")
 148
 149 (luna-define-generic elmo-folder-check (folder)
 150   "Check the FOLDER to obtain newest information at the next list operation.")
 151
 152 (luna-define-generic elmo-folder-commit (folder)
 153   "Save current status of FOLDER.")
 154
 155 (luna-define-generic elmo-folder-close (folder)
 156   "Close, save and clearnup FOLDER.")
 157
 158 (luna-define-generic elmo-folder-close-internal (folder)
 159   "Close FOLDER (without saving folder status).")
 160
 161 (luna-define-generic elmo-folder-plugged-p (folder)
 162   "Returns t if FOLDER is plugged.")
 163
 164 (luna-define-generic elmo-folder-set-plugged (folder plugged &optional add)
 165   "Set FOLDER as plugged.")
 166
 167 (luna-define-generic elmo-folder-use-flag-p (folder)
 168   "Returns t if FOLDER treats unread/important flag itself.")
 169
 170 (luna-define-generic elmo-folder-diff (folder &optional numbers)
 171   "Get diff of FOLDER.
 172 If optional NUMBERS is set, it is used as current NUMBERS.
 173 Otherwise, saved status for folder is used for comparison.
 174 Return value is a cons cell of NEWS and MESSAGES.")
 175
 176 (luna-define-generic elmo-folder-status (folder)
 177   "Returns a cons cell of (MAX-NUMBER . MESSAGES) in the FOLDER.")
 178
 179 (defun elmo-folder-list-messages (folder &optional visible-only)
 180   "Return a list of message numbers contained in FOLDER.
 181 If optional VISIBLE-ONLY is non-nil, killed messages are not listed."
 182   (let ((list (elmo-folder-list-messages-internal folder visible-only))
 183         (killed (elmo-folder-killed-list-internal folder))
 184         numbers)
 185     (setq numbers
 186           (if (listp list)
 187               list
 188             ;; Not available, use current list.
 189             (mapcar
 190              'car
 191              (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))))
 192     (elmo-living-messages numbers killed)))
 193
 194 (defun elmo-folder-list-unreads (folder unread-marks)
 195   "Return a list of unread message numbers contained in FOLDER.
 196 UNREAD-MARKS is the unread marks."
 197   (let ((list (elmo-folder-list-unreads-internal folder
 198                                                  unread-marks)))
 199     (if (listp list)
 200         list
 201       ;; Not available, use current mark.
 202       (delq nil
 203             (mapcar
 204              (function
 205               (lambda (x)
 206                 (if (member (cadr x) unread-marks)
 207                     (car x))))
 208              (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))))
 209
 210 (defun elmo-folder-list-importants (folder important-mark)
 211   "Returns a list of important message numbers contained in FOLDER.
 212 IMPORTANT-MARK is the important mark."
 213   (let ((list (elmo-folder-list-importants-internal folder important-mark)))
 214     (if (listp list)
 215         list
 216       ;; Not available, use current mark.
 217       (delq nil
 218             (mapcar
 219              (function
 220               (lambda (x)
 221                 (if (string= (cadr x) important-mark)
 222                     (car x))))
 223              (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))))
 224
 225 (luna-define-generic elmo-folder-list-messages-internal (folder &optional
 226                                                                 visible-only)
 227   ;; Return a list of message numbers contained in FOLDER.
 228   ;; Return t if the message list is not available.
 229   )
 230
 231 (luna-define-generic elmo-folder-list-unreads-internal (folder
 232                                                         unread-marks
 233                                                         &optional mark-alist)
 234   ;; Return a list of unread message numbers contained in FOLDER.
 235   ;; If optional MARK-ALIST is set, it is used as mark-alist.
 236   ;; Return t if this feature is not available.
 237   )
 238
 239 (luna-define-generic elmo-folder-list-importants-internal (folder
 240                                                            important-mark)
 241   ;; Return a list of important message numbers contained in FOLDER.
 242   ;; Return t if this feature is not available.
 243   )
 244
 245 (luna-define-generic elmo-folder-list-subfolders (folder &optional one-level)
 246   "Returns a list of subfolders contained in FOLDER.
 247 If optional argument ONE-LEVEL is non-nil, only children of FOLDER is returned.
 248 (a folder which have children is returned as a list)
 249 Otherwise, all descendent folders are returned.")
 250
 251 (luna-define-generic elmo-folder-exists-p (folder)
 252   "Returns non-nil when FOLDER exists.")
 253
 254 (luna-define-generic elmo-folder-creatable-p (folder)
 255   "Returns non-nil when FOLDER is creatable.")
 256
 257 (luna-define-generic elmo-folder-writable-p (folder)
 258   "Returns non-nil when FOLDER is writable.")
 259
 260 (luna-define-generic elmo-folder-persistent-p (folder)
 261   "Return non-nil when FOLDER is persistent.")
 262
 263 (luna-define-generic elmo-folder-create (folder)
 264   "Create a FOLDER.")
 265
 266 (luna-define-generic elmo-message-deletable-p (folder number)
 267   "Returns non-nil when the message in the FOLDER with NUMBER is deletable.")
 268
 269 (luna-define-generic elmo-folder-delete (folder)
 270   "Delete FOLDER completely.")
 271
 272 (luna-define-generic elmo-folder-rename (folder new-name)
 273   "Rename FOLDER to NEW-NAME (string).")
 274
 275 (luna-define-generic elmo-folder-delete-messages (folder numbers)
 276   "Delete messages.
 277 FOLDER is the ELMO folder structure.
 278 NUMBERS is a list of message numbers to be deleted.")
 279
 280 (luna-define-generic elmo-folder-search (folder condition &optional numbers)
 281   "Search and return list of message numbers.
 282 FOLDER is the ELMO folder structure.
 283 CONDITION is a condition string for searching.
 284 If optional argument NUMBERS is specified and is a list of message numbers,
 285 messages are searched from the list.")
 286
 287 (luna-define-generic elmo-folder-msgdb-create
 288   (folder numbers new-mark already-mark seen-mark important-mark seen-list)
 289   "Create a message database (implemented in each backends).
 290 FOLDER is the ELMO folder structure.
 291 NUMBERS is a list of message numbers to create msgdb.
 292 NEW-MARK, ALREADY-MARK, SEEN-MARK, and IMPORTANT-MARK are mark string for
 293 new message, unread but cached message, read message and important message.
 294 SEEN-LIST is a list of message-id string which should be treated as read.")
 295
 296 (luna-define-generic elmo-folder-unmark-important (folder numbers)
 297   "Un-mark messages as important.
 298 FOLDER is the ELMO folder structure.
 299 NUMBERS is a list of message numbers to be processed.")
 300
 301 (luna-define-generic elmo-folder-mark-as-important (folder numbers)
 302   "Mark messages as important.
 303 FOLDER is the ELMO folder structure.
 304 NUMBERS is a list of message numbers to be processed.")
 305
 306 (luna-define-generic elmo-folder-unmark-read (folder numbers)
 307   "Un-mark messages as read.
 308 FOLDER is the ELMO folder structure.
 309 NUMBERS is a list of message numbers to be processed.")
 310
 311 (luna-define-generic elmo-folder-mark-as-read (folder numbers)
 312   "Mark messages as read.
 313 FOLDER is the ELMO folder structure.
 314 NUMBERS is a list of message numbers to be processed.")
 315
 316 (luna-define-generic elmo-folder-append-buffer (folder unread &optional number)
 317   "Append current buffer as a new message.
 318 FOLDER is the destination folder(ELMO folder structure).
 319 If UNREAD is non-nil, message is appended as unread.
 320 If optional argument NUMBER is specified, the new message number is set
 321 (if possible).")
 322
 323 (luna-define-generic elmo-folder-append-messages (folder
 324                                                   src-folder
 325                                                   numbers
 326                                                   unread-marks
 327                                                   &optional
 328                                                   same-number)
 329   "Append messages from folder.
 330 FOLDER is the ELMO folder structure.
 331 Caller should make sure FOLDER is `writable'.
 332 (Can be checked with `elmo-folder-writable-p').
 333 SRC-FOLDER is the source ELMO folder structure.
 334 NUMBERS is the message numbers to be appended in the SRC-FOLDER.
 335 UNREAD-MARKS is a list of unread mark string.
 336 If second optional argument SAME-NUMBER is specified,
 337 message number is preserved (if possible).")
 338
 339 (luna-define-generic elmo-folder-pack-numbers (folder)
 340   "Pack message numbers of FOLDER.")
 341
 342 (luna-define-generic elmo-folder-update-number (folder)
 343   "Update number of FOLDER.")
 344
 345 (luna-define-generic elmo-folder-diff-async (folder)
 346   "Get diff of FOLDER asynchronously.")
 347
 348 (luna-define-generic elmo-folder-expand-msgdb-path (folder)
 349   "Expand path for FOLDER.")
 350
 351 (luna-define-generic elmo-folder-get-primitive-list (folder)
 352   "Get primitive folder structure list contained in FOLDER.")
 353
 354 (luna-define-generic elmo-folder-contains-type (folder type)
 355   "Returns t if FOLDER contains TYPE.")
 356
 357 (luna-define-generic elmo-folder-local-p (folder)
 358   "Returns t if FOLDER is local.")
 359
 360 (luna-define-generic elmo-folder-message-file-p (folder)
 361   "Returns t if all messages in the FOLDER are files.")
 362
 363 ;;; Message methods.
 364 (luna-define-generic elmo-message-use-cache-p (folder number)
 365   "Returns t if the message in the FOLDER with NUMBER uses cache.")
 366
 367 (luna-define-generic elmo-message-file-name (folder number)
 368   "Return the file name of a message specified by FOLDER and NUMBER.")
 369
 370 ;;; For archive
 371
 372 ;;; Use original file
 373 (luna-define-generic elmo-folder-message-file-number-p (folder)
 374   "Return t if the file name in the FOLDER is the message number.")
 375
 376 (luna-define-generic elmo-folder-message-file-directory (folder)
 377   "Return the directory of the message files of FOLDER.")
 378
 379 ;;; Use temporary file
 380 (luna-define-generic elmo-folder-message-make-temp-file-p (folder)
 381   "Return t if the messages in the FOLDER makes local temporary file.")
 382
 383 (luna-define-generic elmo-folder-message-make-temp-files (folder
 384                                                           numbers
 385                                                           &optional
 386                                                           start-number)
 387   "Make a new temporary files from the messages in the FOLDER with NUMBERS.
 388 If START-NUMBER is specified, temporary files begin from the number.
 389 Otherwise, same number is used for temporary files.
 390 Return newly created temporary directory name which contains temporary files.")
 391
 392 (luna-define-generic elmo-message-file-p (folder number)
 393   "Return t if message in the FOLDER with NUMBER is a file.")
 394
 395 (luna-define-generic elmo-find-fetch-strategy
 396   (folder entity &optional ignore-cache)
 397 ;; Returns the message fetching strategy suitable for the message.
 398 ;; FOLDER is the ELMO folder structure.
 399 ;; ENTITY is the overview entity of the message in the folder.
 400 ;; If optional argument IGNORE-CACHE is non-nil, cache is ignored.
 401 ;; Returned value is a elmo-fetch-strategy object.
 402 ;; If return value is nil, message should not be nil.
 403   )
 404
 405 (defmacro elmo-make-fetch-strategy (entireness
 406                                     &optional
 407                                     use-cache
 408                                     save-cache
 409                                     cache-path)
 410 ;; Make elmo-message-fetching strategy.
 411 ;; ENTIRENESS is 'entire or 'section.
 412 ;; 'entire means fetch message entirely at once.
 413 ;; 'section means fetch message section by section.
 414 ;; If optional USE-CACHE is non-nil, existing cache is used and otherwise,
 415 ;; existing cache is thrown away.
 416 ;; If SAVE-CACHE is non-nil, fetched message is saved.
 417 ;; CACHE-PATH is the cache path to be used as a message cache file.
 418   (` (vector (, entireness)
 419              (, use-cache) (, save-cache) (, cache-path))))
 420
 421 (defmacro elmo-fetch-strategy-entireness (strategy)
 422   ;; Return entireness of STRATEGY.
 423   (` (aref (, strategy) 0)))
 424
 425 (defmacro elmo-fetch-strategy-use-cache (strategy)
 426   ;; Return use-cache of STRATEGY.
 427   (` (aref (, strategy) 1)))
 428
 429 (defmacro elmo-fetch-strategy-save-cache (strategy)
 430   ;; Return save-cache of STRATEGY.
 431   (` (aref (, strategy) 2)))
 432
 433 (defmacro elmo-fetch-strategy-cache-path (strategy)
 434   ;;  Return cache-path of STRATEGY.
 435   (` (aref (, strategy) 3)))
 436
 437 (luna-define-method elmo-find-fetch-strategy
 438   ((folder elmo-folder) entity &optional ignore-cache)
 439   (let (cache-file size message-id number)
 440     (setq size (elmo-msgdb-overview-entity-get-size entity))
 441     (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 442     (setq number (elmo-msgdb-overview-entity-get-number entity))
 443     (setq cache-file (elmo-file-cache-get message-id))
 444     (if (or ignore-cache
 445             (null (elmo-file-cache-status cache-file)))
 446         ;; No cache or ignore-cache.
 447         (if (and (not (elmo-folder-local-p folder))
 448                  elmo-message-fetch-threshold
 449                  (integerp size)
 450                  (>= size elmo-message-fetch-threshold)
 451                  (or (not elmo-message-fetch-confirm)
 452                      (not (prog1 (y-or-n-p
 453                                   (format "Fetch entire message(%dbytes)? "
 454                                           size))
 455                             (message "")))))
 456             ;; Don't fetch message at all.
 457             nil
 458           ;; Don't use existing cache and fetch entire message at once.
 459           (elmo-make-fetch-strategy
 460            'entire nil
 461            (elmo-message-use-cache-p folder number)
 462            (elmo-file-cache-path cache-file)))
 463       ;; Cache exists.
 464       (if (not ignore-cache)
 465           (elmo-make-fetch-strategy
 466            'entire
 467            ;; ...But ignore current section cache and re-fetch
 468            ;; if section cache.
 469            (not (eq (elmo-file-cache-status cache-file) 'section))
 470            ;; Save cache.
 471            (elmo-message-use-cache-p folder number)
 472            (elmo-file-cache-path cache-file))))))
 473
 474 (luna-define-method elmo-folder-list-messages-internal
 475   ((folder elmo-folder))
 476   t)
 477
 478 (luna-define-method elmo-folder-list-unreads-internal
 479   ((folder elmo-folder) unread-marks &optional mark-alist)
 480   t)
 481
 482 (luna-define-method elmo-folder-list-importants-internal
 483   ((folder elmo-folder) important-mark)
 484   t)
 485
 486 (defun elmo-message-encache (folder number)
 487   (elmo-message-fetch
 488    folder number
 489    (elmo-make-fetch-strategy 'entire
 490                              nil ;use-cache
 491                              t   ;save-cache
 492                              (elmo-file-cache-get-path
 493                               (elmo-message-field
 494                                folder number 'message-id)))))
 495
 496 (luna-define-generic elmo-message-fetch (folder number strategy
 497                                                 &optional
 498                                                 section
 499                                                 outbuf
 500                                                 unread)
 501   "Fetch a message and return as a string.
 502 FOLDER is the ELMO folder structure.
 503 NUMBER is the number of the message in the FOLDER.
 504 STRATEGY is the message fetching strategy.
 505 If optional argument SECTION is specified, only the SECTION of the message
 506 is fetched (if possible).
 507 If second optional argument OUTBUF is specified, fetched message is
 508 inserted to the buffer and returns t if fetch was ended successfully.
 509 If third optional argument UNREAD is non-nil, message is not marked as read.
 510 Returns non-nil if fetching was succeed.")
 511
 512 (luna-define-generic elmo-message-folder (folder number)
 513   "Get primitive folder of the message.")
 514
 515 (luna-define-generic elmo-folder-process-crosspost (folder
 516                                                     &optional
 517                                                     number-alist)
 518   "Process crosspost for FOLDER.
 519 If NUMBER-ALIST is set, it is used as number-alist.
 520 Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
 521
 522 (luna-define-generic elmo-folder-append-msgdb (folder append-msgdb)
 523   "Append  APPEND-MSGDB to the current msgdb of the folder.")
 524
 525 (luna-define-method elmo-folder-open ((folder elmo-folder))
 526   (elmo-generic-folder-open folder))
 527
 528 (defun elmo-generic-folder-open (folder)
 529   (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder))
 530   (elmo-folder-set-killed-list-internal
 531    folder
 532    (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
 533   (elmo-folder-open-internal folder))
 534
 535 (luna-define-method elmo-folder-open-internal ((folder elmo-folder))
 536   nil ; default is do nothing.
 537   )
 538
 539 (luna-define-method elmo-folder-check ((folder elmo-folder))
 540   nil) ; default is noop.
 541
 542 (luna-define-method elmo-folder-commit ((folder elmo-folder))
 543   (elmo-generic-folder-commit folder))
 544
 545 (defun elmo-generic-folder-commit (folder)
 546   (when (elmo-folder-persistent-p folder)
 547     (when (elmo-folder-message-modified-internal folder)
 548       (elmo-msgdb-overview-save
 549        (elmo-folder-msgdb-path folder)
 550        (elmo-msgdb-get-overview (elmo-folder-msgdb-internal folder)))
 551       (elmo-msgdb-number-save
 552        (elmo-folder-msgdb-path folder)
 553        (elmo-msgdb-get-number-alist (elmo-folder-msgdb-internal folder)))
 554       (elmo-folder-set-info-max-by-numdb
 555        folder
 556        (elmo-msgdb-get-number-alist
 557         (elmo-folder-msgdb-internal folder)))
 558       (elmo-folder-set-message-modified-internal folder nil)
 559       (elmo-msgdb-killed-list-save
 560        (elmo-folder-msgdb-path folder)
 561        (elmo-folder-killed-list-internal folder)))
 562     (when (elmo-folder-mark-modified-internal folder)
 563       (elmo-msgdb-mark-save
 564        (elmo-folder-msgdb-path folder)
 565        (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder)))
 566       (elmo-folder-set-mark-modified-internal folder nil))))
 567
 568 (luna-define-method elmo-folder-close-internal ((folder elmo-folder))
 569   ;; do nothing.
 570   )
 571
 572 (luna-define-method elmo-folder-close ((folder elmo-folder))
 573   (elmo-generic-folder-close folder)
 574   (elmo-folder-close-internal folder))
 575
 576 (defun elmo-generic-folder-close (folder)
 577   (elmo-folder-commit folder)
 578   (elmo-folder-set-msgdb-internal folder nil)
 579   (elmo-folder-set-killed-list-internal folder nil))
 580
 581 (luna-define-method elmo-folder-plugged-p ((folder elmo-folder))
 582   t) ; default is plugged.
 583
 584 (luna-define-method elmo-folder-set-plugged ((folder elmo-folder) plugged
 585                                              &optional add)
 586   nil) ; default is do nothing.
 587
 588 (luna-define-method elmo-folder-use-flag-p ((folder elmo-folder))
 589   nil) ; default is no flag.
 590
 591 (luna-define-method elmo-folder-persistent-p ((folder elmo-folder))
 592   (elmo-folder-persistent-internal folder))
 593
 594 (luna-define-method elmo-folder-creatable-p ((folder elmo-folder))
 595   t) ; default is creatable.
 596
 597 (luna-define-method elmo-folder-writable-p ((folder elmo-folder))
 598   t) ; default is writable.
 599
 600 (luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
 601   (let* ((new-folder (elmo-make-folder new-name)))
 602     (unless (eq (elmo-folder-type-internal folder)
 603                 (elmo-folder-type-internal new-folder))
 604       (error "Not same folder type"))
 605     (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
 606             (elmo-folder-exists-p new-folder))
 607         (error "Already exists folder: %s" new-name))
 608     (elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
 609     (elmo-msgdb-rename-path folder new-folder)))
 610
 611 (luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
 612   nil) ; default is noop.
 613
 614 (luna-define-method elmo-folder-update-number ((folder elmo-folder))
 615   nil) ; default is noop.
 616
 617 (luna-define-method elmo-folder-message-file-p ((folder elmo-folder))
 618   nil) ; default is not file.
 619
 620 (luna-define-method elmo-folder-message-file-number-p ((folder elmo-folder))
 621   nil) ; default is not number.
 622
 623 (luna-define-method elmo-folder-message-make-temp-file-p ((folder elmo-folder))
 624   nil) ; default is not make temp file.
 625
 626 (luna-define-method elmo-message-file-name ((folder elmo-folder)
 627                                                    number)
 628   nil) ; default is no name.
 629
 630 (luna-define-method elmo-folder-local-p ((folder elmo-folder))
 631   t)   ; default is local.
 632
 633 ;;; Folder info
 634 ;; Folder info is a message number information cache (hashtable)
 635 (defsubst elmo-folder-get-info (folder &optional hashtb)
 636   "Return FOLDER info from HASHTB (default is `elmo-folder-info-hashtb')."
 637   (elmo-get-hash-val (elmo-folder-name-internal folder)
 638                      (or hashtb elmo-folder-info-hashtb)))
 639
 640 (defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
 641   "Set FOLDER info (means MAX, NUMBERS, NEW and UNREAD)."
 642   (let ((info (elmo-folder-get-info folder)))
 643     (when info
 644       (or new     (setq new     (nth 0 info)))
 645       (or unread  (setq unread  (nth 1 info)))
 646       (or numbers (setq numbers (nth 2 info)))
 647       (or max     (setq max     (nth 3 info))))
 648     (elmo-set-hash-val (elmo-folder-name-internal folder)
 649                        (list new unread numbers max)
 650                        elmo-folder-info-hashtb)))
 651
 652 (defun elmo-folder-set-info-max-by-numdb (folder msgdb-number)
 653   "Set FOLDER info by MSGDB-NUMBER in msgdb."
 654   (let ((num-db (sort (mapcar 'car msgdb-number) '<)))
 655     (elmo-folder-set-info-hashtb
 656      folder
 657      (or (nth (max 0 (1- (length num-db))) num-db) 0)
 658      nil ;;(length num-db)
 659      )))
 660
 661 (defun elmo-folder-get-info-max (folder)
 662   "Return max number of FODLER from folder info."
 663   (nth 3 (elmo-folder-get-info folder)))
 664
 665 (defun elmo-folder-get-info-length (folder)
 666   "Return length of FODLER from folder info."
 667   (nth 2 (elmo-folder-get-info folder)))
 668
 669 (defun elmo-folder-get-info-unread (folder)
 670   "Return unread of FODLER from folder info."
 671   (nth 1 (elmo-folder-get-info folder)))
 672
 673 (defun elmo-folder-info-make-hashtb (info-alist hashtb)
 674   "Setup folder info hashtable by INFO-ALIST on HASHTB."
 675   (let* ((hashtb (or hashtb
 676                      (elmo-make-hash (length info-alist)))))
 677     (mapcar
 678      (lambda (x)
 679        (let ((info (cadr x)))
 680          (and (intern-soft (car x) hashtb)
 681               (elmo-set-hash-val (car x)
 682                                  (list (nth 2 info)   ;; new
 683                                        (nth 3 info)   ;; unread
 684                                        (nth 1 info)   ;; length
 685                                        (nth 0 info))  ;; max
 686                                  hashtb))))
 687      info-alist)
 688     (setq elmo-folder-info-hashtb hashtb)))
 689
 690 (defsubst elmo-strict-folder-diff (folder)
 691   "Return folder diff information strictly from FOLDER."
 692   (let* ((dir (elmo-folder-msgdb-path folder))
 693          (nalist (or (elmo-folder-msgdb-internal folder)
 694                      (elmo-msgdb-number-load dir)))
 695          (in-db (sort (mapcar 'car nalist) '<))
 696          (in-folder  (elmo-folder-list-messages folder))
 697          append-list delete-list diff)
 698     (cons (if (equal in-folder in-db)
 699               0
 700             (setq diff (elmo-list-diff
 701                         in-folder in-db
 702                         nil
 703                         ))
 704             (setq append-list (car diff))
 705             (setq delete-list (cadr diff))
 706             (if append-list
 707                 (length append-list)
 708               (if delete-list
 709                   (- 0 (length delete-list))
 710                 0)))
 711           (length in-folder))))
 712
 713 (luna-define-method elmo-folder-diff ((folder elmo-folder)
 714                                       &optional numbers)
 715   (elmo-generic-folder-diff folder numbers))
 716
 717 (defun elmo-generic-folder-diff (folder numbers)
 718   (if (elmo-string-match-member (elmo-folder-name-internal folder)
 719                                 elmo-strict-diff-folder-list)
 720       (elmo-strict-folder-diff folder)
 721     (let ((cached-in-db-max (elmo-folder-get-info-max folder))
 722           (in-folder (elmo-folder-status folder))
 723           (in-db t)
 724           unsync messages
 725           in-db-max)
 726       (if numbers
 727           (setq in-db-max (or (nth (max 0 (1- (length numbers))) numbers)
 728                               0))
 729         (if (not cached-in-db-max)
 730             (let ((number-list (mapcar 'car
 731                                        (elmo-msgdb-number-load
 732                                         (elmo-folder-msgdb-path folder)))))
 733               ;; No info-cache.
 734               (setq in-db (sort number-list '<))
 735               (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
 736                                   0))
 737               (elmo-folder-set-info-hashtb folder in-db-max nil))
 738           (setq in-db-max cached-in-db-max)))
 739       (setq unsync (if (and in-db
 740                             (car in-folder))
 741                        (- (car in-folder) in-db-max)
 742                      (if (and in-folder
 743                               (null in-db))
 744                          (cdr in-folder)
 745                        (if (null (car in-folder))
 746                            nil))))
 747       (setq messages (cdr in-folder))
 748       (if (and unsync messages (> unsync messages))
 749           (setq unsync messages))
 750       (cons (or unsync 0) (or messages 0)))))
 751
 752 (defvar elmo-folder-diff-async-callback nil)
 753 (defvar elmo-folder-diff-async-callback-data nil)
 754
 755 (luna-define-method elmo-folder-diff-async ((folder elmo-folder))
 756   (and elmo-folder-diff-async-callback
 757        (funcall elmo-folder-diff-async-callback
 758                 folder
 759                 (elmo-folder-diff folder))))
 760
 761 (luna-define-method elmo-folder-get-primitive-list ((folder elmo-folder))
 762   (list folder))
 763
 764 (luna-define-method elmo-folder-contains-type ((folder elmo-folder) type)
 765   (eq (elmo-folder-type-internal folder) type))
 766
 767 (luna-define-method elmo-folder-append-messages ((folder elmo-folder)
 768                                                  src-folder
 769                                                  numbers
 770                                                  unread-marks
 771                                                  &optional
 772                                                  same-number)
 773   (elmo-generic-folder-append-messages folder src-folder numbers
 774                                        unread-marks same-number))
 775
 776 (defun elmo-generic-folder-append-messages (folder src-folder numbers
 777                                                    unread-marks same-number)
 778   (let (unseen seen-list succeed-numbers failure)
 779     (with-temp-buffer
 780       (while numbers
 781         (setq failure nil)
 782         (condition-case nil
 783             (progn
 784               (elmo-message-fetch src-folder (car numbers)
 785                                   (elmo-make-fetch-strategy
 786                                    'entire)
 787                                   nil (current-buffer)
 788                                   'unread)
 789               (unless (eq (buffer-size) 0)
 790                 (elmo-folder-append-buffer
 791                  folder
 792                  (setq unseen (member (elmo-message-mark
 793                                        src-folder (car numbers))
 794                                       unread-marks))
 795                  (if same-number (car numbers)))))
 796           (error (setq failure t)))
 797         ;; FETCH & APPEND finished
 798         (unless failure
 799           (if unseen (setq seen-list (cons
 800                                       (elmo-message-field
 801                                        src-folder (car numbers)
 802                                        'message-id)
 803                                       seen-list)))
 804           (setq succeed-numbers (cons (car numbers) succeed-numbers)))
 805         (setq numbers (cdr numbers)))
 806       (if (and seen-list (elmo-folder-persistent-p folder))
 807           (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder)
 808                                 (nconc (elmo-msgdb-seen-load
 809                                         (elmo-folder-msgdb-path folder))
 810                                        seen-list)))
 811       succeed-numbers)))
 812
 813 ;; Arguments should be reduced.
 814 (defun elmo-folder-move-messages (src-folder msgs dst-folder
 815                                              &optional msgdb all done
 816                                              no-delete-info
 817                                              no-delete
 818                                              same-number
 819                                              unread-marks
 820                                              save-unread)
 821   (save-excursion
 822     (let* ((messages msgs)
 823            (len (length msgs))
 824            (all-msg-num (or all len))
 825            (done-msg-num (or done 0))
 826            (progress-message (if no-delete
 827                                  "Copying messages..."
 828                                "Moving messages..."))
 829            succeeds i result)
 830       (unless (eq dst-folder 'null)
 831         ;; src is already opened.
 832         (when messages
 833           (elmo-folder-open-internal dst-folder)
 834           (unless (setq succeeds (elmo-folder-append-messages dst-folder
 835                                                               src-folder
 836                                                               messages
 837                                                               unread-marks
 838                                                               same-number))
 839             (error "move: append message to %s failed"
 840                    (elmo-folder-name-internal dst-folder)))
 841           (elmo-folder-close dst-folder))
 842         (when (and (elmo-folder-persistent-p dst-folder)
 843                    save-unread)
 844           ;; Save to seen list.
 845           (let* ((dir (elmo-folder-msgdb-path dst-folder))
 846                  (seen-list (elmo-msgdb-seen-load dir)))
 847             (setq seen-list
 848                   (elmo-msgdb-add-msgs-to-seen-list
 849                    msgs (elmo-folder-msgdb-internal src-folder)
 850                    unread-marks seen-list))
 851             (elmo-msgdb-seen-save dir seen-list))))
 852       (when (and done
 853                  (> all-msg-num elmo-display-progress-threshold))
 854         (elmo-display-progress
 855          'elmo-folder-move-messages progress-message
 856          (/ (* done-msg-num 100) all-msg-num)))
 857       (if (and (not no-delete) succeeds)
 858           (progn
 859             (if (not no-delete-info)
 860                 (message "Cleaning up src folder..."))
 861             (if (and (elmo-folder-delete-messages src-folder succeeds)
 862                      (elmo-msgdb-delete-msgs src-folder succeeds))
 863                 (setq result t)
 864               (message "move: delete messages from %s failed."
 865                        (elmo-folder-name-internal src-folder))
 866               (setq result nil))
 867             (if (and result
 868                      (not no-delete-info))
 869                 (message "Cleaning up src folder...done"))
 870             result)
 871         (if no-delete
 872             (progn
 873               (message "Copying messages...done")
 874               t)
 875           (if (eq len 0)
 876               (message "No message was moved.")
 877             (message "Moving messages failed.")
 878             nil ; failure
 879             ))))))
 880
 881 (defun elmo-folder-msgdb-path (folder)
 882   "Return the msgdb path for FOLDER."
 883   (or (elmo-folder-path-internal folder)
 884       (elmo-folder-set-path-internal
 885        folder
 886        (elmo-folder-expand-msgdb-path folder))))
 887
 888 (defun elmo-folder-msgdb (folder)
 889   "Return the msgdb of FOLDER (on-demand loading)."
 890   (or (elmo-folder-msgdb-internal folder)
 891       (elmo-msgdb-load folder)))
 892
 893 (defun elmo-message-mark (folder number)
 894   "Get mark of the message.
 895 FOLDER is the ELMO folder structure.
 896 NUMBER is a number of the message."
 897   (cadr (assq number (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))
 898
 899 (defun elmo-folder-list-messages-mark-match (folder mark-regexp)
 900   "List messages in the FOLDER which have a mark that matches MARK-REGEXP"
 901   (let ((case-fold-search nil)
 902         matched)
 903     (if mark-regexp
 904         (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
 905           (if (string-match mark-regexp (cadr elem))
 906               (setq matched (cons (car elem) matched)))))
 907     matched))
 908
 909 (defun elmo-message-field (folder number field)
 910   "Get message field value in the msgdb.
 911 FOLDER is the ELMO folder structure.
 912 NUMBER is a number of the message.
 913 FIELD is a symbol of the field."
 914   (case field
 915     (message-id (elmo-msgdb-overview-entity-get-id
 916                  (elmo-msgdb-overview-get-entity
 917                   number (elmo-folder-msgdb folder))))
 918     (subject (elmo-msgdb-overview-entity-get-subject
 919               (elmo-msgdb-overview-get-entity
 920                number (elmo-folder-msgdb folder))))
 921     (size (elmo-msgdb-overview-entity-get-size
 922            (elmo-msgdb-overview-get-entity
 923             number (elmo-folder-msgdb folder))))
 924     (date (elmo-msgdb-overview-entity-get-date
 925            (elmo-msgdb-overview-get-entity
 926             number (elmo-folder-msgdb folder))))
 927     (to (elmo-msgdb-overview-entity-get-to
 928          (elmo-msgdb-overview-get-entity
 929           number (elmo-folder-msgdb folder))))
 930     (cc (elmo-msgdb-overview-entity-get-cc
 931          (elmo-msgdb-overview-get-entity
 932           number (elmo-folder-msgdb folder))))))
 933
 934 (defun elmo-message-set-mark (folder number mark)
 935   "Set mark for the message in the FOLDER with NUMBER as MARK."
 936   (elmo-msgdb-set-mark-alist
 937    (elmo-folder-msgdb-internal folder)
 938    (elmo-msgdb-mark-set
 939     (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder))
 940     number mark)))
 941
 942 (luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number)
 943   nil) ; default is not use cache.
 944
 945 (luna-define-method elmo-message-folder ((folder elmo-folder) number)
 946   folder) ; default is folder
 947
 948 (luna-define-method elmo-folder-unmark-important ((folder elmo-folder) numbers)
 949   t)
 950
 951 (luna-define-method elmo-folder-mark-as-important ((folder elmo-folder)
 952                                                    numbers)
 953   t)
 954
 955 (luna-define-method elmo-folder-unmark-read ((folder elmo-folder) numbers)
 956   t)
 957
 958 (luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) numbers)
 959   t)
 960
 961 (luna-define-method elmo-folder-process-crosspost ((folder elmo-folder)
 962                                                    &optional
 963                                                    number-alist)
 964   ;; Do nothing.
 965   )
 966
 967 (defun elmo-generic-folder-append-msgdb (folder append-msgdb)
 968   (if append-msgdb
 969       (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
 970              (all-alist (copy-sequence (append
 971                                         (elmo-msgdb-get-number-alist
 972                                          (elmo-folder-msgdb-internal folder))
 973                                         number-alist)))
 974              (cur number-alist)
 975              pair
 976              to-be-deleted
 977              mark-alist)
 978         (while cur
 979           (setq all-alist (delq (car cur) all-alist))
 980           ;; same message id exists.
 981           (if (setq pair (rassoc (cdr (car cur)) all-alist))
 982               (setq to-be-deleted (nconc to-be-deleted (list (car pair)))))
 983           (setq cur (cdr cur)))
 984         ;; XXXX If caching is enabled, read-uncached mark should be set.
 985         (setq mark-alist (elmo-delete-if
 986                           (function
 987                            (lambda (x)
 988                              (memq (car x) to-be-deleted)))
 989                           (elmo-msgdb-get-mark-alist append-msgdb)))
 990         (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
 991         (elmo-folder-set-msgdb-internal folder
 992                                         (elmo-msgdb-append
 993                                          (elmo-folder-msgdb-internal folder)
 994                                          append-msgdb t))
 995         (length to-be-deleted))
 996     0))
 997
 998 (luna-define-method elmo-folder-append-msgdb ((folder elmo-folder)
 999                                               append-msgdb)
1000   (elmo-generic-folder-append-msgdb folder append-msgdb))
1001
1002 (defun elmo-folder-confirm-appends (appends)
1003   (let ((len (length appends))
1004         in)
1005     (if (and (> len elmo-folder-update-threshold)
1006              elmo-folder-update-confirm)
1007         (if (y-or-n-p (format "Too many messages(%d).  Continue? " len))
1008             appends
1009           (setq in elmo-folder-update-threshold)
1010           (catch 'end
1011             (while t
1012               (setq in (read-from-minibuffer "Update number: "
1013                                              (int-to-string in))
1014                     in (string-to-int in))
1015               (if (< len in)
1016                   (throw 'end len))
1017               (if (y-or-n-p (format "%d messages are disappeared.  OK? "
1018                                     (max (- len in) 0)))
1019                   (throw 'end in))))
1020           (nthcdr (max (- len in) 0) appends))
1021       (if (and (> len elmo-folder-update-threshold)
1022                (not elmo-folder-update-confirm))
1023           (nthcdr (max (- len elmo-folder-update-threshold) 0) appends)
1024         appends))))
1025
1026 (defun elmo-folder-synchronize (folder
1027                                 new-mark             ;"N"
1028                                 unread-uncached-mark ;"U"
1029                                 unread-cached-mark   ;"!"
1030                                 read-uncached-mark   ;"u"
1031                                 important-mark       ;"$"
1032                                 &optional ignore-msgdb)
1033   "Synchronize the folder data to the newest status.
1034 FOLDER is the ELMO folder structure.
1035 NEW-MARK, UNREAD-CACHED-MARK, READ-UNCACHED-MARK, and IMPORTANT-MARK
1036 are mark strings for new messages, unread but cached messages,
1037 read but not cached messages, and important messages.
1038 If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except
1039 read mark status. If IGNORE-MSGDB is 'visible-only, only visible messages
1040 are thrown away and synchronized.
1041
1042 Return a list of
1043 \(NEW-MSGDB DELETE-LIST CROSSED\)
1044 NEW-MSGDB is the newly appended msgdb.
1045 DELETE-LIST is a list of deleted message number.
1046 CROSSED is cross-posted message number."
1047   (let ((killed-list (elmo-folder-killed-list-internal folder))
1048         (before-append t)
1049         number-alist mark-alist
1050         old-msgdb diff diff-2 delete-list new-list new-msgdb mark
1051         seen-list crossed after-append)
1052     (setq old-msgdb (elmo-folder-msgdb-internal folder))
1053     ;; Load seen-list.
1054     (setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder)))
1055     (setq number-alist (elmo-msgdb-get-number-alist
1056                         (elmo-folder-msgdb-internal folder)))
1057     (setq mark-alist (elmo-msgdb-get-mark-alist
1058                       (elmo-folder-msgdb-internal folder)))
1059     (if ignore-msgdb
1060         (progn
1061           (setq seen-list (nconc
1062                            (elmo-msgdb-mark-alist-to-seen-list
1063                             number-alist mark-alist
1064                             (concat important-mark read-uncached-mark))
1065                            seen-list))
1066           ;; Make killed list as nil.
1067           (unless (eq ignore-msgdb 'visible-only)
1068             (elmo-folder-set-killed-list-internal folder nil))
1069           (elmo-folder-set-msgdb-internal folder
1070                                           (elmo-msgdb-clear))))
1071     (elmo-folder-check folder)
1072     (condition-case nil
1073         (progn
1074           (message "Checking folder diff...")
1075           ;; TODO: killed list is loaded in elmo-folder-open and
1076           ;; list-messages use internal killed-list-folder.
1077           (setq diff (elmo-list-diff (elmo-folder-list-messages
1078                                       folder
1079                                       (eq 'visible-only ignore-msgdb))
1080                                      (unless ignore-msgdb
1081                                        (sort (mapcar
1082                                               'car
1083                                               number-alist)
1084                                              '<))))
1085           (message "Checking folder diff...done")
1086           (setq new-list (elmo-folder-confirm-appends (car diff)))
1087           ;; Set killed list.
1088           (when (and (not (eq (length (car diff))
1089                               (length new-list)))
1090                      (setq diff-2 (elmo-list-diff (car diff) new-list)))
1091             (elmo-msgdb-append-to-killed-list folder (car diff-2)))
1092           ;; Don't delete important marked messages.
1093           (setq delete-list
1094                 (elmo-delete-if
1095                  (lambda (x)
1096                    (and (setq mark (cadr (assq x mark-alist)))
1097                         (string= mark important-mark)))
1098                  ;; delete message list
1099                  (cadr diff)))
1100           (if (or (equal diff '(nil nil))
1101                   (equal diff '(nil))
1102                   (and (eq (length (car diff)) 0)
1103                        (eq (length (cadr diff)) 0)))
1104               (progn
1105                 (elmo-folder-update-number folder)
1106                 (elmo-folder-process-crosspost folder)
1107                 nil ; no update.
1108                 )
1109             (if delete-list (elmo-msgdb-delete-msgs folder delete-list))
1110             (when new-list
1111               (setq new-msgdb (elmo-folder-msgdb-create
1112                                folder
1113                                new-list
1114                                new-mark unread-cached-mark
1115                                read-uncached-mark important-mark
1116                                seen-list))
1117               (elmo-msgdb-change-mark (elmo-folder-msgdb-internal folder)
1118                                       new-mark unread-uncached-mark)
1119               ;; Clear seen-list.
1120               (if (elmo-folder-persistent-p folder)
1121                   (setq seen-list (elmo-msgdb-seen-save
1122                                    (elmo-folder-msgdb-path folder) nil)))
1123               (setq before-append nil)
1124               (setq crossed (elmo-folder-append-msgdb folder new-msgdb))
1125               ;; process crosspost.
1126               ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).
1127               (elmo-folder-process-crosspost folder)
1128               (elmo-folder-set-message-modified-internal folder t)
1129               (elmo-folder-set-mark-modified-internal folder t)
1130               ;; return value.
1131               (list new-msgdb delete-list crossed))))
1132       (quit
1133        ;; Resume to the original status.
1134        (if before-append
1135            (elmo-folder-set-msgdb-internal folder old-msgdb))
1136        (elmo-folder-set-killed-list-internal folder killed-list)
1137        nil))))
1138
1139 (defun elmo-folder-messages (folder)
1140   "Return number of messages in the FOLDER."
1141   (length
1142    (elmo-msgdb-get-number-alist
1143     (elmo-folder-msgdb-internal folder))))
1144
1145 ;;;
1146 (defun elmo-msgdb-search (folder condition msgdb)
1147   "Search messages which satisfy CONDITION from FOLDER with MSGDB."
1148   (let* ((condition (car (elmo-parse-search-condition condition)))
1149          (overview (elmo-msgdb-get-overview msgdb))
1150          (number-alist (elmo-msgdb-get-number-alist msgdb))
1151          (number-list (mapcar 'car number-alist))
1152          (length (length overview))
1153          (i 0)
1154          result)
1155     (if (elmo-condition-find-key condition "body")
1156         (elmo-folder-search folder condition number-list)
1157       (while overview
1158         (if (elmo-msgdb-search-internal condition (car overview)
1159                                         number-list)
1160             (setq result
1161                   (cons
1162                    (elmo-msgdb-overview-entity-get-number (car overview))
1163                    result)))
1164         (setq i (1+ i))
1165         (elmo-display-progress
1166          'elmo-msgdb-search "Searching..." (/ (* i 100) length))
1167         (setq overview (cdr overview)))
1168       (nreverse result))))
1169
1170 (defun elmo-msgdb-load (folder)
1171   (message "Loading msgdb for %s..." (elmo-folder-name-internal folder))
1172   (let* ((path (elmo-folder-msgdb-path folder))
1173          (overview (elmo-msgdb-overview-load path))
1174          (msgdb (list overview
1175                       (elmo-msgdb-number-load path)
1176                       (elmo-msgdb-mark-load path)
1177                       (elmo-msgdb-make-overview-hashtb overview))))
1178     (message "Loading msgdb for %s...done" (elmo-folder-name-internal folder))
1179     (elmo-folder-set-info-max-by-numdb folder
1180                                        (elmo-msgdb-get-number-alist msgdb))
1181     msgdb))
1182
1183 (defun elmo-msgdb-delete-path (folder)
1184   (let ((path (elmo-folder-msgdb-path folder)))
1185     (if (file-directory-p path)
1186         (elmo-delete-directory path t))))
1187
1188 (defun elmo-msgdb-rename-path (old-folder new-folder)
1189   (let* ((old (directory-file-name (elmo-folder-msgdb-path old-folder)))
1190          (new (directory-file-name (elmo-folder-msgdb-path new-folder)))
1191          (new-dir (directory-file-name (file-name-directory new))))
1192     (if (not (file-directory-p old))
1193         ()
1194       (if (file-exists-p new)
1195           (error "Already exists directory: %s" new)
1196         (if (not (file-exists-p new-dir))
1197             (elmo-make-directory new-dir))
1198         (rename-file old new)))))
1199
1200 (defun elmo-setup-subscribed-newsgroups (groups)
1201   "Setup subscribed newsgroups.
1202 GROUPS is a list of newsgroup name string.
1203 Return a hashtable for newsgroups."
1204   (let ((hashtb (or elmo-newsgroups-hashtb
1205                     (setq elmo-newsgroups-hashtb
1206                           (elmo-make-hash (length groups))))))
1207     (dolist (group groups)
1208       (or (elmo-get-hash-val group hashtb)
1209           (elmo-set-hash-val group nil hashtb)))
1210     (setq elmo-newsgroups-hashtb hashtb)))
1211
1212 (defvar elmo-crosspost-message-alist-modified nil)
1213 (defun elmo-crosspost-message-alist-load ()
1214   "Load crosspost message alist."
1215   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
1216   (setq elmo-crosspost-message-alist-modified nil))
1217
1218 (defun elmo-crosspost-message-alist-save ()
1219   "Save crosspost message alist."
1220   (when elmo-crosspost-message-alist-modified
1221     (let ((alist elmo-crosspost-message-alist)
1222           newsgroups)
1223       (while alist
1224         (setq newsgroups
1225               (elmo-delete-if
1226                '(lambda (x)
1227                   (not (intern-soft x elmo-newsgroups-hashtb)))
1228                (nth 1 (car alist))))
1229         (if newsgroups
1230             (setcar (cdar alist) newsgroups)
1231           (setq elmo-crosspost-message-alist
1232                 (delete (car alist) elmo-crosspost-message-alist)))
1233         (setq alist (cdr alist)))
1234       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
1235       (setq elmo-crosspost-message-alist-modified nil))))
1236
1237 (defun elmo-folder-make-temp-dir (folder)
1238   ;; Make a temporary directory for FOLDER.
1239   (let ((temp-dir (make-temp-name
1240                    (concat
1241                     (file-name-as-directory (elmo-folder-msgdb-path folder))
1242                     "elmo"))))
1243     (elmo-make-directory temp-dir)
1244     temp-dir))
1245
1246 (defun elmo-init ()
1247   "Initialize ELMO module."
1248   (elmo-crosspost-message-alist-load)
1249   (elmo-resque-obsolete-variables))
1250
1251 (defun elmo-quit ()
1252   "Quit and cleanup ELMO."
1253 ;  (setq elmo-newsgroups-hashtb nil)
1254   (elmo-crosspost-message-alist-save)
1255   ;; Not implemented yet.
1256   (let ((types elmo-folder-type-alist)
1257         class)
1258     (while types
1259       (setq class
1260             (luna-find-class
1261              (intern (format "elmo-%s-folder" (symbol-name (cdr (car types)))))))
1262       ;; Call all folder's `elmo-quit' method.
1263       (if class
1264           (dolist (func (luna-class-find-functions class 'elmo-quit))
1265             (funcall func nil)))
1266       (setq types (cdr types)))))
1267
1268
1269 ;;; Define folders.
1270 (elmo-define-folder ?% 'imap4)
1271 (elmo-define-folder ?-  'nntp)
1272 (elmo-define-folder ?\+ 'localdir)
1273 (elmo-define-folder ?\* 'multi)
1274 (elmo-define-folder ?\/ 'filter)
1275 (elmo-define-folder ?\$ 'archive)
1276 (elmo-define-folder ?&  'pop3)
1277 (elmo-define-folder ?=  'localnews)
1278 (elmo-define-folder ?|  'pipe)
1279 (elmo-define-folder ?.  'maildir)
1280 (elmo-define-folder ?'  'internal)
1281 (elmo-define-folder ?[  'nmz)
1282
1283 (require 'product)
1284 (product-provide (provide 'elmo) (require 'elmo-version))
1285
1286 ;;; elmo.el ends here