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