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         (setq numbers (cdr numbers)))
 897       (if (and seen-list (elmo-folder-persistent-p folder))
 898           (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder)
 899                                 (nconc (elmo-msgdb-seen-load
 900                                         (elmo-folder-msgdb-path folder))
 901                                        seen-list)))
 902       succeed-numbers)))
 903
 904 ;; Arguments should be reduced.
 905 (defun elmo-folder-move-messages (src-folder msgs dst-folder
 906                                              &optional msgdb all done
 907                                              no-delete-info
 908                                              no-delete
 909                                              same-number
 910                                              unread-marks
 911                                              save-unread)
 912   (save-excursion
 913     (let* ((messages msgs)
 914            (elmo-inhibit-display-retrieval-progress t)
 915            (len (length msgs))
 916            (all-msg-num (or all len))
 917            (done-msg-num (or done 0))
 918            (progress-message (if no-delete
 919                                  "Copying messages..."
 920                                "Moving messages..."))
 921            succeeds i result)
 922       (if (eq dst-folder 'null)
 923           (setq succeeds messages)
 924         (unless (elmo-folder-writable-p dst-folder)
 925           (error "move: %d is not writable"
 926                  (elmo-folder-name-internal dst-folder)))
 927         (when messages
 928           ;; src is already opened.
 929           (elmo-folder-open-internal dst-folder)
 930           (unless (setq succeeds (elmo-folder-append-messages dst-folder
 931                                                               src-folder
 932                                                               messages
 933                                                               unread-marks
 934                                                               same-number))
 935             (error "move: append message to %s failed"
 936                    (elmo-folder-name-internal dst-folder)))
 937           (elmo-folder-close dst-folder))
 938         (when (and (elmo-folder-persistent-p dst-folder)
 939                    save-unread)
 940           ;; Save to seen list.
 941           (let* ((dir (elmo-folder-msgdb-path dst-folder))
 942                  (seen-list (elmo-msgdb-seen-load dir)))
 943             (setq seen-list
 944                   (elmo-msgdb-add-msgs-to-seen-list
 945                    msgs (elmo-folder-msgdb src-folder)
 946                    unread-marks seen-list))
 947             (elmo-msgdb-seen-save dir seen-list))))
 948       (when (and done
 949                  (> all-msg-num elmo-display-progress-threshold))
 950         (elmo-display-progress
 951          'elmo-folder-move-messages progress-message
 952          (/ (* done-msg-num 100) all-msg-num)))
 953       (if (and (not no-delete) succeeds)
 954           (progn
 955             (if (not no-delete-info)
 956                 (message "Cleaning up src folder..."))
 957             (if (and (elmo-folder-delete-messages src-folder succeeds)
 958                      (elmo-msgdb-delete-msgs
 959                       (elmo-folder-msgdb src-folder) succeeds))
 960                 (setq result t)
 961               (message "move: delete messages from %s failed."
 962                        (elmo-folder-name-internal src-folder))
 963               (setq result nil))
 964             (if (and result
 965                      (not no-delete-info))
 966                 (message "Cleaning up src folder...done"))
 967             result)
 968         (if no-delete
 969             (progn
 970               (message "Copying messages...done")
 971               t)
 972           (if (eq len 0)
 973               (message "No message was moved.")
 974             (message "Moving messages failed.")
 975             nil ; failure
 976             ))))))
 977
 978 (defun elmo-folder-msgdb-path (folder)
 979   "Return the msgdb path for FOLDER."
 980   (or (elmo-folder-path-internal folder)
 981       (elmo-folder-set-path-internal
 982        folder
 983        (elmo-folder-expand-msgdb-path folder))))
 984
 985 (defun elmo-message-mark (folder number)
 986   "Get mark of the message.
 987 FOLDER is the ELMO folder structure.
 988 NUMBER is a number of the message."
 989   (cadr (assq number (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))
 990
 991 (defun elmo-folder-list-messages-mark-match (folder mark-regexp)
 992   "List messages in the FOLDER which have a mark that matches MARK-REGEXP"
 993   (let ((case-fold-search nil)
 994         matched)
 995     (if mark-regexp
 996         (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
 997           (if (string-match mark-regexp (cadr elem))
 998               (setq matched (cons (car elem) matched)))))
 999     matched))
1000
1001 (defun elmo-message-field (folder number field)
1002   "Get message field value in the msgdb.
1003 FOLDER is the ELMO folder structure.
1004 NUMBER is a number of the message.
1005 FIELD is a symbol of the field."
1006   (case field
1007     (message-id (elmo-msgdb-overview-entity-get-id
1008                  (elmo-msgdb-overview-get-entity
1009                   number (elmo-folder-msgdb folder))))
1010     (subject (elmo-msgdb-overview-entity-get-subject
1011               (elmo-msgdb-overview-get-entity
1012                number (elmo-folder-msgdb folder))))
1013     (size (elmo-msgdb-overview-entity-get-size
1014            (elmo-msgdb-overview-get-entity
1015             number (elmo-folder-msgdb folder))))
1016     (date (elmo-msgdb-overview-entity-get-date
1017            (elmo-msgdb-overview-get-entity
1018             number (elmo-folder-msgdb folder))))
1019     (to (elmo-msgdb-overview-entity-get-to
1020          (elmo-msgdb-overview-get-entity
1021           number (elmo-folder-msgdb folder))))
1022     (cc (elmo-msgdb-overview-entity-get-cc
1023          (elmo-msgdb-overview-get-entity
1024           number (elmo-folder-msgdb folder))))))
1025
1026 (defun elmo-message-set-mark (folder number mark)
1027   "Set mark for the message in the FOLDER with NUMBER as MARK."
1028   (elmo-msgdb-set-mark-alist
1029    (elmo-folder-msgdb folder)
1030    (elmo-msgdb-mark-set
1031     (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))
1032     number mark)))
1033
1034 (luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number)
1035   nil) ; default is not use cache.
1036
1037 (luna-define-method elmo-message-folder ((folder elmo-folder) number)
1038   folder) ; default is folder
1039
1040 (luna-define-method elmo-folder-unmark-important ((folder elmo-folder) numbers)
1041   t)
1042
1043 (luna-define-method elmo-folder-mark-as-important ((folder elmo-folder)
1044                                                    numbers)
1045   t)
1046
1047 (luna-define-method elmo-folder-unmark-read ((folder elmo-folder) numbers)
1048   t)
1049
1050 (luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) numbers)
1051   t)
1052
1053 (luna-define-method elmo-folder-process-crosspost ((folder elmo-folder)
1054                                                    &optional
1055                                                    number-alist)
1056   ;; Do nothing.
1057   )
1058
1059 (defun elmo-generic-folder-append-msgdb (folder append-msgdb)
1060   (if append-msgdb
1061       (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
1062              (all-alist (copy-sequence (append
1063                                         (elmo-msgdb-get-number-alist
1064                                          (elmo-folder-msgdb folder))
1065                                         number-alist)))
1066              (cur number-alist)
1067              pair overview
1068              to-be-deleted
1069              mark-alist)
1070         (while cur
1071           (setq all-alist (delq (car cur) all-alist))
1072           ;; same message id exists.
1073           (if (setq pair (rassoc (cdr (car cur)) all-alist))
1074               (setq to-be-deleted (nconc to-be-deleted (list (car pair)))))
1075           (setq cur (cdr cur)))
1076         (cond ((eq (elmo-folder-process-duplicates-internal folder)
1077                    'hide)
1078                ;; Hide duplicates.
1079                (setq overview (elmo-delete-if
1080                                (lambda (x)
1081                                  (memq (elmo-msgdb-overview-entity-get-number
1082                                         x)
1083                                        to-be-deleted))
1084                                (elmo-msgdb-get-overview append-msgdb)))
1085                ;; Should be mark as read.
1086                (elmo-folder-mark-as-read folder to-be-deleted)
1087                (elmo-msgdb-set-overview append-msgdb overview))
1088               ((eq (elmo-folder-process-duplicates-internal folder)
1089                    'read)
1090                ;; Mark as read duplicates.
1091                (elmo-folder-mark-as-read folder to-be-deleted))
1092               (t
1093                ;; Do nothing.
1094                (setq to-be-deleted nil)))
1095         (elmo-folder-set-msgdb-internal folder
1096                                         (elmo-msgdb-append
1097                                          (elmo-folder-msgdb folder)
1098                                          append-msgdb t))
1099         (length to-be-deleted))
1100     0))
1101
1102 (luna-define-method elmo-folder-append-msgdb ((folder elmo-folder)
1103                                               append-msgdb)
1104   (elmo-generic-folder-append-msgdb folder append-msgdb))
1105
1106 (defun elmo-folder-confirm-appends (appends)
1107   (let ((len (length appends))
1108         in)
1109     (if (and (> len elmo-folder-update-threshold)
1110              elmo-folder-update-confirm)
1111         (if (y-or-n-p (format "Too many messages(%d).  Continue? " len))
1112             appends
1113           (setq in elmo-folder-update-threshold)
1114           (catch 'end
1115             (while t
1116               (setq in (read-from-minibuffer "Update number: "
1117                                              (int-to-string in))
1118                     in (string-to-int in))
1119               (if (< len in)
1120                   (throw 'end len))
1121               (if (y-or-n-p (format "%d messages are disappeared.  OK? "
1122                                     (max (- len in) 0)))
1123                   (throw 'end in))))
1124           (nthcdr (max (- len in) 0) appends))
1125       (if (and (> len elmo-folder-update-threshold)
1126                (not elmo-folder-update-confirm))
1127           (nthcdr (max (- len elmo-folder-update-threshold) 0) appends)
1128         appends))))
1129
1130 (luna-define-method elmo-message-fetch ((folder elmo-folder)
1131                                         number strategy
1132                                         &optional
1133                                         section
1134                                         outbuf
1135                                         unread)
1136   (if outbuf
1137       (with-current-buffer outbuf
1138         (erase-buffer)
1139         (elmo-message-fetch-with-cache-process folder number
1140                                                strategy section unread)
1141         t)
1142     (with-temp-buffer
1143       (elmo-message-fetch-with-cache-process folder number
1144                                              strategy section unread)
1145       (buffer-string))))
1146
1147 (luna-define-method elmo-message-fetch-with-cache-process ((folder elmo-folder)
1148                                                            number strategy
1149                                                            &optional
1150                                                            section unread)
1151   (let (cache-path cache-file)
1152     (if (and (elmo-fetch-strategy-use-cache strategy)
1153              (setq cache-path (elmo-fetch-strategy-cache-path strategy))
1154              (setq cache-file (elmo-file-cache-expand-path
1155                                cache-path
1156                                section))
1157              (file-exists-p cache-file)
1158              (or (not (elmo-cache-path-section-p cache-file))
1159                  (not (eq (elmo-fetch-strategy-entireness strategy) 'entire))))
1160         (insert-file-contents-as-binary cache-file)
1161       (elmo-message-fetch-internal folder number strategy section unread)
1162       (elmo-delete-cr-buffer)
1163       (when (and (> (buffer-size) 0)
1164                  (elmo-fetch-strategy-save-cache strategy)
1165                  (elmo-fetch-strategy-cache-path strategy))
1166         (elmo-file-cache-save
1167          (elmo-fetch-strategy-cache-path strategy)
1168          section)))))
1169
1170 (luna-define-method elmo-folder-clear ((folder elmo-folder)
1171                                        &optional keep-killed)
1172   (unless keep-killed
1173     (elmo-folder-set-killed-list-internal folder nil))
1174   (elmo-folder-set-msgdb-internal folder (elmo-msgdb-clear)))
1175
1176 (defun elmo-folder-synchronize (folder
1177                                 new-mark             ;"N"
1178                                 unread-uncached-mark ;"U"
1179                                 unread-cached-mark   ;"!"
1180                                 read-uncached-mark   ;"u"
1181                                 important-mark       ;"$"
1182                                 &optional ignore-msgdb
1183                                 no-check)
1184   "Synchronize the folder data to the newest status.
1185 FOLDER is the ELMO folder structure.
1186 NEW-MARK, UNREAD-CACHED-MARK, READ-UNCACHED-MARK, and IMPORTANT-MARK
1187 are mark strings for new messages, unread but cached messages,
1188 read but not cached messages, and important messages.
1189 If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except
1190 read mark status. If IGNORE-MSGDB is 'visible-only, only visible messages
1191 \(the messages which are not in the killed-list\) are thrown away and
1192 synchronized.
1193 If NO-CHECK is non-nil, rechecking folder is skipped.
1194
1195 Return a list of
1196 \(NEW-MSGDB DELETE-LIST CROSSED\)
1197 NEW-MSGDB is the newly appended msgdb.
1198 DELETE-LIST is a list of deleted message number.
1199 CROSSED is cross-posted message number.
1200 If update process is interrupted, return nil."
1201   (let ((killed-list (elmo-folder-killed-list-internal folder))
1202         (before-append t)
1203         number-alist mark-alist
1204         old-msgdb diff diff-2 delete-list new-list new-msgdb mark
1205         seen-list crossed after-append)
1206     (setq old-msgdb (elmo-folder-msgdb folder))
1207     ;; Load seen-list.
1208     (setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder)))
1209     (setq number-alist (elmo-msgdb-get-number-alist
1210                         (elmo-folder-msgdb folder)))
1211     (setq mark-alist (elmo-msgdb-get-mark-alist
1212                       (elmo-folder-msgdb folder)))
1213     (if ignore-msgdb
1214         (progn
1215           (setq seen-list (nconc
1216                            (elmo-msgdb-mark-alist-to-seen-list
1217                             number-alist mark-alist
1218                             (concat important-mark read-uncached-mark))
1219                            seen-list))
1220           (elmo-folder-clear folder (eq ignore-msgdb 'visible-only))))
1221     (unless no-check (elmo-folder-check folder))
1222     (condition-case nil
1223         (progn
1224           (message "Checking folder diff...")
1225           ;; TODO: killed list is loaded in elmo-folder-open and
1226           ;; list-messages use internal killed-list-folder.
1227           (setq diff (elmo-list-diff (elmo-folder-list-messages
1228                                       folder
1229                                       (eq 'visible-only ignore-msgdb))
1230                                      (unless ignore-msgdb
1231                                        (sort (mapcar
1232                                               'car
1233                                               number-alist)
1234                                              '<))))
1235           (message "Checking folder diff...done")
1236           (setq new-list (elmo-folder-confirm-appends (car diff)))
1237           ;; Set killed list.
1238           (when (and (not (eq (length (car diff))
1239                               (length new-list)))
1240                      (setq diff-2 (elmo-list-diff (car diff) new-list)))
1241             (elmo-msgdb-append-to-killed-list folder (car diff-2)))
1242           ;; Don't delete important marked messages.
1243           (setq delete-list
1244                 (if (eq (elmo-folder-type-internal folder) 'mark)
1245                     (cadr diff)
1246                   (elmo-delete-if
1247                    (lambda (x)
1248                      (and (setq mark (cadr (assq x mark-alist)))
1249                           (string= mark important-mark)))
1250                    ;; delete message list
1251                    (cadr diff))))
1252           (if (or (equal diff '(nil nil))
1253                   (equal diff '(nil))
1254                   (and (eq (length (car diff)) 0)
1255                        (eq (length (cadr diff)) 0)))
1256               (progn
1257                 (elmo-folder-update-number folder)
1258                 (elmo-folder-process-crosspost folder)
1259                 (list nil nil nil) ; no updates.
1260                 )
1261             (if delete-list (elmo-msgdb-delete-msgs
1262                              (elmo-folder-msgdb folder) delete-list))
1263             (when new-list
1264               (setq new-msgdb (elmo-folder-msgdb-create
1265                                folder
1266                                new-list
1267                                new-mark unread-cached-mark
1268                                read-uncached-mark important-mark
1269                                seen-list))
1270               (elmo-msgdb-change-mark (elmo-folder-msgdb folder)
1271                                       new-mark unread-uncached-mark)
1272               ;; Clear seen-list.
1273               (if (elmo-folder-persistent-p folder)
1274                   (setq seen-list (elmo-msgdb-seen-save
1275                                    (elmo-folder-msgdb-path folder) nil)))
1276               (setq before-append nil)
1277               (setq crossed (elmo-folder-append-msgdb folder new-msgdb))
1278               ;; process crosspost.
1279               ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).
1280               (elmo-folder-process-crosspost folder)
1281               (elmo-folder-set-message-modified-internal folder t)
1282               (elmo-folder-set-mark-modified-internal folder t))
1283             ;; return value.
1284             (list new-msgdb delete-list crossed)))
1285       (quit
1286        ;; Resume to the original status.
1287        (if before-append
1288            (elmo-folder-set-msgdb-internal folder old-msgdb))
1289        (elmo-folder-set-killed-list-internal folder killed-list)
1290        nil))))
1291
1292 (defun elmo-folder-messages (folder)
1293   "Return number of messages in the FOLDER."
1294   (length
1295    (elmo-msgdb-get-number-alist
1296     (elmo-folder-msgdb folder))))
1297
1298 ;;;
1299 (defun elmo-msgdb-search (folder condition msgdb)
1300   "Search messages which satisfy CONDITION from FOLDER with MSGDB."
1301   (let* ((condition (car (elmo-parse-search-condition condition)))
1302          (overview (elmo-msgdb-get-overview msgdb))
1303          (number-alist (elmo-msgdb-get-number-alist msgdb))
1304          (number-list (mapcar 'car number-alist))
1305          (length (length overview))
1306          (i 0)
1307          result)
1308     (if (not (elmo-condition-in-msgdb-p condition))
1309         (elmo-folder-search folder condition number-list)
1310       (while overview
1311         (if (elmo-msgdb-search-internal condition (car overview)
1312                                         number-list)
1313             (setq result
1314                   (cons
1315                    (elmo-msgdb-overview-entity-get-number (car overview))
1316                    result)))
1317         (setq i (1+ i))
1318         (elmo-display-progress
1319          'elmo-msgdb-search "Searching..." (/ (* i 100) length))
1320         (setq overview (cdr overview)))
1321       (nreverse result))))
1322
1323 (defun elmo-msgdb-load (folder)
1324   (message "Loading msgdb for %s..." (elmo-folder-name-internal folder))
1325   (let* ((path (elmo-folder-msgdb-path folder))
1326          (overview (elmo-msgdb-overview-load path))
1327          (msgdb (list overview
1328                       (elmo-msgdb-number-load path)
1329                       (elmo-msgdb-mark-load path)
1330                       (elmo-msgdb-make-overview-hashtb overview))))
1331     (message "Loading msgdb for %s...done" (elmo-folder-name-internal folder))
1332     (elmo-folder-set-info-max-by-numdb folder
1333                                        (elmo-msgdb-get-number-alist msgdb))
1334     msgdb))
1335
1336 (defun elmo-msgdb-delete-path (folder)
1337   (let ((path (elmo-folder-msgdb-path folder)))
1338     (if (file-directory-p path)
1339         (elmo-delete-directory path t))))
1340
1341 (defun elmo-msgdb-rename-path (old-folder new-folder)
1342   (let* ((old (directory-file-name (elmo-folder-msgdb-path old-folder)))
1343          (new (directory-file-name (elmo-folder-msgdb-path new-folder)))
1344          (new-dir (directory-file-name (file-name-directory new))))
1345     (if (not (file-directory-p old))
1346         ()
1347       (if (file-exists-p new)
1348           (error "Already exists directory: %s" new)
1349         (if (not (file-exists-p new-dir))
1350             (elmo-make-directory new-dir))
1351         (rename-file old new)))))
1352
1353 (defun elmo-setup-subscribed-newsgroups (groups)
1354   "Setup subscribed newsgroups.
1355 GROUPS is a list of newsgroup name string.
1356 Return a hashtable for newsgroups."
1357   (let ((hashtb (or elmo-newsgroups-hashtb
1358                     (setq elmo-newsgroups-hashtb
1359                           (elmo-make-hash (length groups))))))
1360     (dolist (group groups)
1361       (or (elmo-get-hash-val group hashtb)
1362           (elmo-set-hash-val group nil hashtb)))
1363     (setq elmo-newsgroups-hashtb hashtb)))
1364
1365 (defvar elmo-crosspost-message-alist-modified nil)
1366 (defun elmo-crosspost-message-alist-load ()
1367   "Load crosspost message alist."
1368   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
1369   (setq elmo-crosspost-message-alist-modified nil))
1370
1371 (defun elmo-crosspost-message-alist-save ()
1372   "Save crosspost message alist."
1373   (when elmo-crosspost-message-alist-modified
1374     (let ((alist elmo-crosspost-message-alist)
1375           newsgroups)
1376       (while alist
1377         (setq newsgroups
1378               (elmo-delete-if
1379                '(lambda (x)
1380                   (not (intern-soft x elmo-newsgroups-hashtb)))
1381                (nth 1 (car alist))))
1382         (if newsgroups
1383             (setcar (cdar alist) newsgroups)
1384           (setq elmo-crosspost-message-alist
1385                 (delete (car alist) elmo-crosspost-message-alist)))
1386         (setq alist (cdr alist)))
1387       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
1388       (setq elmo-crosspost-message-alist-modified nil))))
1389
1390 (defun elmo-folder-make-temp-dir (folder)
1391   ;; Make a temporary directory for FOLDER.
1392   (let ((temp-dir (make-temp-name
1393                    (concat
1394                     (file-name-as-directory (elmo-folder-msgdb-path folder))
1395                     "elmo"))))
1396     (elmo-make-directory temp-dir)
1397     temp-dir))
1398
1399 (defun elmo-init ()
1400   "Initialize ELMO module."
1401   (elmo-crosspost-message-alist-load)
1402   (elmo-resque-obsolete-variables)
1403   (elmo-dop-queue-load))
1404
1405 (defun elmo-quit ()
1406   "Quit and cleanup ELMO."
1407   (elmo-crosspost-message-alist-save)
1408   (elmo-dop-queue-save)
1409   ;; Not implemented yet.
1410   (let ((types elmo-folder-type-alist)
1411         class)
1412     (while types
1413       (setq class
1414             (luna-find-class
1415              (intern (format "elmo-%s-folder" (symbol-name (cdr (car types)))))))
1416       ;; Call all folder's `elmo-quit' method.
1417       (if class
1418           (dolist (func (luna-class-find-functions class 'elmo-quit))
1419             (funcall func nil)))
1420       (setq types (cdr types)))))
1421
1422
1423 ;;; Define folders.
1424 (elmo-define-folder ?% 'imap4)
1425 (elmo-define-folder ?-  'nntp)
1426 (elmo-define-folder ?\+ 'localdir)
1427 (elmo-define-folder ?\* 'multi)
1428 (elmo-define-folder ?\/ 'filter)
1429 (elmo-define-folder ?\$ 'archive)
1430 (elmo-define-folder ?&  'pop3)
1431 (elmo-define-folder ?=  'localnews)
1432 (elmo-define-folder ?|  'pipe)
1433 (elmo-define-folder ?.  'maildir)
1434 (elmo-define-folder ?'  'internal)
1435 (elmo-define-folder ?\[  'nmz)
1436 (elmo-define-folder ?@  'shimbun)
1437
1438 ;;; Obsolete variables.
1439 (elmo-define-obsolete-variable 'elmo-default-imap4-mailbox
1440                                'elmo-imap4-default-mailbox)
1441 (elmo-define-obsolete-variable 'elmo-default-imap4-server
1442                                'elmo-imap4-default-server)
1443 (elmo-define-obsolete-variable 'elmo-default-imap4-authenticate-type
1444                                'elmo-imap4-default-authenticate-type)
1445 (elmo-define-obsolete-variable 'elmo-default-imap4-user
1446                                'elmo-imap4-default-user)
1447 (elmo-define-obsolete-variable 'elmo-default-imap4-port
1448                                'elmo-imap4-default-port)
1449 (elmo-define-obsolete-variable 'elmo-default-nntp-server
1450                                'elmo-nntp-default-server)
1451 (elmo-define-obsolete-variable 'elmo-default-nntp-user
1452                                'elmo-nntp-default-user)
1453 (elmo-define-obsolete-variable 'elmo-default-nntp-port
1454                                'elmo-nntp-default-port)
1455 (elmo-define-obsolete-variable 'elmo-default-pop3-server
1456                                'elmo-pop3-default-server)
1457 (elmo-define-obsolete-variable 'elmo-default-pop3-user
1458                                'elmo-pop3-default-user)
1459 (elmo-define-obsolete-variable 'elmo-default-pop3-authenticate-type
1460                                'elmo-pop3-default-authenticate-type)
1461 (elmo-define-obsolete-variable 'elmo-default-pop3-port
1462                                'elmo-pop3-default-port)
1463
1464 ;; autoloads
1465 (autoload 'elmo-dop-queue-flush "elmo-dop")
1466
1467 (require 'product)
1468 (product-provide (provide 'elmo) (require 'elmo-version))
1469
1470 ;;; elmo.el ends here