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