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   "If non-nil, confirm fetching if message size is larger than
  54 `elmo-message-fetch-threshold'.
  55 Otherwise, entire fetching of the message is aborted without confirmation."
  56   :type 'boolean
  57   :group 'elmo)
  58
  59 (defcustom elmo-folder-update-threshold 500
  60   "Update threshold."
  61   :type 'integer
  62   :group 'elmo)
  63
  64 (defcustom elmo-folder-update-confirm t
  65   "Confirm if update number exceeds `elmo-folder-update-threshold'."
  66   :type 'boolean
  67   :group 'elmo)
  68
  69 (defvar elmo-message-displaying nil
  70   "A global switch to indicate message is displaying or not.")
  71
  72 ;;; internal
  73 (defvar elmo-folder-type-alist nil)
  74
  75 (defvar elmo-newsgroups-hashtb nil)
  76
  77 (elmo-define-error 'elmo-error "Error" 'error)
  78 (elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error)
  79 (elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error)
  80 (elmo-define-error 'elmo-imap4-bye-error "IMAP4 session was terminated" 'elmo-open-error)
  81
  82 (defun elmo-define-folder (prefix backend)
  83   "Define a folder.
  84 If a folder name begins with PREFIX, use BACKEND."
  85   (let ((pair (assq prefix elmo-folder-type-alist)))
  86     (if pair
  87         (progn
  88           (setcar pair prefix)
  89           (setcdr pair backend))
  90       (setq elmo-folder-type-alist (cons (cons prefix backend)
  91                                          elmo-folder-type-alist)))))
  92
  93 (defmacro elmo-folder-type (name)
  94   "Get folder type from NAME string."
  95   (` (and (stringp (, name))
  96           (cdr (assoc (string-to-char (, name)) elmo-folder-type-alist)))))
  97
  98 ;;; ELMO folder
  99 ;; A elmo folder provides uniformed (orchestrated) access
 100 ;; to the internet messages.
 101 (eval-and-compile
 102   (luna-define-class elmo-folder () (type   ; folder type symbol.
 103                                      name   ; orignal folder name string.
 104                                      prefix ; prefix for folder name
 105                                      path   ; directory path for msgdb.
 106                                      msgdb  ; msgdb (may be nil).
 107                                      killed-list  ; killed list.
 108                                      persistent   ; non-nil if persistent.
 109                                      message-modified ; message is modified.
 110                                      mark-modified    ; mark is modified.
 111                                      process-duplicates  ; read or hide
 112                                      biff   ; folder for biff
 113                                      ))
 114   (luna-define-internal-accessors 'elmo-folder))
 115
 116 (luna-define-generic elmo-folder-initialize (folder name)
 117   ;; Initialize a FOLDER structure with NAME."
 118   )
 119
 120 (defmacro elmo-folder-send (folder message &rest args)
 121   "Let FOLDER receive the MESSAGE with ARGS."
 122   (` (luna-send (, folder) (, message) (, folder) (,@ args))))
 123
 124 ;;;###autoload
 125 (defun elmo-make-folder (name &optional non-persistent)
 126   "Make an ELMO folder structure specified by NAME.
 127 If optional argument NON-PERSISTENT is non-nil, folder is treated as
 128  non-persistent."
 129   (let ((type (elmo-folder-type name))
 130         prefix split class folder original)
 131     (setq original (elmo-string name))
 132     (if type
 133         (progn
 134           (setq prefix (substring name 0 1))
 135           (setq name (substring name 1)))
 136       (setq type (intern (car (setq split (split-string name ":")))))
 137       (if (> (length split) 2)
 138           (setq name (substring name (+ 1 (length (car split)))))
 139         (error "Error in folder name `%s'" original))
 140       (setq prefix (concat (car split) ":")))
 141     (setq class (format "elmo-%s" (symbol-name type)))
 142     (require (intern class))
 143     (setq folder (luna-make-entity (intern (concat class "-folder"))
 144                                    :type   type
 145                                    :prefix prefix
 146                                    :name original
 147                                    :persistent (not non-persistent)))
 148     (save-match-data
 149       (elmo-folder-send folder 'elmo-folder-initialize name))))
 150
 151 (luna-define-generic elmo-folder-msgdb (folder)
 152   "Return the msgdb of FOLDER (on-demand loading).")
 153
 154 (luna-define-method elmo-folder-msgdb ((folder elmo-folder))
 155   (or (elmo-folder-msgdb-internal folder)
 156       (elmo-folder-set-msgdb-internal folder
 157                                       (elmo-msgdb-load folder))))
 158
 159 (luna-define-generic elmo-folder-open (folder &optional load-msgdb)
 160   "Open and setup (load saved status) FOLDER.
 161 If optional LOAD-MSGDB is non-nil, msgdb is loaded.
 162 (otherwise, msgdb is loaded on-demand)")
 163
 164 (luna-define-generic elmo-folder-open-internal (folder)
 165   "Open FOLDER (without loading saved folder status).")
 166
 167 (luna-define-generic elmo-folder-check (folder)
 168   "Check the FOLDER to obtain newest information at the next list operation.")
 169
 170 (luna-define-generic elmo-folder-clear (folder &optional keep-killed)
 171   "Clear FOLDER to the initial state.
 172 If optional KEEP-KILLED is non-nil, killed-list is not cleared.")
 173
 174 (luna-define-generic elmo-folder-commit (folder)
 175   "Save current status of FOLDER.")
 176
 177 (luna-define-generic elmo-folder-close (folder)
 178   "Close, save and clearnup FOLDER.")
 179
 180 (luna-define-generic elmo-folder-close-internal (folder)
 181   "Close FOLDER (without saving folder status).")
 182
 183 (luna-define-generic elmo-folder-plugged-p (folder)
 184   "Returns t if FOLDER is plugged.")
 185
 186 (luna-define-generic elmo-folder-set-plugged (folder plugged &optional add)
 187   "Set FOLDER as plugged.")
 188
 189 (luna-define-generic elmo-net-port-info (folder)
 190   "Get port information of FOLDER.")
 191
 192 (luna-define-generic elmo-folder-use-flag-p (folder)
 193   "Returns t if FOLDER treats unread/important flag itself.")
 194
 195 (luna-define-generic elmo-folder-diff (folder &optional numbers)
 196   "Get diff of FOLDER.
 197 If optional NUMBERS is set, it is used as current NUMBERS.
 198 Otherwise, saved status for folder is used for comparison.
 199 Return value is cons cell or list:
 200  - a cons cell (NEWS . MESSAGES)
 201  - a list (RECENT UNSEEN MESSAGES) ; RECENT means NEWS, UNSEEN means UNREAD.")
 202
 203 (luna-define-generic elmo-folder-status (folder)
 204   "Returns a cons cell of (MAX-NUMBER . MESSAGES) in the FOLDER.")
 205
 206 (luna-define-generic elmo-folder-reserve-status-p (folder)
 207   "If non-nil, the folder should not close folder after `elmo-folder-status'.")
 208
 209 (defun elmo-folder-list-messages (folder &optional visible-only in-msgdb)
 210   "Return a list of message numbers contained in FOLDER.
 211 If optional VISIBLE-ONLY is non-nil, killed messages are not listed.
 212 If second optional IN-MSGDB is non-nil, only messages in the msgdb are listed."
 213   (let ((list (if in-msgdb
 214                   t
 215                 (elmo-folder-list-messages-internal folder visible-only))))
 216     (elmo-living-messages
 217      (if (listp list)
 218          list
 219        ;; Use current list.
 220        (mapcar
 221         'car
 222         (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder))))
 223      (elmo-folder-killed-list-internal folder))))
 224
 225 (luna-define-generic elmo-folder-list-unreads (folder)
 226   "Return a list of unread message numbers contained in FOLDER.")
 227 (luna-define-generic elmo-folder-list-importants (folder)
 228   "Return a list of important message numbers contained in FOLDER.")
 229 (luna-define-generic elmo-folder-list-answereds (folder)
 230   "Return a list of answered message numbers contained in FOLDER.")
 231
 232 (luna-define-method elmo-folder-list-unreads ((folder elmo-folder))
 233   (delq nil
 234         (mapcar
 235          (lambda (x)
 236            (if (member (cadr x) (elmo-msgdb-unread-marks))
 237                (car x)))
 238          (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))
 239
 240 ;; TODO: Should reconsider the structure of global mark.
 241 (defun elmo-folder-list-messages-with-global-mark (folder mark)
 242   (let (entity msgs)
 243     (dolist (mark-pair (or elmo-msgdb-global-mark-alist
 244                            (setq elmo-msgdb-global-mark-alist
 245                                  (elmo-object-load
 246                                   (expand-file-name
 247                                    elmo-msgdb-global-mark-filename
 248                                    elmo-msgdb-directory)))))
 249       (if (and (string= mark (cdr mark-pair))
 250                (setq entity
 251                      (elmo-msgdb-overview-get-entity (car mark-pair)
 252                                                      (elmo-folder-msgdb
 253                                                       folder))))
 254           (setq msgs (cons (elmo-msgdb-overview-entity-get-number entity)
 255                            msgs))))
 256     msgs))
 257
 258 (luna-define-method elmo-folder-list-importants ((folder elmo-folder))
 259   (elmo-folder-list-messages-mark-match folder
 260                                         (regexp-quote
 261                                          elmo-msgdb-important-mark)))
 262
 263 (luna-define-method elmo-folder-list-answereds ((folder elmo-folder))
 264   (delq nil
 265         (mapcar
 266          (function
 267           (lambda (x)
 268             (if (member (cadr x) (elmo-msgdb-answered-marks))
 269                 (car x))))
 270          (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))
 271
 272 (luna-define-generic elmo-folder-list-messages-internal (folder &optional
 273                                                                 visible-only)
 274   ;; Return a list of message numbers contained in FOLDER.
 275   ;; Return t if the message list is not available.
 276   )
 277
 278 (luna-define-generic elmo-folder-list-subfolders (folder &optional one-level)
 279   "Returns a list of subfolders contained in FOLDER.
 280 If optional argument ONE-LEVEL is non-nil, only children of FOLDER is returned.
 281 \(a folder which have children is returned as a list\)
 282 Otherwise, all descendent folders are returned.")
 283
 284 (luna-define-generic elmo-folder-have-subfolder-p (folder)
 285   "Return non-nil when FOLDER has subfolders.")
 286
 287 (luna-define-generic elmo-folder-exists-p (folder)
 288   "Returns non-nil when FOLDER exists.")
 289
 290 (luna-define-generic elmo-folder-creatable-p (folder)
 291   "Returns non-nil when FOLDER is creatable.")
 292
 293 (luna-define-generic elmo-folder-writable-p (folder)
 294   "Returns non-nil when FOLDER is writable.")
 295
 296 (luna-define-generic elmo-folder-persistent-p (folder)
 297   "Return non-nil when FOLDER is persistent.")
 298
 299 (luna-define-generic elmo-folder-create (folder)
 300   "Create a FOLDER.")
 301
 302 (luna-define-generic elmo-message-deletable-p (folder number)
 303   "Returns non-nil when the message in the FOLDER with NUMBER is deletable.")
 304
 305 (luna-define-generic elmo-folder-delete (folder)
 306   "Delete FOLDER completely.")
 307
 308 (luna-define-generic elmo-folder-rename (folder new-name)
 309   "Rename FOLDER to NEW-NAME (string).")
 310
 311 (luna-define-generic elmo-folder-delete-messages (folder numbers)
 312   "Delete messages.
 313 FOLDER is the ELMO folder structure.
 314 NUMBERS is a list of message numbers to be deleted.")
 315
 316 (luna-define-generic elmo-folder-search (folder condition &optional numbers)
 317   "Search and return list of message numbers.
 318 FOLDER is the ELMO folder structure.
 319 CONDITION is a condition structure for searching.
 320 If optional argument NUMBERS is specified and is a list of message numbers,
 321 messages are searched from the list.")
 322
 323 (luna-define-generic elmo-message-match-condition (folder number
 324                                                           condition
 325                                                           numbers)
 326   "Return non-nil when the message in the FOLDER with NUMBER is matched.
 327 CONDITION is a condition structure for testing.
 328 NUMBERS is a list of message numbers,
 329 use to be test for \"last\" and \"first\" predicates.")
 330
 331 (luna-define-generic elmo-folder-msgdb-create (folder numbers id-mark-table)
 332   "Create a message database (implemented in each backends).
 333 FOLDER is the ELMO folder structure.
 334 NUMBERS is a list of message numbers to create msgdb.
 335 ID-MARK-TABLE is a hashtable of message-id and its status mark.")
 336
 337 (luna-define-generic elmo-folder-unmark-important (folder numbers)
 338   "Un-mark messages as important.
 339 FOLDER is the ELMO folder structure.
 340 NUMBERS is a list of message numbers to be processed.")
 341
 342 (luna-define-generic elmo-folder-mark-as-important (folder numbers)
 343   "Mark messages as important.
 344 FOLDER is the ELMO folder structure.
 345 NUMBERS is a list of message numbers to be processed.")
 346
 347 (luna-define-generic elmo-folder-unmark-read (folder numbers
 348                                                      &optional ignore-flags)
 349   "Un-mark messages as read.
 350 FOLDER is the ELMO folder structure.
 351 NUMBERS is a list of message numbers to be processed.
 352 If IGNORE-FLAGS is non-nil, folder flags are not updated.")
 353
 354 (luna-define-generic elmo-folder-mark-as-read (folder numbers
 355                                                       &optional ignore-flags)
 356   "Mark messages as read.
 357 FOLDER is the ELMO folder structure.
 358 NUMBERS is a list of message numbers to be processed.
 359 If IGNORE-FLAGS is non-nil, folder flags are not updated.")
 360
 361 (luna-define-generic elmo-folder-unmark-answered (folder numbers)
 362   "Un-mark messages as answered.
 363 FOLDER is the ELMO folder structure.
 364 NUMBERS is a list of message numbers to be processed.")
 365
 366 (luna-define-generic elmo-folder-mark-as-answered (folder numbers)
 367   "Mark messages as answered.
 368 FOLDER is the ELMO folder structure.
 369 NUMBERS is a list of message numbers to be processed.")
 370
 371 (luna-define-generic elmo-folder-append-buffer (folder unread &optional number)
 372   "Append current buffer as a new message.
 373 FOLDER is the destination folder(ELMO folder structure).
 374 If UNREAD is non-nil, message is appended as unread.
 375 If optional argument NUMBER is specified, the new message number is set
 376 (if possible).")
 377
 378 (luna-define-generic elmo-folder-append-messages (folder
 379                                                   src-folder
 380                                                   numbers
 381                                                   &optional
 382                                                   same-number)
 383   "Append messages from folder.
 384 FOLDER is the ELMO folder structure.
 385 Caller should make sure FOLDER is `writable'.
 386 (Can be checked with `elmo-folder-writable-p').
 387 SRC-FOLDER is the source ELMO folder structure.
 388 NUMBERS is the message numbers to be appended in the SRC-FOLDER.
 389 If second optional argument SAME-NUMBER is specified,
 390 message number is preserved (if possible).")
 391
 392 (luna-define-generic elmo-folder-pack-numbers (folder)
 393   "Pack message numbers of FOLDER.")
 394
 395 (luna-define-generic elmo-folder-update-number (folder)
 396   "Update number of FOLDER.")
 397
 398 (luna-define-generic elmo-folder-diff-async (folder)
 399   "Get diff of FOLDER asynchronously.")
 400
 401 (luna-define-generic elmo-folder-expand-msgdb-path (folder)
 402   "Expand path for FOLDER.")
 403
 404 (luna-define-generic elmo-folder-get-primitive-list (folder)
 405   "Get primitive folder structure list contained in FOLDER.")
 406
 407 (luna-define-generic elmo-folder-contains-type (folder type)
 408   "Returns t if FOLDER contains TYPE.")
 409
 410 (luna-define-generic elmo-folder-local-p (folder)
 411   "Returns t if FOLDER is local.")
 412
 413 (luna-define-generic elmo-folder-message-file-p (folder)
 414   "Returns t if all messages in the FOLDER are files.")
 415
 416 ;;; Message methods.
 417 (luna-define-generic elmo-message-use-cache-p (folder number)
 418   "Returns t if the message in the FOLDER with NUMBER uses cache.")
 419
 420 (luna-define-generic elmo-message-file-name (folder number)
 421   "Return the file name of a message specified by FOLDER and NUMBER.")
 422
 423 ;;; For archive
 424
 425 ;;; Use original file
 426 (luna-define-generic elmo-folder-message-file-number-p (folder)
 427   "Return t if the file name in the FOLDER is the message number.")
 428
 429 (luna-define-generic elmo-folder-message-file-directory (folder)
 430   "Return the directory of the message files of FOLDER.")
 431
 432 ;;; Use temporary file
 433 (luna-define-generic elmo-folder-message-make-temp-file-p (folder)
 434   "Return t if the messages in the FOLDER makes local temporary file.")
 435
 436 (luna-define-generic elmo-folder-message-make-temp-files (folder
 437                                                           numbers
 438                                                           &optional
 439                                                           start-number)
 440   "Make a new temporary files from the messages in the FOLDER with NUMBERS.
 441 If START-NUMBER is specified, temporary files begin from the number.
 442 Otherwise, same number is used for temporary files.
 443 Return newly created temporary directory name which contains temporary files.")
 444
 445 (luna-define-generic elmo-message-file-p (folder number)
 446   "Return t if message in the FOLDER with NUMBER is a file.")
 447
 448 (luna-define-generic elmo-find-fetch-strategy
 449   (folder entity &optional ignore-cache)
 450 ;; Returns the message fetching strategy suitable for the message.
 451 ;; FOLDER is the ELMO folder structure.
 452 ;; ENTITY is the overview entity of the message in the folder.
 453 ;; If optional argument IGNORE-CACHE is non-nil, cache is ignored.
 454 ;; Returned value is a elmo-fetch-strategy object.
 455 ;; If return value is nil, message should not be nil.
 456   )
 457
 458 (defmacro elmo-make-fetch-strategy (entireness
 459                                     &optional
 460                                     use-cache
 461                                     save-cache
 462                                     cache-path)
 463 ;; Make elmo-message-fetching strategy.
 464 ;; ENTIRENESS is 'entire or 'section.
 465 ;; 'entire means fetch message entirely at once.
 466 ;; 'section means fetch message section by section.
 467 ;; If optional USE-CACHE is non-nil, existing cache is used and otherwise,
 468 ;; existing cache is thrown away.
 469 ;; If SAVE-CACHE is non-nil, fetched message is saved.
 470 ;; CACHE-PATH is the cache path to be used as a message cache file.
 471   (` (vector (, entireness)
 472              (, use-cache) (, save-cache) (, cache-path))))
 473
 474 (defmacro elmo-fetch-strategy-entireness (strategy)
 475   ;; Return entireness of STRATEGY.
 476   (` (aref (, strategy) 0)))
 477
 478 (defmacro elmo-fetch-strategy-use-cache (strategy)
 479   ;; Return use-cache of STRATEGY.
 480   (` (aref (, strategy) 1)))
 481
 482 (defmacro elmo-fetch-strategy-save-cache (strategy)
 483   ;; Return save-cache of STRATEGY.
 484   (` (aref (, strategy) 2)))
 485
 486 (defmacro elmo-fetch-strategy-cache-path (strategy)
 487   ;;  Return cache-path of STRATEGY.
 488   (` (aref (, strategy) 3)))
 489
 490 (luna-define-method elmo-find-fetch-strategy
 491   ((folder elmo-folder) entity &optional ignore-cache)
 492   (let (cache-file size message-id number)
 493     (setq size (elmo-msgdb-overview-entity-get-size entity))
 494     (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 495     (setq number (elmo-msgdb-overview-entity-get-number entity))
 496     (setq cache-file (elmo-file-cache-get message-id))
 497     (setq ignore-cache (or ignore-cache
 498                            (null (elmo-message-use-cache-p folder number))))
 499     (if (or ignore-cache
 500             (null (elmo-file-cache-status cache-file)))
 501         ;; No cache or ignore-cache.
 502         (if (and (not (elmo-folder-local-p folder))
 503                  elmo-message-fetch-threshold
 504                  (integerp size)
 505                  (>= size elmo-message-fetch-threshold)
 506                  (or (not elmo-message-fetch-confirm)
 507                      (not (prog1 (y-or-n-p
 508                                   (format "Fetch entire message(%dbytes)? "
 509                                           size))
 510                             (message "")))))
 511             ;; Don't fetch message at all.
 512             nil
 513           ;; Don't use existing cache and fetch entire message at once.
 514           (elmo-make-fetch-strategy
 515            'entire nil
 516            (elmo-message-use-cache-p folder number)
 517            (elmo-file-cache-path cache-file)))
 518       ;; Cache exists.
 519       (if (not ignore-cache)
 520           (elmo-make-fetch-strategy
 521            'entire
 522            ;; ...But ignore current section cache and re-fetch
 523            ;; if section cache.
 524            (not (eq (elmo-file-cache-status cache-file) 'section))
 525            ;; Save cache.
 526            (elmo-message-use-cache-p folder number)
 527            (elmo-file-cache-path cache-file))))))
 528
 529 (luna-define-method elmo-folder-list-messages-internal
 530   ((folder elmo-folder) &optional visible-only)
 531   t)
 532
 533 (defun elmo-folder-encache (folder numbers &optional unread)
 534   "Encache messages in the FOLDER with NUMBERS.
 535 If UNREAD is non-nil, messages are not marked as read."
 536   (dolist (number numbers)
 537     (elmo-message-encache folder number unread)))
 538
 539 (luna-define-generic elmo-message-encache (folder number &optional read)
 540   "Encache message in the FOLDER with NUMBER.
 541 If READ is non-nil, message is marked as read.")
 542
 543 (luna-define-method elmo-message-encache ((folder elmo-folder) number
 544                                           &optional read)
 545   (elmo-message-fetch
 546    folder number
 547    (elmo-make-fetch-strategy 'entire
 548                              nil ;use-cache
 549                              t   ;save-cache
 550                              (elmo-file-cache-get-path
 551                               (elmo-message-field
 552                                folder number 'message-id)))
 553    nil nil (not read)))
 554
 555 (luna-define-generic elmo-message-fetch (folder number strategy
 556                                                 &optional
 557                                                 section
 558                                                 outbuf
 559                                                 unread)
 560   "Fetch a message and return as a string.
 561 FOLDER is the ELMO folder structure.
 562 NUMBER is the number of the message in the FOLDER.
 563 STRATEGY is the message fetching strategy.
 564 If optional argument SECTION is specified, only the SECTION of the message
 565 is fetched (if possible).
 566 If second optional argument OUTBUF is specified, fetched message is
 567 inserted to the buffer and returns t if fetch was ended successfully.
 568 If third optional argument UNREAD is non-nil, message is not marked as read.
 569 Returns non-nil if fetching was succeed.")
 570
 571 (luna-define-generic elmo-message-fetch-with-cache-process (folder
 572                                                             number strategy
 573                                                             &optional
 574                                                             section
 575                                                             unread)
 576   "Fetch a message into current buffer with cache process.
 577 FOLDER is the ELMO folder structure.
 578 NUMBER is the number of the message in the FOLDER.
 579 STRATEGY is the message fetching strategy.
 580 If optional argument SECTION is specified, only the SECTION of the message
 581 is fetched (if possible).
 582 If second optional argument UNREAD is non-nil, message is not marked as read.
 583 Returns non-nil if fetching was succeed.")
 584
 585 (luna-define-generic elmo-message-fetch-internal (folder number strategy
 586                                                          &optional
 587                                                          section
 588                                                          unread)
 589   "Fetch a message into current buffer.
 590 FOLDER is the ELMO folder structure.
 591 NUMBER is the number of the message in the FOLDER.
 592 STRATEGY is the message fetching strategy.
 593 If optional argument SECTION is specified, only the SECTION of the message
 594 is fetched (if possible).
 595 If second optional argument UNREAD is non-nil, message is not marked as read.
 596 Returns non-nil if fetching was succeed.")
 597
 598 (luna-define-generic elmo-message-fetch-field (folder number field)
 599   "Fetch a message field value.
 600 FOLDER is the ELMO folder structure.
 601 NUMBER is the number of the message in the FOLDER.
 602 FIELD is a symbol of the field name.")
 603
 604 (luna-define-generic elmo-message-folder (folder number)
 605   "Get primitive folder of the message.")
 606
 607 (luna-define-generic elmo-folder-process-crosspost (folder
 608                                                     &optional
 609                                                     number-alist)
 610   "Process crosspost for FOLDER.
 611 If NUMBER-ALIST is set, it is used as number-alist.
 612 Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
 613
 614 (luna-define-generic elmo-folder-append-msgdb (folder append-msgdb)
 615   "Append  APPEND-MSGDB to the current msgdb of the folder.")
 616
 617 (luna-define-generic elmo-folder-newsgroups (folder)
 618   "Return list of newsgroup name of FOLDER.")
 619
 620 (luna-define-generic elmo-folder-search-requires-msgdb-p (folder condition)
 621   "Return non-nil if searching in FOLDER by CONDITION requires msgdb fetch.")
 622
 623 (defun elmo-folder-search-requires-msgdb-p-internal (folder condition)
 624   (if (listp condition)
 625       (or (elmo-folder-search-requires-msgdb-p-internal
 626            folder (nth 1 condition))
 627           (elmo-folder-search-requires-msgdb-p-internal
 628            folder (nth 2 condition)))
 629     (and (not (string= (elmo-filter-key condition) "last"))
 630          (not (string= (elmo-filter-key condition) "first")))))
 631
 632 (luna-define-method elmo-folder-search-requires-msgdb-p ((folder elmo-folder)
 633                                                          condition)
 634   (elmo-folder-search-requires-msgdb-p-internal folder condition))
 635
 636 (luna-define-method elmo-folder-newsgroups ((folder elmo-folder))
 637   nil)
 638
 639 (luna-define-method elmo-folder-open ((folder elmo-folder)
 640                                       &optional load-msgdb)
 641   (elmo-generic-folder-open folder load-msgdb))
 642
 643 (defun elmo-generic-folder-open (folder load-msgdb)
 644   (let ((inhibit-quit t))
 645     (if load-msgdb (elmo-folder-msgdb folder))
 646     (elmo-folder-set-killed-list-internal
 647      folder
 648      (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
 649   (elmo-folder-open-internal folder))
 650
 651 (luna-define-method elmo-folder-open-internal ((folder elmo-folder))
 652   nil ; default is do nothing.
 653   )
 654
 655 (luna-define-method elmo-folder-check ((folder elmo-folder))
 656   nil) ; default is noop.
 657
 658 (luna-define-method elmo-folder-commit ((folder elmo-folder))
 659   (elmo-generic-folder-commit folder))
 660
 661 (defun elmo-generic-folder-commit (folder)
 662   (when (elmo-folder-persistent-p folder)
 663     (when (elmo-folder-message-modified-internal folder)
 664       (elmo-msgdb-overview-save
 665        (elmo-folder-msgdb-path folder)
 666        (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))
 667       (elmo-msgdb-number-save
 668        (elmo-folder-msgdb-path folder)
 669        (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))
 670       (elmo-folder-set-info-max-by-numdb
 671        folder
 672        (elmo-msgdb-get-number-alist
 673         (elmo-folder-msgdb folder)))
 674       (elmo-folder-set-message-modified-internal folder nil)
 675       (elmo-msgdb-killed-list-save
 676        (elmo-folder-msgdb-path folder)
 677        (elmo-folder-killed-list-internal folder)))
 678     (when (elmo-folder-mark-modified-internal folder)
 679       (elmo-msgdb-mark-save
 680        (elmo-folder-msgdb-path folder)
 681        (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
 682       (elmo-folder-set-mark-modified-internal folder nil))))
 683
 684 (luna-define-method elmo-folder-close-internal ((folder elmo-folder))
 685   ;; do nothing.
 686   )
 687
 688 (luna-define-method elmo-folder-close ((folder elmo-folder))
 689   (elmo-generic-folder-close folder)
 690   (elmo-folder-close-internal folder))
 691
 692 (defun elmo-generic-folder-close (folder)
 693   (elmo-folder-commit folder)
 694   (elmo-folder-set-msgdb-internal folder nil)
 695   (elmo-folder-set-killed-list-internal folder nil))
 696
 697 (luna-define-method elmo-folder-plugged-p ((folder elmo-folder))
 698   t) ; default is plugged.
 699
 700 (luna-define-method elmo-folder-set-plugged ((folder elmo-folder) plugged
 701                                              &optional add)
 702   nil) ; default is do nothing.
 703
 704 (luna-define-method elmo-folder-use-flag-p ((folder elmo-folder))
 705   nil) ; default is no flag.
 706
 707 (luna-define-method elmo-folder-persistent-p ((folder elmo-folder))
 708   (elmo-folder-persistent-internal folder))
 709
 710 (luna-define-method elmo-folder-creatable-p ((folder elmo-folder))
 711   nil) ; default is not creatable.
 712
 713 (luna-define-method elmo-folder-writable-p ((folder elmo-folder))
 714   nil) ; default is not writable.
 715
 716 (luna-define-method elmo-folder-delete ((folder elmo-folder))
 717   (elmo-msgdb-delete-path folder))
 718
 719 (luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
 720   (let* ((new-folder (elmo-make-folder new-name)))
 721     (unless (eq (elmo-folder-type-internal folder)
 722                 (elmo-folder-type-internal new-folder))
 723       (error "Not same folder type"))
 724     (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
 725             (elmo-folder-exists-p new-folder))
 726         (error "Already exists folder: %s" new-name))
 727     (elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
 728     (elmo-msgdb-rename-path folder new-folder)))
 729
 730 (defsubst elmo-folder-search-fast (folder condition numbers)
 731   (when (and numbers
 732              (vectorp condition)
 733              (member (elmo-filter-key condition) '("first" "last" "mark")))
 734     (if (string= (elmo-filter-key condition) "mark")
 735         (let ((msgdb (elmo-folder-msgdb folder)))
 736           ;; msgdb should be synchronized at this point.
 737           (cond
 738            ((string= (elmo-filter-value condition) "unread")
 739             (elmo-folder-list-unreads folder))
 740            ((string= (elmo-filter-value condition) "important")
 741             (elmo-folder-list-importants folder))
 742            ((string= (elmo-filter-value condition) "answered")
 743             (elmo-folder-list-answereds folder))
 744            ((string= (elmo-filter-value condition) "any")
 745             (nconc (elmo-folder-list-unreads folder)
 746                    (elmo-folder-list-importants folder)
 747                    (elmo-folder-list-answereds folder)))))
 748       (let ((len (length numbers))
 749             (lastp (string= (elmo-filter-key condition) "last"))
 750             (value (string-to-number (elmo-filter-value condition))))
 751         (when (eq (elmo-filter-type condition) 'unmatch)
 752           (setq lastp (not lastp)
 753                 value  (- len value)))
 754         (if lastp
 755             (nthcdr (max (- len value) 0) numbers)
 756           (when (> value 0)
 757             (let ((last (nthcdr (1- value) numbers)))
 758               (when last
 759                 (setcdr last nil))
 760               numbers)))))))
 761
 762 (luna-define-method elmo-folder-search ((folder elmo-folder)
 763                                         condition
 764                                         &optional numbers)
 765   (let ((numbers (or numbers (elmo-folder-list-messages folder))))
 766     (or (elmo-folder-search-fast folder condition numbers)
 767         (let ((msgdb (elmo-folder-msgdb folder))
 768               (len (length numbers))
 769               matched)
 770           (when (> len elmo-display-progress-threshold)
 771             (elmo-progress-set 'elmo-folder-search len "Searching..."))
 772           (unwind-protect
 773               (dolist (number numbers)
 774                 (let (result)
 775                   (setq result (elmo-msgdb-match-condition
 776                                 msgdb
 777                                 condition
 778                                 number
 779                                 numbers))
 780                   (when (elmo-filter-condition-p result)
 781                     (setq result (elmo-message-match-condition
 782                                   folder
 783                                   number
 784                                   condition
 785                                   numbers)))
 786                   (when result
 787                     (setq matched (cons number matched))))
 788                 (elmo-progress-notify 'elmo-folder-search))
 789             (elmo-progress-clear 'elmo-folder-search))
 790           (nreverse matched)))))
 791
 792 (luna-define-method elmo-message-match-condition ((folder elmo-folder)
 793                                                   number condition
 794                                                   numbers)
 795   (let ((filename (cond
 796                    ((elmo-message-file-name folder number))
 797                    ((let* ((cache (elmo-file-cache-get
 798                                    (elmo-message-field folder number
 799                                                        'message-id)))
 800                            (cache-path (elmo-file-cache-path cache)))
 801                       (when (and cache-path
 802                                  (not (elmo-cache-path-section-p cache-path)))
 803                         cache-path))))))
 804     (when (and filename
 805                (file-readable-p filename))
 806       (with-temp-buffer
 807         (insert-file-contents-as-binary filename)
 808         (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 809         ;; Should consider charset?
 810         (decode-mime-charset-region (point-min) (point-max) elmo-mime-charset)
 811         (elmo-buffer-field-condition-match condition number numbers)))))
 812
 813 (luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
 814   nil) ; default is noop.
 815
 816 (luna-define-method elmo-folder-update-number ((folder elmo-folder))
 817   nil) ; default is noop.
 818
 819 (luna-define-method elmo-folder-message-file-p ((folder elmo-folder))
 820   nil) ; default is not file.
 821
 822 (luna-define-method elmo-folder-message-file-number-p ((folder elmo-folder))
 823   nil) ; default is not number.
 824
 825 (luna-define-method elmo-folder-message-make-temp-file-p ((folder elmo-folder))
 826   nil) ; default is not make temp file.
 827
 828 (luna-define-method elmo-message-file-name ((folder elmo-folder)
 829                                                    number)
 830   nil) ; default is no name.
 831
 832 (luna-define-method elmo-folder-local-p ((folder elmo-folder))
 833   t)   ; default is local.
 834
 835 (luna-define-method elmo-folder-have-subfolder-p ((folder elmo-folder))
 836   t)
 837
 838 ;;; Folder info
 839 ;; Folder info is a message number information cache (hashtable)
 840 (defsubst elmo-folder-get-info (folder &optional hashtb)
 841   "Return FOLDER info from HASHTB (default is `elmo-folder-info-hashtb')."
 842   (elmo-get-hash-val (elmo-folder-name-internal folder)
 843                      (or hashtb elmo-folder-info-hashtb)))
 844
 845 (defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
 846   "Set FOLDER info (means MAX, NUMBERS, NEW and UNREAD)."
 847   (let ((info (elmo-folder-get-info folder)))
 848     (when info
 849       (or new     (setq new     (nth 0 info)))
 850       (or unread  (setq unread  (nth 1 info)))
 851       (or numbers (setq numbers (nth 2 info)))
 852       (or max     (setq max     (nth 3 info))))
 853     (elmo-set-hash-val (elmo-folder-name-internal folder)
 854                        (list new unread numbers max)
 855                        elmo-folder-info-hashtb)))
 856
 857 (defun elmo-folder-set-info-max-by-numdb (folder msgdb-number)
 858   "Set FOLDER info by MSGDB-NUMBER in msgdb."
 859   (let ((num-db (sort (mapcar 'car msgdb-number) '<)))
 860     (elmo-folder-set-info-hashtb
 861      folder
 862      (or (nth (max 0 (1- (length num-db))) num-db) 0)
 863      nil ;;(length num-db)
 864      )))
 865
 866 (defun elmo-folder-get-info-max (folder)
 867   "Return max number of FODLER from folder info."
 868   (nth 3 (elmo-folder-get-info folder)))
 869
 870 (defun elmo-folder-get-info-length (folder)
 871   "Return length of FODLER from folder info."
 872   (nth 2 (elmo-folder-get-info folder)))
 873
 874 (defun elmo-folder-get-info-unread (folder)
 875   "Return unread of FODLER from folder info."
 876   (nth 1 (elmo-folder-get-info folder)))
 877
 878 (defun elmo-folder-info-make-hashtb (info-alist hashtb)
 879   "Setup folder info hashtable by INFO-ALIST on HASHTB."
 880   (let* ((hashtb (or hashtb
 881                      (elmo-make-hash (length info-alist)))))
 882     (mapcar
 883      (lambda (x)
 884        (let ((info (cadr x)))
 885          (and (intern-soft (car x) hashtb)
 886               (elmo-set-hash-val (car x)
 887                                  (list (nth 2 info)   ;; new
 888                                        (nth 3 info)   ;; unread
 889                                        (nth 1 info)   ;; length
 890                                        (nth 0 info))  ;; max
 891                                  hashtb))))
 892      info-alist)
 893     (setq elmo-folder-info-hashtb hashtb)))
 894
 895 (defsubst elmo-diff-new (diff)
 896   (car diff))
 897
 898 (defsubst elmo-diff-unread (diff)
 899   (when (consp (cdr diff))
 900     (nth 1 diff)))
 901
 902 (defsubst elmo-diff-all (diff)
 903   (if (consp (cdr diff))
 904       (nth 2 diff)
 905     (cdr diff)))
 906
 907 (defsubst elmo-strict-folder-diff (folder)
 908   "Return folder diff information strictly from FOLDER."
 909   (let* ((dir (elmo-folder-msgdb-path folder))
 910          (nalist (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))
 911          (in-db (sort (mapcar 'car nalist) '<))
 912          (in-folder  (elmo-folder-list-messages folder))
 913          append-list delete-list diff)
 914     (cons (if (equal in-folder in-db)
 915               0
 916             (setq diff (elmo-list-diff
 917                         in-folder in-db
 918                         nil
 919                         ))
 920             (setq append-list (car diff))
 921             (setq delete-list (cadr diff))
 922             (if append-list
 923                 (length append-list)
 924               (if delete-list
 925                   (- 0 (length delete-list))
 926                 0)))
 927           (length in-folder))))
 928
 929 (luna-define-method elmo-folder-diff ((folder elmo-folder)
 930                                       &optional numbers)
 931   (elmo-generic-folder-diff folder numbers))
 932
 933 (defun elmo-generic-folder-diff (folder numbers)
 934   (if (elmo-string-match-member (elmo-folder-name-internal folder)
 935                                 elmo-strict-diff-folder-list)
 936       (elmo-strict-folder-diff folder)
 937     (let ((cached-in-db-max (elmo-folder-get-info-max folder))
 938           (in-folder (elmo-folder-status folder))
 939           (in-db t)
 940           unsync messages
 941           in-db-max)
 942       (if numbers
 943           (setq in-db-max (or (nth (max 0 (1- (length numbers))) numbers)
 944                               0))
 945         (if (not cached-in-db-max)
 946             (let ((number-list (mapcar 'car
 947                                        (elmo-msgdb-number-load
 948                                         (elmo-folder-msgdb-path folder)))))
 949               ;; No info-cache.
 950               (setq in-db (sort number-list '<))
 951               (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
 952                                   0))
 953               (elmo-folder-set-info-hashtb folder in-db-max nil))
 954           (setq in-db-max cached-in-db-max)))
 955       (setq unsync (if (and in-db (car in-folder))
 956                        (- (car in-folder) in-db-max)
 957                      (if (and in-folder (null in-db))
 958                          (cdr in-folder)
 959                        (car in-folder))))
 960       (setq messages (cdr in-folder))
 961       (if (and unsync messages (> unsync messages))
 962           (setq unsync messages))
 963       (cons (or unsync 0) (or messages 0)))))
 964
 965 (defvar elmo-folder-diff-async-callback nil)
 966 (defvar elmo-folder-diff-async-callback-data nil)
 967
 968 (luna-define-method elmo-folder-diff-async ((folder elmo-folder))
 969   (and elmo-folder-diff-async-callback
 970        (funcall elmo-folder-diff-async-callback
 971                 folder
 972                 (elmo-folder-diff folder))))
 973
 974 (luna-define-method elmo-folder-get-primitive-list ((folder elmo-folder))
 975   (list folder))
 976
 977 (luna-define-method elmo-folder-contains-type ((folder elmo-folder) type)
 978   (eq (elmo-folder-type-internal folder) type))
 979
 980 (luna-define-method elmo-folder-append-messages ((folder elmo-folder)
 981                                                  src-folder
 982                                                  numbers
 983                                                  &optional
 984                                                  same-number)
 985   (elmo-generic-folder-append-messages folder src-folder numbers
 986                                        same-number))
 987
 988 (defun elmo-generic-folder-append-messages (folder src-folder numbers
 989                                                    same-number)
 990   (let (unseen seen-list succeed-numbers failure cache)
 991     (with-temp-buffer
 992       (set-buffer-multibyte nil)
 993       (while numbers
 994         (setq failure nil)
 995         (condition-case nil
 996             (setq cache (elmo-file-cache-get
 997                          (elmo-message-field src-folder
 998                                              (car numbers)
 999                                              'message-id))
1000                   failure
1001                   (not
1002                    (and
1003                     (elmo-message-fetch
1004                      src-folder (car numbers)
1005                      (if (elmo-folder-plugged-p src-folder)
1006                          (elmo-make-fetch-strategy
1007                           'entire 'maybe nil
1008                           (and cache (elmo-file-cache-path cache)))
1009                        (or (and elmo-enable-disconnected-operation
1010                                 cache
1011                                 (eq (elmo-file-cache-status cache) 'entire)
1012                                 (elmo-make-fetch-strategy
1013                                  'entire t nil
1014                                  (elmo-file-cache-path cache)))
1015                            (error "Unplugged")))
1016                      nil (current-buffer)
1017                      'unread)
1018                     (> (buffer-size) 0)
1019                     (elmo-folder-append-buffer
1020                      folder
1021                      (setq unseen (member (elmo-message-mark
1022                                            src-folder (car numbers))
1023                                           (elmo-msgdb-unread-marks)))
1024                      (if same-number (car numbers))))))
1025           (error (setq failure t)))
1026         ;; FETCH & APPEND finished
1027         (unless failure
1028           (unless unseen
1029             (setq seen-list (cons (elmo-message-field
1030                                    src-folder (car numbers)
1031                                    'message-id)
1032                                   seen-list)))
1033           (setq succeed-numbers (cons (car numbers) succeed-numbers)))
1034         (elmo-progress-notify 'elmo-folder-move-messages)
1035         (setq numbers (cdr numbers)))
1036       (if (and seen-list (elmo-folder-persistent-p folder))
1037           (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder)
1038                                 (nconc (elmo-msgdb-seen-load
1039                                         (elmo-folder-msgdb-path folder))
1040                                        seen-list)))
1041       succeed-numbers)))
1042
1043 ;; Arguments should be reduced.
1044 (defun elmo-folder-move-messages (src-folder msgs dst-folder
1045                                              &optional msgdb
1046                                              no-delete-info
1047                                              no-delete
1048                                              same-number
1049                                              save-unread)
1050   (save-excursion
1051     (let* ((messages msgs)
1052            (elmo-inhibit-display-retrieval-progress t)
1053            (len (length msgs))
1054            succeeds i result)
1055       (if (eq dst-folder 'null)
1056           (setq succeeds messages)
1057         (unless (elmo-folder-writable-p dst-folder)
1058           (error "move: %d is not writable"
1059                  (elmo-folder-name-internal dst-folder)))
1060         (when messages
1061           ;; src is already opened.
1062           (elmo-folder-open-internal dst-folder)
1063           (unless (setq succeeds (elmo-folder-append-messages dst-folder
1064                                                               src-folder
1065                                                               messages
1066                                                               same-number))
1067             (error "move: append message to %s failed"
1068                    (elmo-folder-name-internal dst-folder)))
1069           (elmo-folder-close dst-folder))
1070         (when (and (elmo-folder-persistent-p dst-folder)
1071                    save-unread)
1072           ;; Save to seen list.
1073           (let* ((dir (elmo-folder-msgdb-path dst-folder))
1074                  (seen-list (elmo-msgdb-seen-load dir)))
1075             (setq seen-list
1076                   (elmo-msgdb-add-msgs-to-seen-list
1077                    msgs (elmo-folder-msgdb src-folder)
1078                    seen-list))
1079             (elmo-msgdb-seen-save dir seen-list))))
1080       (if (and (not no-delete) succeeds)
1081           (progn
1082             (if (not no-delete-info)
1083                 (message "Cleaning up src folder..."))
1084             (if (and (elmo-folder-delete-messages src-folder succeeds)
1085                      (elmo-msgdb-delete-msgs
1086                       (elmo-folder-msgdb src-folder) succeeds))
1087                 (setq result t)
1088               (message "move: delete messages from %s failed."
1089                        (elmo-folder-name-internal src-folder))
1090               (setq result nil))
1091             (if (and result
1092                      (not no-delete-info))
1093                 (message "Cleaning up src folder...done"))
1094             result)
1095         (if no-delete
1096             (progn
1097               (message "Copying messages...done")
1098               t)
1099           (if (eq len 0)
1100               (message "No message was moved.")
1101             (message "Moving messages failed.")
1102             nil ; failure
1103             ))))))
1104
1105 (defun elmo-folder-msgdb-path (folder)
1106   "Return the msgdb path for FOLDER."
1107   (or (elmo-folder-path-internal folder)
1108       (elmo-folder-set-path-internal
1109        folder
1110        (elmo-folder-expand-msgdb-path folder))))
1111
1112 (defun elmo-message-set-cached (folder number cached)
1113   "Set cache status of the message mark.
1114 FOLDER is the ELMO folder structure.
1115 NUMBER is a number of the message.
1116 If CACHED is t, message mark is set as cached."
1117   (when (elmo-msgdb-set-cached (elmo-folder-msgdb folder)
1118                                number
1119                                cached
1120                                (elmo-message-use-cache-p folder number))
1121     (elmo-folder-set-mark-modified-internal folder t)))
1122
1123
1124 (defun elmo-message-mark (folder number)
1125   "Get mark of the message.
1126 FOLDER is the ELMO folder structure.
1127 NUMBER is a number of the message."
1128   (elmo-msgdb-get-mark (elmo-folder-msgdb folder) number))
1129
1130 (defun elmo-folder-list-messages-mark-match (folder mark-regexp)
1131   "List messages in the FOLDER which have a mark that matches MARK-REGEXP"
1132   (let ((case-fold-search nil)
1133         matched)
1134     (if mark-regexp
1135         (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
1136           (if (string-match mark-regexp (cadr elem))
1137               (setq matched (cons (car elem) matched)))))
1138     matched))
1139
1140 (defun elmo-message-field (folder number field)
1141   "Get message field value in the msgdb.
1142 FOLDER is the ELMO folder structure.
1143 NUMBER is a number of the message.
1144 FIELD is a symbol of the field."
1145   (elmo-msgdb-get-field (elmo-folder-msgdb folder) number field))
1146
1147 (defun elmo-message-set-mark (folder number mark)
1148   ;; Set mark for the message in the FOLDER with NUMBER as MARK.
1149   (elmo-msgdb-set-mark
1150    (elmo-folder-msgdb folder)
1151    number mark))
1152
1153 (luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number)
1154   nil) ; default is not use cache.
1155
1156 (luna-define-method elmo-message-folder ((folder elmo-folder) number)
1157   folder) ; default is folder
1158
1159 (luna-define-method elmo-folder-unmark-important ((folder elmo-folder)
1160                                                   numbers)
1161   (when (elmo-folder-msgdb-internal folder)
1162     (dolist (number numbers)
1163       (elmo-msgdb-unset-flag (elmo-folder-msgdb folder)
1164                              folder
1165                              number
1166                              'important))))
1167
1168 (luna-define-method elmo-folder-mark-as-important ((folder elmo-folder)
1169                                                    numbers)
1170   (when (elmo-folder-msgdb-internal folder)
1171     (dolist (number numbers)
1172       (elmo-msgdb-set-flag (elmo-folder-msgdb folder)
1173                            folder
1174                            number
1175                            'important))))
1176
1177 (luna-define-method elmo-folder-unmark-read ((folder elmo-folder)
1178                                              numbers
1179                                              &optional ignore-flags)
1180   (when (elmo-folder-msgdb-internal folder)
1181     (dolist (number numbers)
1182       (elmo-msgdb-unset-flag (elmo-folder-msgdb folder)
1183                              folder
1184                              number
1185                              'read))))
1186
1187 (luna-define-method elmo-folder-mark-as-read ((folder elmo-folder)
1188                                               numbers
1189                                               &optional ignore-flag)
1190   (when (elmo-folder-msgdb-internal folder)
1191     (dolist (number numbers)
1192       (elmo-msgdb-set-flag (elmo-folder-msgdb folder)
1193                            folder
1194                            number
1195                            'read))))
1196
1197 (luna-define-method elmo-folder-unmark-answered ((folder elmo-folder) numbers)
1198   (when (elmo-folder-msgdb-internal folder)
1199     (dolist (number numbers)
1200       (elmo-msgdb-unset-flag (elmo-folder-msgdb folder)
1201                              folder
1202                              number
1203                              'answered))))
1204
1205 (luna-define-method elmo-folder-mark-as-answered ((folder elmo-folder) numbers)
1206   (when (elmo-folder-msgdb-internal folder)
1207     (dolist (number numbers)
1208       (elmo-msgdb-set-flag (elmo-folder-msgdb folder)
1209                            folder
1210                            number
1211                            'answered))))
1212
1213 (luna-define-method elmo-folder-process-crosspost ((folder elmo-folder)
1214                                                    &optional
1215                                                    number-alist)
1216   ;; Do nothing.
1217   )
1218
1219 (defun elmo-generic-folder-append-msgdb (folder append-msgdb)
1220   (if append-msgdb
1221       (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
1222              (all-alist (copy-sequence (append
1223                                         (elmo-msgdb-get-number-alist
1224                                          (elmo-folder-msgdb folder))
1225                                         number-alist)))
1226              (cur number-alist)
1227              pair overview
1228              to-be-deleted
1229              mark-alist)
1230         (elmo-folder-set-msgdb-internal folder
1231                                         (elmo-msgdb-append
1232                                          (elmo-folder-msgdb folder)
1233                                          append-msgdb))
1234         (while cur
1235           (setq all-alist (delq (car cur) all-alist))
1236           ;; same message id exists.
1237           (if (setq pair (rassoc (cdr (car cur)) all-alist))
1238               (setq to-be-deleted (nconc to-be-deleted (list (car pair)))))
1239           (setq cur (cdr cur)))
1240         (cond ((eq (elmo-folder-process-duplicates-internal folder)
1241                    'hide)
1242                ;; Hide duplicates.
1243                (setq overview (elmo-delete-if
1244                                (lambda (x)
1245                                  (memq (elmo-msgdb-overview-entity-get-number
1246                                         x)
1247                                        to-be-deleted))
1248                                (elmo-msgdb-get-overview append-msgdb)))
1249                ;; Should be mark as read.
1250                (elmo-folder-mark-as-read folder to-be-deleted)
1251                (elmo-msgdb-set-overview append-msgdb overview))
1252               ((eq (elmo-folder-process-duplicates-internal folder)
1253                    'read)
1254                ;; Mark as read duplicates.
1255                (elmo-folder-mark-as-read folder to-be-deleted))
1256               (t
1257                ;; Do nothing.
1258                (setq to-be-deleted nil)))
1259         (length to-be-deleted))
1260     0))
1261
1262 (luna-define-method elmo-folder-append-msgdb ((folder elmo-folder)
1263                                               append-msgdb)
1264   (elmo-generic-folder-append-msgdb folder append-msgdb))
1265
1266 (defun elmo-folder-confirm-appends (appends)
1267   (let ((len (length appends))
1268         in)
1269     (if (and elmo-folder-update-threshold
1270              (> len elmo-folder-update-threshold)
1271              elmo-folder-update-confirm)
1272         (if (y-or-n-p (format "Too many messages(%d).  Update all? " len))
1273             appends
1274           (setq in elmo-folder-update-threshold)
1275           (catch 'end
1276             (while t
1277               (setq in (read-from-minibuffer "Update number: "
1278                                              (int-to-string in))
1279                     in (string-to-int in))
1280               (if (< len in)
1281                   (throw 'end len))
1282               (if (y-or-n-p (format "%d messages are not appeared.  OK? "
1283                                     (max (- len in) 0)))
1284                   (throw 'end in))))
1285           (nthcdr (max (- len in) 0) appends))
1286       (if (and elmo-folder-update-threshold
1287                (> len elmo-folder-update-threshold)
1288                (not elmo-folder-update-confirm))
1289           (nthcdr (max (- len elmo-folder-update-threshold) 0) appends)
1290         appends))))
1291
1292 (luna-define-method elmo-message-fetch ((folder elmo-folder)
1293                                         number strategy
1294                                         &optional
1295                                         section
1296                                         outbuf
1297                                         unread)
1298   (if outbuf
1299       (with-current-buffer outbuf
1300         (erase-buffer)
1301         (elmo-message-fetch-with-cache-process folder number
1302                                                strategy section unread))
1303     (with-temp-buffer
1304       (elmo-message-fetch-with-cache-process folder number
1305                                              strategy section unread)
1306       (buffer-string))))
1307
1308 (luna-define-method elmo-message-fetch-with-cache-process ((folder elmo-folder)
1309                                                            number strategy
1310                                                            &optional
1311                                                            section unread)
1312   (let ((cache-path (elmo-fetch-strategy-cache-path strategy))
1313         (method-priorities
1314          (cond ((eq (elmo-fetch-strategy-use-cache strategy) 'maybe)
1315                 '(entity cache))
1316                ((elmo-fetch-strategy-use-cache strategy)
1317                 '(cache entity))
1318                (t
1319                 '(entity))))
1320         result err)
1321     (while (and method-priorities
1322                 (null result))
1323       (setq result
1324             (case (car method-priorities)
1325               (cache
1326                (elmo-file-cache-load cache-path section))
1327               (entity
1328                (when (and (condition-case error
1329                               (elmo-message-fetch-internal folder number
1330                                                            strategy
1331                                                            section
1332                                                            unread)
1333                             (error (setq err error) nil))
1334                           (> (buffer-size) 0))
1335                  (elmo-delete-cr-buffer)
1336                  (when (and (elmo-fetch-strategy-save-cache strategy)
1337                             cache-path)
1338                    (elmo-file-cache-save cache-path section))
1339                  t)))
1340             method-priorities (cdr method-priorities)))
1341     (or result
1342         (and err (signal (car err) (cdr err))))))
1343
1344 (luna-define-method elmo-folder-clear ((folder elmo-folder)
1345                                        &optional keep-killed)
1346   (unless keep-killed
1347     (elmo-folder-set-killed-list-internal folder nil))
1348   (elmo-folder-set-msgdb-internal folder (elmo-msgdb-clear)))
1349
1350 (defun elmo-folder-synchronize (folder
1351                                 &optional ignore-msgdb
1352                                 no-check)
1353   "Synchronize the folder data to the newest status.
1354 FOLDER is the ELMO folder structure.
1355 If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except
1356 flag status. If IGNORE-MSGDB is 'visible-only, only visible messages
1357 \(the messages which are not in the killed-list\) are thrown away and
1358 synchronized.
1359 If NO-CHECK is non-nil, rechecking folder is skipped.
1360
1361 Return a list of a cross-posted message number.
1362 If update process is interrupted, return nil."
1363   (let ((killed-list (elmo-folder-killed-list-internal folder))
1364         (before-append t)
1365         number-alist mark-alist
1366         old-msgdb diff diff-2 delete-list new-list new-msgdb mark
1367         seen-list crossed after-append)
1368     (setq old-msgdb (elmo-folder-msgdb folder))
1369     ;; Load seen-list.
1370     (setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder)))
1371     (setq number-alist (elmo-msgdb-get-number-alist
1372                         (elmo-folder-msgdb folder)))
1373     (setq mark-alist (elmo-msgdb-get-mark-alist
1374                       (elmo-folder-msgdb folder)))
1375     (if ignore-msgdb
1376         (progn
1377           (setq seen-list (nconc (elmo-msgdb-seen-list
1378                                   (elmo-folder-msgdb folder))
1379                                  seen-list))
1380           (elmo-folder-clear folder (eq ignore-msgdb 'visible-only))))
1381     (unless no-check (elmo-folder-check folder))
1382     (condition-case nil
1383         (progn
1384           (message "Checking folder diff...")
1385           ;; TODO: killed list is loaded in elmo-folder-open and
1386           ;; list-messages use internal killed-list-folder.
1387           (setq diff (elmo-list-diff (elmo-folder-list-messages
1388                                       folder
1389                                       (eq 'visible-only ignore-msgdb))
1390                                      (unless ignore-msgdb
1391                                        (sort (mapcar
1392                                               'car
1393                                               number-alist)
1394                                              '<))))
1395           (message "Checking folder diff...done")
1396           (setq new-list (elmo-folder-confirm-appends (car diff)))
1397           ;; Set killed list.
1398           (when (and (not (eq (length (car diff))
1399                               (length new-list)))
1400                      (setq diff-2 (elmo-list-diff (car diff) new-list)))
1401             (elmo-msgdb-append-to-killed-list folder (car diff-2)))
1402           (setq delete-list (cadr diff))
1403           (if (or (equal diff '(nil nil))
1404                   (equal diff '(nil))
1405                   (and (eq (length (car diff)) 0)
1406                        (eq (length (cadr diff)) 0)))
1407               (progn
1408                 (elmo-folder-update-number folder)
1409                 (elmo-folder-process-crosspost folder)
1410                 0 ; no updates.
1411                 )
1412             (if delete-list (elmo-msgdb-delete-msgs
1413                              (elmo-folder-msgdb folder) delete-list))
1414             (when new-list
1415               (setq new-msgdb (elmo-folder-msgdb-create
1416                                folder new-list seen-list))
1417               (elmo-msgdb-change-mark (elmo-folder-msgdb folder)
1418                                       elmo-msgdb-new-mark
1419                                       elmo-msgdb-unread-uncached-mark)
1420               ;; Clear seen-list.
1421               (if (elmo-folder-persistent-p folder)
1422                   (setq seen-list (elmo-msgdb-seen-save
1423                                    (elmo-folder-msgdb-path folder) nil)))
1424               (setq before-append nil)
1425               (setq crossed (elmo-folder-append-msgdb folder new-msgdb))
1426               ;; process crosspost.
1427               ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).
1428               (elmo-folder-process-crosspost folder)
1429               (elmo-folder-set-message-modified-internal folder t)
1430               (elmo-folder-set-mark-modified-internal folder t))
1431             ;; return value.
1432             (or crossed 0)))
1433       (quit
1434        ;; Resume to the original status.
1435        (if before-append
1436            (elmo-folder-set-msgdb-internal folder old-msgdb))
1437        (elmo-folder-set-killed-list-internal folder killed-list)
1438        nil))))
1439
1440 (defun elmo-folder-messages (folder)
1441   "Return number of messages in the FOLDER."
1442   (length
1443    (elmo-msgdb-get-number-alist
1444     (elmo-folder-msgdb folder))))
1445
1446 (defun elmo-msgdb-load (folder &optional silent)
1447   (unless silent
1448     (message "Loading msgdb for %s..." (elmo-folder-name-internal folder)))
1449   (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder))))
1450     (elmo-folder-set-info-max-by-numdb folder
1451                                        (elmo-msgdb-get-number-alist msgdb))
1452
1453     (unless silent
1454       (message "Loading msgdb for %s...done"
1455                (elmo-folder-name-internal folder)))
1456     msgdb))
1457
1458 (defun elmo-msgdb-delete-path (folder)
1459   (let ((path (elmo-folder-msgdb-path folder)))
1460     (if (file-directory-p path)
1461         (elmo-delete-directory path t))))
1462
1463 (defun elmo-msgdb-rename-path (old-folder new-folder)
1464   (let* ((old (directory-file-name (elmo-folder-msgdb-path old-folder)))
1465          (new (directory-file-name (elmo-folder-msgdb-path new-folder)))
1466          (new-dir (directory-file-name (file-name-directory new))))
1467     (if (not (file-directory-p old))
1468         ()
1469       (if (file-exists-p new)
1470           (error "Already exists directory: %s" new)
1471         (if (not (file-exists-p new-dir))
1472             (elmo-make-directory new-dir))
1473         (rename-file old new)))))
1474
1475 (defun elmo-setup-subscribed-newsgroups (groups)
1476   "Setup subscribed newsgroups.
1477 GROUPS is a list of newsgroup name string.
1478 Return a hashtable for newsgroups."
1479   (let ((hashtb (or elmo-newsgroups-hashtb
1480                     (setq elmo-newsgroups-hashtb
1481                           (elmo-make-hash (length groups))))))
1482     (dolist (group groups)
1483       (or (elmo-get-hash-val group hashtb)
1484           (elmo-set-hash-val group nil hashtb)))
1485     (setq elmo-newsgroups-hashtb hashtb)))
1486
1487 (defvar elmo-crosspost-message-alist-modified nil)
1488 (defun elmo-crosspost-message-alist-load ()
1489   "Load crosspost message alist."
1490   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
1491   (setq elmo-crosspost-message-alist-modified nil))
1492
1493 (defun elmo-crosspost-message-alist-save ()
1494   "Save crosspost message alist."
1495   (when elmo-crosspost-message-alist-modified
1496     (let ((alist elmo-crosspost-message-alist)
1497           newsgroups)
1498       (while alist
1499         (setq newsgroups
1500               (elmo-delete-if
1501                '(lambda (x)
1502                   (not (intern-soft x elmo-newsgroups-hashtb)))
1503                (nth 1 (car alist))))
1504         (if newsgroups
1505             (setcar (cdar alist) newsgroups)
1506           (setq elmo-crosspost-message-alist
1507                 (delete (car alist) elmo-crosspost-message-alist)))
1508         (setq alist (cdr alist)))
1509       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
1510       (setq elmo-crosspost-message-alist-modified nil))))
1511
1512 (defun elmo-folder-make-temporary-directory (folder)
1513   ;; Make a temporary directory for FOLDER.
1514   (let ((temp-dir (make-temp-name
1515                    (concat
1516                     (file-name-as-directory (elmo-folder-msgdb-path folder))
1517                     "elmo"))))
1518     (elmo-make-directory temp-dir)
1519     temp-dir))
1520
1521 (defun elmo-init ()
1522   "Initialize ELMO module."
1523   (elmo-crosspost-message-alist-load)
1524   (elmo-resque-obsolete-variables)
1525   (elmo-dop-queue-load))
1526
1527 (defun elmo-quit ()
1528   "Quit and cleanup ELMO."
1529   (elmo-crosspost-message-alist-save)
1530   (elmo-dop-queue-save)
1531   ;; Not implemented yet.
1532   (let ((types elmo-folder-type-alist)
1533         class)
1534     (while types
1535       (setq class
1536             (luna-find-class
1537              (intern (format "elmo-%s-folder" (symbol-name (cdr (car types)))))))
1538       ;; Call all folder's `elmo-quit' method.
1539       (if class
1540           (dolist (func (luna-class-find-functions class 'elmo-quit))
1541             (funcall func nil)))
1542       (setq types (cdr types)))))
1543
1544
1545 ;;; Define folders.
1546 (elmo-define-folder ?% 'imap4)
1547 (elmo-define-folder ?-  'nntp)
1548 (elmo-define-folder ?\+ 'localdir)
1549 (elmo-define-folder ?\* 'multi)
1550 (elmo-define-folder ?\/ 'filter)
1551 (elmo-define-folder ?\$ 'archive)
1552 (elmo-define-folder ?&  'pop3)
1553 (elmo-define-folder ?=  'localnews)
1554 (elmo-define-folder ?|  'pipe)
1555 (elmo-define-folder ?.  'maildir)
1556 (elmo-define-folder ?'  'internal)
1557 (elmo-define-folder ?\[  'nmz)
1558 (elmo-define-folder ?@  'shimbun)
1559
1560 ;;; Obsolete variables.
1561 (elmo-define-obsolete-variable 'elmo-default-imap4-mailbox
1562                                'elmo-imap4-default-mailbox)
1563 (elmo-define-obsolete-variable 'elmo-default-imap4-server
1564                                'elmo-imap4-default-server)
1565 (elmo-define-obsolete-variable 'elmo-default-imap4-authenticate-type
1566                                'elmo-imap4-default-authenticate-type)
1567 (elmo-define-obsolete-variable 'elmo-default-imap4-user
1568                                'elmo-imap4-default-user)
1569 (elmo-define-obsolete-variable 'elmo-default-imap4-port
1570                                'elmo-imap4-default-port)
1571 (elmo-define-obsolete-variable 'elmo-default-imap4-stream-type
1572                                'elmo-imap4-default-stream-type)
1573 (elmo-define-obsolete-variable 'elmo-default-nntp-server
1574                                'elmo-nntp-default-server)
1575 (elmo-define-obsolete-variable 'elmo-default-nntp-user
1576                                'elmo-nntp-default-user)
1577 (elmo-define-obsolete-variable 'elmo-default-nntp-port
1578                                'elmo-nntp-default-port)
1579 (elmo-define-obsolete-variable 'elmo-default-nntp-stream-type
1580                                'elmo-nntp-default-stream-type)
1581 (elmo-define-obsolete-variable 'elmo-default-pop3-server
1582                                'elmo-pop3-default-server)
1583 (elmo-define-obsolete-variable 'elmo-default-pop3-user
1584                                'elmo-pop3-default-user)
1585 (elmo-define-obsolete-variable 'elmo-default-pop3-authenticate-type
1586                                'elmo-pop3-default-authenticate-type)
1587 (elmo-define-obsolete-variable 'elmo-default-pop3-port
1588                                'elmo-pop3-default-port)
1589 (elmo-define-obsolete-variable 'elmo-default-pop3-stream-type
1590                                'elmo-pop3-default-stream-type)
1591 (elmo-define-obsolete-variable 'elmo-cache-dirname
1592                                'elmo-cache-directory)
1593 (elmo-define-obsolete-variable 'elmo-msgdb-dir
1594                                'elmo-msgdb-directory)
1595
1596 ;; Obsolete functions.
1597 ;; 2001-12-11: *-dir -> *-directory
1598 (defalias 'elmo-folder-make-temp-dir 'elmo-folder-make-temporary-directory)
1599 (make-obsolete 'elmo-folder-make-temp-dir
1600                'elmo-folder-make-temporary-directory)
1601
1602
1603 ;; autoloads
1604 (autoload 'elmo-dop-queue-flush "elmo-dop")
1605 (autoload 'elmo-nntp-post "elmo-nntp")
1606
1607 (require 'product)
1608 (product-provide (provide 'elmo) (require 'elmo-version))
1609
1610 ;;; elmo.el ends here