elmo/elmo.el

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