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