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   "Un-mark messages as read.
 349 FOLDER is the ELMO folder structure.
 350 NUMBERS is a list of message numbers to be processed.")
 351
 352 (luna-define-generic elmo-folder-mark-as-read (folder numbers)
 353   "Mark messages as read.
 354 FOLDER is the ELMO folder structure.
 355 NUMBERS is a list of message numbers to be processed.")
 356
 357 (luna-define-generic elmo-folder-unmark-answered (folder numbers)
 358   "Un-mark messages as answered.
 359 FOLDER is the ELMO folder structure.
 360 NUMBERS is a list of message numbers to be processed.")
 361
 362 (luna-define-generic elmo-folder-mark-as-answered (folder numbers)
 363   "Mark messages as answered.
 364 FOLDER is the ELMO folder structure.
 365 NUMBERS is a list of message numbers to be processed.")
 366
 367 (luna-define-generic elmo-folder-append-buffer (folder unread &optional number)
 368   "Append current buffer as a new message.
 369 FOLDER is the destination folder(ELMO folder structure).
 370 If UNREAD is non-nil, message is appended as unread.
 371 If optional argument NUMBER is specified, the new message number is set
 372 (if possible).")
 373
 374 (luna-define-generic elmo-folder-append-messages (folder
 375                                                   src-folder
 376                                                   numbers
 377                                                   &optional
 378                                                   same-number)
 379   "Append messages from folder.
 380 FOLDER is the ELMO folder structure.
 381 Caller should make sure FOLDER is `writable'.
 382 (Can be checked with `elmo-folder-writable-p').
 383 SRC-FOLDER is the source ELMO folder structure.
 384 NUMBERS is the message numbers to be appended in the SRC-FOLDER.
 385 If second optional argument SAME-NUMBER is specified,
 386 message number is preserved (if possible).")
 387
 388 (luna-define-generic elmo-folder-pack-numbers (folder)
 389   "Pack message numbers of FOLDER.")
 390
 391 (luna-define-generic elmo-folder-update-number (folder)
 392   "Update number of FOLDER.")
 393
 394 (luna-define-generic elmo-folder-diff-async (folder)
 395   "Get diff of FOLDER asynchronously.")
 396
 397 (luna-define-generic elmo-folder-expand-msgdb-path (folder)
 398   "Expand path for FOLDER.")
 399
 400 (luna-define-generic elmo-folder-get-primitive-list (folder)
 401   "Get primitive folder structure list contained in FOLDER.")
 402
 403 (luna-define-generic elmo-folder-contains-type (folder type)
 404   "Returns t if FOLDER contains TYPE.")
 405
 406 (luna-define-generic elmo-folder-local-p (folder)
 407   "Returns t if FOLDER is local.")
 408
 409 (luna-define-generic elmo-folder-message-file-p (folder)
 410   "Returns t if all messages in the FOLDER are files.")
 411
 412 ;;; Message methods.
 413 (luna-define-generic elmo-message-use-cache-p (folder number)
 414   "Returns t if the message in the FOLDER with NUMBER uses cache.")
 415
 416 (luna-define-generic elmo-message-file-name (folder number)
 417   "Return the file name of a message specified by FOLDER and NUMBER.")
 418
 419 ;;; For archive
 420
 421 ;;; Use original file
 422 (luna-define-generic elmo-folder-message-file-number-p (folder)
 423   "Return t if the file name in the FOLDER is the message number.")
 424
 425 (luna-define-generic elmo-folder-message-file-directory (folder)
 426   "Return the directory of the message files of FOLDER.")
 427
 428 ;;; Use temporary file
 429 (luna-define-generic elmo-folder-message-make-temp-file-p (folder)
 430   "Return t if the messages in the FOLDER makes local temporary file.")
 431
 432 (luna-define-generic elmo-folder-message-make-temp-files (folder
 433                                                           numbers
 434                                                           &optional
 435                                                           start-number)
 436   "Make a new temporary files from the messages in the FOLDER with NUMBERS.
 437 If START-NUMBER is specified, temporary files begin from the number.
 438 Otherwise, same number is used for temporary files.
 439 Return newly created temporary directory name which contains temporary files.")
 440
 441 (luna-define-generic elmo-message-file-p (folder number)
 442   "Return t if message in the FOLDER with NUMBER is a file.")
 443
 444 (luna-define-generic elmo-find-fetch-strategy
 445   (folder entity &optional ignore-cache)
 446 ;; Returns the message fetching strategy suitable for the message.
 447 ;; FOLDER is the ELMO folder structure.
 448 ;; ENTITY is the overview entity of the message in the folder.
 449 ;; If optional argument IGNORE-CACHE is non-nil, cache is ignored.
 450 ;; Returned value is a elmo-fetch-strategy object.
 451 ;; If return value is nil, message should not be nil.
 452   )
 453
 454 (defmacro elmo-make-fetch-strategy (entireness
 455                                     &optional
 456                                     use-cache
 457                                     save-cache
 458                                     cache-path)
 459 ;; Make elmo-message-fetching strategy.
 460 ;; ENTIRENESS is 'entire or 'section.
 461 ;; 'entire means fetch message entirely at once.
 462 ;; 'section means fetch message section by section.
 463 ;; If optional USE-CACHE is non-nil, existing cache is used and otherwise,
 464 ;; existing cache is thrown away.
 465 ;; If SAVE-CACHE is non-nil, fetched message is saved.
 466 ;; CACHE-PATH is the cache path to be used as a message cache file.
 467   (` (vector (, entireness)
 468              (, use-cache) (, save-cache) (, cache-path))))
 469
 470 (defmacro elmo-fetch-strategy-entireness (strategy)
 471   ;; Return entireness of STRATEGY.
 472   (` (aref (, strategy) 0)))
 473
 474 (defmacro elmo-fetch-strategy-use-cache (strategy)
 475   ;; Return use-cache of STRATEGY.
 476   (` (aref (, strategy) 1)))
 477
 478 (defmacro elmo-fetch-strategy-save-cache (strategy)
 479   ;; Return save-cache of STRATEGY.
 480   (` (aref (, strategy) 2)))
 481
 482 (defmacro elmo-fetch-strategy-cache-path (strategy)
 483   ;;  Return cache-path of STRATEGY.
 484   (` (aref (, strategy) 3)))
 485
 486 (luna-define-method elmo-find-fetch-strategy
 487   ((folder elmo-folder) entity &optional ignore-cache)
 488   (let (cache-file size message-id number)
 489     (setq size (elmo-msgdb-overview-entity-get-size entity))
 490     (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 491     (setq number (elmo-msgdb-overview-entity-get-number entity))
 492     (setq cache-file (elmo-file-cache-get message-id))
 493     (setq ignore-cache (or ignore-cache
 494                            (null (elmo-message-use-cache-p folder number))))
 495     (if (or ignore-cache
 496             (null (elmo-file-cache-status cache-file)))
 497         ;; No cache or ignore-cache.
 498         (if (and (not (elmo-folder-local-p folder))
 499                  elmo-message-fetch-threshold
 500                  (integerp size)
 501                  (>= size elmo-message-fetch-threshold)
 502                  (or (not elmo-message-fetch-confirm)
 503                      (not (prog1 (y-or-n-p
 504                                   (format "Fetch entire message(%dbytes)? "
 505                                           size))
 506                             (message "")))))
 507             ;; Don't fetch message at all.
 508             nil
 509           ;; Don't use existing cache and fetch entire message at once.
 510           (elmo-make-fetch-strategy
 511            'entire nil
 512            (elmo-message-use-cache-p folder number)
 513            (elmo-file-cache-path cache-file)))
 514       ;; Cache exists.
 515       (if (not ignore-cache)
 516           (elmo-make-fetch-strategy
 517            'entire
 518            ;; ...But ignore current section cache and re-fetch
 519            ;; if section cache.
 520            (not (eq (elmo-file-cache-status cache-file) 'section))
 521            ;; Save cache.
 522            (elmo-message-use-cache-p folder number)
 523            (elmo-file-cache-path cache-file))))))
 524
 525 (luna-define-method elmo-folder-list-messages-internal
 526   ((folder elmo-folder) &optional visible-only)
 527   t)
 528
 529 (defun elmo-folder-encache (folder numbers &optional unread)
 530   "Encache messages in the FOLDER with NUMBERS.
 531 If UNREAD is non-nil, messages are not marked as read."
 532   (dolist (number numbers)
 533     (elmo-message-encache folder number unread)))
 534
 535 (luna-define-generic elmo-message-encache (folder number &optional read)
 536   "Encache message in the FOLDER with NUMBER.
 537 If READ is non-nil, message is marked as read.")
 538
 539 (luna-define-method elmo-message-encache ((folder elmo-folder) number
 540                                           &optional read)
 541   (elmo-message-fetch
 542    folder number
 543    (elmo-make-fetch-strategy 'entire
 544                              nil ;use-cache
 545                              t   ;save-cache
 546                              (elmo-file-cache-get-path
 547                               (elmo-message-field
 548                                folder number 'message-id)))
 549    nil nil (not read)))
 550
 551 (luna-define-generic elmo-message-fetch (folder number strategy
 552                                                 &optional
 553                                                 section
 554                                                 outbuf
 555                                                 unread)
 556   "Fetch a message and return as a string.
 557 FOLDER is the ELMO folder structure.
 558 NUMBER is the number of the message in the FOLDER.
 559 STRATEGY is the message fetching strategy.
 560 If optional argument SECTION is specified, only the SECTION of the message
 561 is fetched (if possible).
 562 If second optional argument OUTBUF is specified, fetched message is
 563 inserted to the buffer and returns t if fetch was ended successfully.
 564 If third optional argument UNREAD is non-nil, message is not marked as read.
 565 Returns non-nil if fetching was succeed.")
 566
 567 (luna-define-generic elmo-message-fetch-with-cache-process (folder
 568                                                             number strategy
 569                                                             &optional
 570                                                             section
 571                                                             unread)
 572   "Fetch a message into current buffer with cache process.
 573 FOLDER is the ELMO folder structure.
 574 NUMBER is the number of the message in the FOLDER.
 575 STRATEGY is the message fetching strategy.
 576 If optional argument SECTION is specified, only the SECTION of the message
 577 is fetched (if possible).
 578 If second optional argument UNREAD is non-nil, message is not marked as read.
 579 Returns non-nil if fetching was succeed.")
 580
 581 (luna-define-generic elmo-message-fetch-internal (folder number strategy
 582                                                          &optional
 583                                                          section
 584                                                          unread)
 585   "Fetch a message into current buffer.
 586 FOLDER is the ELMO folder structure.
 587 NUMBER is the number of the message in the FOLDER.
 588 STRATEGY is the message fetching strategy.
 589 If optional argument SECTION is specified, only the SECTION of the message
 590 is fetched (if possible).
 591 If second optional argument UNREAD is non-nil, message is not marked as read.
 592 Returns non-nil if fetching was succeed.")
 593
 594 (luna-define-generic elmo-message-fetch-field (folder number field)
 595   "Fetch a message field value.
 596 FOLDER is the ELMO folder structure.
 597 NUMBER is the number of the message in the FOLDER.
 598 FIELD is a symbol of the field name.")
 599
 600 (luna-define-generic elmo-message-folder (folder number)
 601   "Get primitive folder of the message.")
 602
 603 (luna-define-generic elmo-folder-process-crosspost (folder
 604                                                     &optional
 605                                                     number-alist)
 606   "Process crosspost for FOLDER.
 607 If NUMBER-ALIST is set, it is used as number-alist.
 608 Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
 609
 610 (luna-define-generic elmo-folder-append-msgdb (folder append-msgdb)
 611   "Append  APPEND-MSGDB to the current msgdb of the folder.")
 612
 613 (luna-define-generic elmo-folder-newsgroups (folder)
 614   "Return list of newsgroup name of FOLDER.")
 615
 616 (luna-define-generic elmo-folder-search-requires-msgdb-p (folder condition)
 617   "Return non-nil if searching in FOLDER by CONDITION requires msgdb fetch.")
 618
 619 (defun elmo-folder-search-requires-msgdb-p-internal (folder condition)
 620   (if (listp condition)
 621       (or (elmo-folder-search-requires-msgdb-p-internal
 622            folder (nth 1 condition))
 623           (elmo-folder-search-requires-msgdb-p-internal
 624            folder (nth 2 condition)))
 625     (and (not (string= (elmo-filter-key condition) "last"))
 626          (not (string= (elmo-filter-key condition) "first")))))
 627
 628 (luna-define-method elmo-folder-search-requires-msgdb-p ((folder elmo-folder)
 629                                                          condition)
 630   (elmo-folder-search-requires-msgdb-p-internal folder condition))
 631
 632 (luna-define-method elmo-folder-newsgroups ((folder elmo-folder))
 633   nil)
 634
 635 (luna-define-method elmo-folder-open ((folder elmo-folder)
 636                                       &optional load-msgdb)
 637   (elmo-generic-folder-open folder load-msgdb))
 638
 639 (defun elmo-generic-folder-open (folder load-msgdb)
 640   (let ((inhibit-quit t))
 641     (if load-msgdb (elmo-folder-msgdb folder))
 642     (elmo-folder-set-killed-list-internal
 643      folder
 644      (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
 645   (elmo-folder-open-internal folder))
 646
 647 (luna-define-method elmo-folder-open-internal ((folder elmo-folder))
 648   nil ; default is do nothing.
 649   )
 650
 651 (luna-define-method elmo-folder-check ((folder elmo-folder))
 652   nil) ; default is noop.
 653
 654 (luna-define-method elmo-folder-commit ((folder elmo-folder))
 655   (elmo-generic-folder-commit folder))
 656
 657 (defun elmo-generic-folder-commit (folder)
 658   (when (elmo-folder-persistent-p folder)
 659     (when (elmo-folder-message-modified-internal folder)
 660       (elmo-msgdb-overview-save
 661        (elmo-folder-msgdb-path folder)
 662        (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))
 663       (elmo-msgdb-number-save
 664        (elmo-folder-msgdb-path folder)
 665        (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))
 666       (elmo-folder-set-info-max-by-numdb
 667        folder
 668        (elmo-msgdb-get-number-alist
 669         (elmo-folder-msgdb folder)))
 670       (elmo-folder-set-message-modified-internal folder nil)
 671       (elmo-msgdb-killed-list-save
 672        (elmo-folder-msgdb-path folder)
 673        (elmo-folder-killed-list-internal folder)))
 674     (when (elmo-folder-mark-modified-internal folder)
 675       (elmo-msgdb-mark-save
 676        (elmo-folder-msgdb-path folder)
 677        (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
 678       (elmo-folder-set-mark-modified-internal folder nil))))
 679
 680 (luna-define-method elmo-folder-close-internal ((folder elmo-folder))
 681   ;; do nothing.
 682   )
 683
 684 (luna-define-method elmo-folder-close ((folder elmo-folder))
 685   (elmo-generic-folder-close folder)
 686   (elmo-folder-close-internal folder))
 687
 688 (defun elmo-generic-folder-close (folder)
 689   (elmo-folder-commit folder)
 690   (elmo-folder-set-msgdb-internal folder nil)
 691   (elmo-folder-set-killed-list-internal folder nil))
 692
 693 (luna-define-method elmo-folder-plugged-p ((folder elmo-folder))
 694   t) ; default is plugged.
 695
 696 (luna-define-method elmo-folder-set-plugged ((folder elmo-folder) plugged
 697                                              &optional add)
 698   nil) ; default is do nothing.
 699
 700 (luna-define-method elmo-folder-use-flag-p ((folder elmo-folder))
 701   nil) ; default is no flag.
 702
 703 (luna-define-method elmo-folder-persistent-p ((folder elmo-folder))
 704   (elmo-folder-persistent-internal folder))
 705
 706 (luna-define-method elmo-folder-creatable-p ((folder elmo-folder))
 707   nil) ; default is not creatable.
 708
 709 (luna-define-method elmo-folder-writable-p ((folder elmo-folder))
 710   nil) ; default is not writable.
 711
 712 (luna-define-method elmo-folder-delete ((folder elmo-folder))
 713   (elmo-msgdb-delete-path folder))
 714
 715 (luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
 716   (let* ((new-folder (elmo-make-folder new-name)))
 717     (unless (eq (elmo-folder-type-internal folder)
 718                 (elmo-folder-type-internal new-folder))
 719       (error "Not same folder type"))
 720     (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
 721             (elmo-folder-exists-p new-folder))
 722         (error "Already exists folder: %s" new-name))
 723     (elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
 724     (elmo-msgdb-rename-path folder new-folder)))
 725
 726 (defsubst elmo-folder-search-fast (folder condition numbers)
 727   (when (and numbers
 728              (vectorp condition)
 729              (member (elmo-filter-key condition) '("first" "last" "mark")))
 730     (if (string= (elmo-filter-key condition) "mark")
 731         (let ((msgdb (elmo-folder-msgdb folder)))
 732           ;; msgdb should be synchronized at this point.
 733           (cond
 734            ((string= (elmo-filter-value condition) "unread")
 735             (elmo-folder-list-unreads folder))
 736            ((string= (elmo-filter-value condition) "important")
 737             (elmo-folder-list-importants folder))
 738            ((string= (elmo-filter-value condition) "answered")
 739             (elmo-folder-list-answereds folder))
 740            ((string= (elmo-filter-value condition) "any")
 741             (nconc (elmo-folder-list-unreads folder)
 742                    (elmo-folder-list-importants folder)
 743                    (elmo-folder-list-answereds folder)))))
 744       (let ((len (length numbers))
 745             (lastp (string= (elmo-filter-key condition) "last"))
 746             (value (string-to-number (elmo-filter-value condition))))
 747         (when (eq (elmo-filter-type condition) 'unmatch)
 748           (setq lastp (not lastp)
 749                 value  (- len value)))
 750         (if lastp
 751             (nthcdr (max (- len value) 0) numbers)
 752           (when (> value 0)
 753             (let ((last (nthcdr (1- value) numbers)))
 754               (when last
 755                 (setcdr last nil))
 756               numbers)))))))
 757
 758 (luna-define-method elmo-folder-search ((folder elmo-folder)
 759                                         condition
 760                                         &optional numbers)
 761   (let ((numbers (or numbers (elmo-folder-list-messages folder))))
 762     (or (elmo-folder-search-fast folder condition numbers)
 763         (let ((msgdb (elmo-folder-msgdb folder))
 764               (len (length numbers))
 765               matched)
 766           (when (> len elmo-display-progress-threshold)
 767             (elmo-progress-set 'elmo-folder-search len "Searching..."))
 768           (unwind-protect
 769               (dolist (number numbers)
 770                 (let ((entity (elmo-msgdb-overview-get-entity number msgdb))
 771                       result)
 772                   (if entity
 773                       (setq result (elmo-msgdb-match-condition
 774                                     condition
 775                                     entity
 776                                     numbers))
 777                     (setq result condition))
 778                   (when (elmo-filter-condition-p result)
 779                     (setq result (elmo-message-match-condition
 780                                   folder
 781                                   number
 782                                   condition
 783                                   numbers)))
 784                   (when result
 785                     (setq matched (cons number matched))))
 786                 (elmo-progress-notify 'elmo-folder-search))
 787             (elmo-progress-clear 'elmo-folder-search))
 788           (nreverse matched)))))
 789
 790 (luna-define-method elmo-message-match-condition ((folder elmo-folder)
 791                                                   number condition
 792                                                   numbers)
 793   (let ((filename (cond
 794                    ((elmo-message-file-name folder number))
 795                    ((let* ((cache (elmo-file-cache-get
 796                                    (elmo-message-field folder number
 797                                                        'message-id)))
 798                            (cache-path (elmo-file-cache-path cache)))
 799                       (when (and cache-path
 800                                  (not (elmo-cache-path-section-p cache-path)))
 801                         cache-path))))))
 802     (when (and filename
 803                (file-readable-p filename))
 804       (with-temp-buffer
 805         (insert-file-contents-as-binary filename)
 806         (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 807         ;; Should consider charset?
 808         (decode-mime-charset-region (point-min) (point-max) elmo-mime-charset)
 809         (elmo-buffer-field-condition-match condition number numbers)))))
 810
 811 (luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
 812   nil) ; default is noop.
 813
 814 (luna-define-method elmo-folder-update-number ((folder elmo-folder))
 815   nil) ; default is noop.
 816
 817 (luna-define-method elmo-folder-message-file-p ((folder elmo-folder))
 818   nil) ; default is not file.
 819
 820 (luna-define-method elmo-folder-message-file-number-p ((folder elmo-folder))
 821   nil) ; default is not number.
 822
 823 (luna-define-method elmo-folder-message-make-temp-file-p ((folder elmo-folder))
 824   nil) ; default is not make temp file.
 825
 826 (luna-define-method elmo-message-file-name ((folder elmo-folder)
 827                                                    number)
 828   nil) ; default is no name.
 829
 830 (luna-define-method elmo-folder-local-p ((folder elmo-folder))
 831   t)   ; default is local.
 832
 833 (luna-define-method elmo-folder-have-subfolder-p ((folder elmo-folder))
 834   t)
 835
 836 ;;; Folder info
 837 ;; Folder info is a message number information cache (hashtable)
 838 (defsubst elmo-folder-get-info (folder &optional hashtb)
 839   "Return FOLDER info from HASHTB (default is `elmo-folder-info-hashtb')."
 840   (elmo-get-hash-val (elmo-folder-name-internal folder)
 841                      (or hashtb elmo-folder-info-hashtb)))
 842
 843 (defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
 844   "Set FOLDER info (means MAX, NUMBERS, NEW and UNREAD)."
 845   (let ((info (elmo-folder-get-info folder)))
 846     (when info
 847       (or new     (setq new     (nth 0 info)))
 848       (or unread  (setq unread  (nth 1 info)))
 849       (or numbers (setq numbers (nth 2 info)))
 850       (or max     (setq max     (nth 3 info))))
 851     (elmo-set-hash-val (elmo-folder-name-internal folder)
 852                        (list new unread numbers max)
 853                        elmo-folder-info-hashtb)))
 854
 855 (defun elmo-folder-set-info-max-by-numdb (folder msgdb-number)
 856   "Set FOLDER info by MSGDB-NUMBER in msgdb."
 857   (let ((num-db (sort (mapcar 'car msgdb-number) '<)))
 858     (elmo-folder-set-info-hashtb
 859      folder
 860      (or (nth (max 0 (1- (length num-db))) num-db) 0)
 861      nil ;;(length num-db)
 862      )))
 863
 864 (defun elmo-folder-get-info-max (folder)
 865   "Return max number of FODLER from folder info."
 866   (nth 3 (elmo-folder-get-info folder)))
 867
 868 (defun elmo-folder-get-info-length (folder)
 869   "Return length of FODLER from folder info."
 870   (nth 2 (elmo-folder-get-info folder)))
 871
 872 (defun elmo-folder-get-info-unread (folder)
 873   "Return unread of FODLER from folder info."
 874   (nth 1 (elmo-folder-get-info folder)))
 875
 876 (defun elmo-folder-info-make-hashtb (info-alist hashtb)
 877   "Setup folder info hashtable by INFO-ALIST on HASHTB."
 878   (let* ((hashtb (or hashtb
 879                      (elmo-make-hash (length info-alist)))))
 880     (mapcar
 881      (lambda (x)
 882        (let ((info (cadr x)))
 883          (and (intern-soft (car x) hashtb)
 884               (elmo-set-hash-val (car x)
 885                                  (list (nth 2 info)   ;; new
 886                                        (nth 3 info)   ;; unread
 887                                        (nth 1 info)   ;; length
 888                                        (nth 0 info))  ;; max
 889                                  hashtb))))
 890      info-alist)
 891     (setq elmo-folder-info-hashtb hashtb)))
 892
 893 (defsubst elmo-diff-new (diff)
 894   (car diff))
 895
 896 (defsubst elmo-diff-unread (diff)
 897   (when (consp (cdr diff))
 898     (nth 1 diff)))
 899
 900 (defsubst elmo-diff-all (diff)
 901   (if (consp (cdr diff))
 902       (nth 2 diff)
 903     (cdr diff)))
 904
 905 (defsubst elmo-strict-folder-diff (folder)
 906   "Return folder diff information strictly from FOLDER."
 907   (let* ((dir (elmo-folder-msgdb-path folder))
 908          (nalist (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))
 909          (in-db (sort (mapcar 'car nalist) '<))
 910          (in-folder  (elmo-folder-list-messages folder))
 911          append-list delete-list diff)
 912     (cons (if (equal in-folder in-db)
 913               0
 914             (setq diff (elmo-list-diff
 915                         in-folder in-db
 916                         nil
 917                         ))
 918             (setq append-list (car diff))
 919             (setq delete-list (cadr diff))
 920             (if append-list
 921                 (length append-list)
 922               (if delete-list
 923                   (- 0 (length delete-list))
 924                 0)))
 925           (length in-folder))))
 926
 927 (luna-define-method elmo-folder-diff ((folder elmo-folder)
 928                                       &optional numbers)
 929   (elmo-generic-folder-diff folder numbers))
 930
 931 (defun elmo-generic-folder-diff (folder numbers)
 932   (if (elmo-string-match-member (elmo-folder-name-internal folder)
 933                                 elmo-strict-diff-folder-list)
 934       (elmo-strict-folder-diff folder)
 935     (let ((cached-in-db-max (elmo-folder-get-info-max folder))
 936           (in-folder (elmo-folder-status folder))
 937           (in-db t)
 938           unsync messages
 939           in-db-max)
 940       (if numbers
 941           (setq in-db-max (or (nth (max 0 (1- (length numbers))) numbers)
 942                               0))
 943         (if (not cached-in-db-max)
 944             (let ((number-list (mapcar 'car
 945                                        (elmo-msgdb-number-load
 946                                         (elmo-folder-msgdb-path folder)))))
 947               ;; No info-cache.
 948               (setq in-db (sort number-list '<))
 949               (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
 950                                   0))
 951               (elmo-folder-set-info-hashtb folder in-db-max nil))
 952           (setq in-db-max cached-in-db-max)))
 953       (setq unsync (if (and in-db
 954                             (car in-folder))
 955                        (- (car in-folder) in-db-max)
 956                      (if (and in-folder
 957                               (null in-db))
 958                          (cdr in-folder)
 959                        (if (null (car in-folder))
 960                            nil))))
 961       (setq messages (cdr in-folder))
 962       (if (and unsync messages (> unsync messages))
 963           (setq unsync messages))
 964       (cons (or unsync 0) (or messages 0)))))
 965
 966 (defvar elmo-folder-diff-async-callback nil)
 967 (defvar elmo-folder-diff-async-callback-data nil)
 968
 969 (luna-define-method elmo-folder-diff-async ((folder elmo-folder))
 970   (and elmo-folder-diff-async-callback
 971        (funcall elmo-folder-diff-async-callback
 972                 folder
 973                 (elmo-folder-diff folder))))
 974
 975 (luna-define-method elmo-folder-get-primitive-list ((folder elmo-folder))
 976   (list folder))
 977
 978 (luna-define-method elmo-folder-contains-type ((folder elmo-folder) type)
 979   (eq (elmo-folder-type-internal folder) type))
 980
 981 (luna-define-method elmo-folder-append-messages ((folder elmo-folder)
 982                                                  src-folder
 983                                                  numbers
 984                                                  &optional
 985                                                  same-number)
 986   (elmo-generic-folder-append-messages folder src-folder numbers
 987                                        same-number))
 988
 989 (defun elmo-generic-folder-append-messages (folder src-folder numbers
 990                                                    same-number)
 991   (let (unseen seen-list succeed-numbers failure cache)
 992     (with-temp-buffer
 993       (set-buffer-multibyte nil)
 994       (while numbers
 995         (setq failure nil)
 996         (condition-case nil
 997             (setq cache (elmo-file-cache-get
 998                          (elmo-message-field src-folder
 999                                              (car numbers)
1000                                              'message-id))
1001                   failure
1002                   (not
1003                    (and
1004                     (elmo-message-fetch
1005                      src-folder (car numbers)
1006                      (if (elmo-folder-plugged-p src-folder)
1007                          (elmo-make-fetch-strategy
1008                           'entire 'maybe nil
1009                           (and cache (elmo-file-cache-path cache)))
1010                        (or (and elmo-enable-disconnected-operation
1011                                 cache
1012                                 (eq (elmo-file-cache-status cache) 'entire)
1013                                 (elmo-make-fetch-strategy
1014                                  'entire t nil
1015                                  (elmo-file-cache-path cache)))
1016                            (error "Unplugged")))
1017                      nil (current-buffer)
1018                      'unread)
1019                     (> (buffer-size) 0)
1020                     (elmo-folder-append-buffer
1021                      folder
1022                      (setq unseen (member (elmo-message-mark
1023                                            src-folder (car numbers))
1024                                           (elmo-msgdb-unread-marks)))
1025                      (if same-number (car numbers))))))
1026           (error (setq failure t)))
1027         ;; FETCH & APPEND finished
1028         (unless failure
1029           (unless unseen
1030             (setq seen-list (cons (elmo-message-field
1031                                    src-folder (car numbers)
1032                                    'message-id)
1033                                   seen-list)))
1034           (setq succeed-numbers (cons (car numbers) succeed-numbers)))
1035         (elmo-progress-notify 'elmo-folder-move-messages)
1036         (setq numbers (cdr numbers)))
1037       (if (and seen-list (elmo-folder-persistent-p folder))
1038           (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder)
1039                                 (nconc (elmo-msgdb-seen-load
1040                                         (elmo-folder-msgdb-path folder))
1041                                        seen-list)))
1042       succeed-numbers)))
1043
1044 ;; Arguments should be reduced.
1045 (defun elmo-folder-move-messages (src-folder msgs dst-folder
1046                                              &optional msgdb
1047                                              no-delete-info
1048                                              no-delete
1049                                              same-number
1050                                              save-unread)
1051   (save-excursion
1052     (let* ((messages msgs)
1053            (elmo-inhibit-display-retrieval-progress t)
1054            (len (length msgs))
1055            succeeds i result)
1056       (if (eq dst-folder 'null)
1057           (setq succeeds messages)
1058         (unless (elmo-folder-writable-p dst-folder)
1059           (error "move: %d is not writable"
1060                  (elmo-folder-name-internal dst-folder)))
1061         (when messages
1062           ;; src is already opened.
1063           (elmo-folder-open-internal dst-folder)
1064           (unless (setq succeeds (elmo-folder-append-messages dst-folder
1065                                                               src-folder
1066                                                               messages
1067                                                               same-number))
1068             (error "move: append message to %s failed"
1069                    (elmo-folder-name-internal dst-folder)))
1070           (elmo-folder-close dst-folder))
1071         (when (and (elmo-folder-persistent-p dst-folder)
1072                    save-unread)
1073           ;; Save to seen list.
1074           (let* ((dir (elmo-folder-msgdb-path dst-folder))
1075                  (seen-list (elmo-msgdb-seen-load dir)))
1076             (setq seen-list
1077                   (elmo-msgdb-add-msgs-to-seen-list
1078                    msgs (elmo-folder-msgdb src-folder)
1079                    seen-list))
1080             (elmo-msgdb-seen-save dir seen-list))))
1081       (if (and (not no-delete) succeeds)
1082           (progn
1083             (if (not no-delete-info)
1084                 (message "Cleaning up src folder..."))
1085             (if (and (elmo-folder-delete-messages src-folder succeeds)
1086                      (elmo-msgdb-delete-msgs
1087                       (elmo-folder-msgdb src-folder) succeeds))
1088                 (setq result t)
1089               (message "move: delete messages from %s failed."
1090                        (elmo-folder-name-internal src-folder))
1091               (setq result nil))
1092             (if (and result
1093                      (not no-delete-info))
1094                 (message "Cleaning up src folder...done"))
1095             result)
1096         (if no-delete
1097             (progn
1098               (message "Copying messages...done")
1099               t)
1100           (if (eq len 0)
1101               (message "No message was moved.")
1102             (message "Moving messages failed.")
1103             nil ; failure
1104             ))))))
1105
1106 (defun elmo-folder-msgdb-path (folder)
1107   "Return the msgdb path for FOLDER."
1108   (or (elmo-folder-path-internal folder)
1109       (elmo-folder-set-path-internal
1110        folder
1111        (elmo-folder-expand-msgdb-path folder))))
1112
1113 (defun elmo-message-mark (folder number)
1114   "Get mark of the message.
1115 FOLDER is the ELMO folder structure.
1116 NUMBER is a number of the message."
1117   (elmo-msgdb-get-mark (elmo-folder-msgdb folder) number))
1118
1119 (defun elmo-folder-list-messages-mark-match (folder mark-regexp)
1120   "List messages in the FOLDER which have a mark that matches MARK-REGEXP"
1121   (let ((case-fold-search nil)
1122         matched)
1123     (if mark-regexp
1124         (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
1125           (if (string-match mark-regexp (cadr elem))
1126               (setq matched (cons (car elem) matched)))))
1127     matched))
1128
1129 (defun elmo-message-field (folder number field)
1130   "Get message field value in the msgdb.
1131 FOLDER is the ELMO folder structure.
1132 NUMBER is a number of the message.
1133 FIELD is a symbol of the field."
1134   (elmo-msgdb-get-field (elmo-folder-msgdb folder) number field))
1135
1136 (defun elmo-message-set-mark (folder number mark)
1137   ;; Set mark for the message in the FOLDER with NUMBER as MARK.
1138   (elmo-msgdb-set-mark
1139    (elmo-folder-msgdb folder)
1140    number mark))
1141
1142 (luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number)
1143   nil) ; default is not use cache.
1144
1145 (luna-define-method elmo-message-folder ((folder elmo-folder) number)
1146   folder) ; default is folder
1147
1148 (luna-define-method elmo-folder-unmark-important ((folder elmo-folder)
1149                                                   numbers)
1150   (when (elmo-folder-msgdb-internal folder)
1151     (dolist (number numbers)
1152       (elmo-msgdb-unset-status (elmo-folder-msgdb folder)
1153                                folder
1154                                number
1155                                'important))))
1156
1157 (luna-define-method elmo-folder-mark-as-important ((folder elmo-folder)
1158                                                    numbers)
1159   (when (elmo-folder-msgdb-internal folder)
1160     (dolist (number numbers)
1161       (elmo-msgdb-set-status (elmo-folder-msgdb folder)
1162                              folder
1163                              number
1164                              'important))))
1165
1166 (luna-define-method elmo-folder-unmark-read ((folder elmo-folder) numbers)
1167   (when (elmo-folder-msgdb-internal folder)
1168     (dolist (number numbers)
1169       (elmo-msgdb-unset-status (elmo-folder-msgdb folder)
1170                                folder
1171                                number
1172                                'read))))
1173
1174 (luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) numbers)
1175   (when (elmo-folder-msgdb-internal folder)
1176     (dolist (number numbers)
1177       (elmo-msgdb-set-status (elmo-folder-msgdb folder)
1178                              folder
1179                              number
1180                              'read))))
1181
1182 (luna-define-method elmo-folder-unmark-answered ((folder elmo-folder) numbers)
1183   (when (elmo-folder-msgdb-internal folder)
1184     (dolist (number numbers)
1185       (elmo-msgdb-unset-status (elmo-folder-msgdb folder)
1186                                folder
1187                                number
1188                                'answered))))
1189
1190 (luna-define-method elmo-folder-mark-as-answered ((folder elmo-folder) numbers)
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                              'answered))))
1197
1198 (luna-define-method elmo-folder-process-crosspost ((folder elmo-folder)
1199                                                    &optional
1200                                                    number-alist)
1201   ;; Do nothing.
1202   )
1203
1204 (defun elmo-generic-folder-append-msgdb (folder append-msgdb)
1205   (if append-msgdb
1206       (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
1207              (all-alist (copy-sequence (append
1208                                         (elmo-msgdb-get-number-alist
1209                                          (elmo-folder-msgdb folder))
1210                                         number-alist)))
1211              (cur number-alist)
1212              pair overview
1213              to-be-deleted
1214              mark-alist)
1215         (elmo-folder-set-msgdb-internal folder
1216                                         (elmo-msgdb-append
1217                                          (elmo-folder-msgdb folder)
1218                                          append-msgdb))
1219         (while cur
1220           (setq all-alist (delq (car cur) all-alist))
1221           ;; same message id exists.
1222           (if (setq pair (rassoc (cdr (car cur)) all-alist))
1223               (setq to-be-deleted (nconc to-be-deleted (list (car pair)))))
1224           (setq cur (cdr cur)))
1225         (cond ((eq (elmo-folder-process-duplicates-internal folder)
1226                    'hide)
1227                ;; Hide duplicates.
1228                (setq overview (elmo-delete-if
1229                                (lambda (x)
1230                                  (memq (elmo-msgdb-overview-entity-get-number
1231                                         x)
1232                                        to-be-deleted))
1233                                (elmo-msgdb-get-overview append-msgdb)))
1234                ;; Should be mark as read.
1235                (elmo-folder-mark-as-read folder to-be-deleted)
1236                (elmo-msgdb-set-overview append-msgdb overview))
1237               ((eq (elmo-folder-process-duplicates-internal folder)
1238                    'read)
1239                ;; Mark as read duplicates.
1240                (elmo-folder-mark-as-read folder to-be-deleted))
1241               (t
1242                ;; Do nothing.
1243                (setq to-be-deleted nil)))
1244         (length to-be-deleted))
1245     0))
1246
1247 (luna-define-method elmo-folder-append-msgdb ((folder elmo-folder)
1248                                               append-msgdb)
1249   (elmo-generic-folder-append-msgdb folder append-msgdb))
1250
1251 (defun elmo-folder-confirm-appends (appends)
1252   (let ((len (length appends))
1253         in)
1254     (if (and elmo-folder-update-threshold
1255              (> len elmo-folder-update-threshold)
1256              elmo-folder-update-confirm)
1257         (if (y-or-n-p (format "Too many messages(%d).  Update all? " len))
1258             appends
1259           (setq in elmo-folder-update-threshold)
1260           (catch 'end
1261             (while t
1262               (setq in (read-from-minibuffer "Update number: "
1263                                              (int-to-string in))
1264                     in (string-to-int in))
1265               (if (< len in)
1266                   (throw 'end len))
1267               (if (y-or-n-p (format "%d messages are not appeared.  OK? "
1268                                     (max (- len in) 0)))
1269                   (throw 'end in))))
1270           (nthcdr (max (- len in) 0) appends))
1271       (if (and elmo-folder-update-threshold
1272                (> len elmo-folder-update-threshold)
1273                (not elmo-folder-update-confirm))
1274           (nthcdr (max (- len elmo-folder-update-threshold) 0) appends)
1275         appends))))
1276
1277 (luna-define-method elmo-message-fetch ((folder elmo-folder)
1278                                         number strategy
1279                                         &optional
1280                                         section
1281                                         outbuf
1282                                         unread)
1283   (if outbuf
1284       (with-current-buffer outbuf
1285         (erase-buffer)
1286         (elmo-message-fetch-with-cache-process folder number
1287                                                strategy section unread))
1288     (with-temp-buffer
1289       (elmo-message-fetch-with-cache-process folder number
1290                                              strategy section unread)
1291       (buffer-string))))
1292
1293 (luna-define-method elmo-message-fetch-with-cache-process ((folder elmo-folder)
1294                                                            number strategy
1295                                                            &optional
1296                                                            section unread)
1297   (let ((cache-path (elmo-fetch-strategy-cache-path strategy))
1298         (method-priorities
1299          (cond ((eq (elmo-fetch-strategy-use-cache strategy) 'maybe)
1300                 '(entity cache))
1301                ((elmo-fetch-strategy-use-cache strategy)
1302                 '(cache entity))
1303                (t
1304                 '(entity))))
1305         result err)
1306     (while (and method-priorities
1307                 (null result))
1308       (setq result
1309             (case (car method-priorities)
1310               (cache
1311                (elmo-file-cache-load cache-path section))
1312               (entity
1313                (when (and (condition-case error
1314                               (elmo-message-fetch-internal folder number
1315                                                            strategy
1316                                                            section
1317                                                            unread)
1318                             (error (setq err error) nil))
1319                           (> (buffer-size) 0))
1320                  (elmo-delete-cr-buffer)
1321                  (when (and (elmo-fetch-strategy-save-cache strategy)
1322                             cache-path)
1323                    (elmo-file-cache-save cache-path section))
1324                  t)))
1325             method-priorities (cdr method-priorities)))
1326     (or result
1327         (and err (signal (car err) (cdr err))))))
1328
1329 (luna-define-method elmo-folder-clear ((folder elmo-folder)
1330                                        &optional keep-killed)
1331   (unless keep-killed
1332     (elmo-folder-set-killed-list-internal folder nil))
1333   (elmo-folder-set-msgdb-internal folder (elmo-msgdb-clear)))
1334
1335 (defun elmo-folder-synchronize (folder
1336                                 &optional ignore-msgdb
1337                                 no-check)
1338   "Synchronize the folder data to the newest status.
1339 FOLDER is the ELMO folder structure.
1340 If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except
1341 read mark status. If IGNORE-MSGDB is 'visible-only, only visible messages
1342 \(the messages which are not in the killed-list\) are thrown away and
1343 synchronized.
1344 If NO-CHECK is non-nil, rechecking folder is skipped.
1345
1346 Return a list of a cross-posted message number.
1347 If update process is interrupted, return nil."
1348   (let ((killed-list (elmo-folder-killed-list-internal folder))
1349         (before-append t)
1350         number-alist mark-alist
1351         old-msgdb diff diff-2 delete-list new-list new-msgdb mark
1352         seen-list crossed after-append)
1353     (setq old-msgdb (elmo-folder-msgdb folder))
1354     ;; Load seen-list.
1355     (setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder)))
1356     (setq number-alist (elmo-msgdb-get-number-alist
1357                         (elmo-folder-msgdb folder)))
1358     (setq mark-alist (elmo-msgdb-get-mark-alist
1359                       (elmo-folder-msgdb folder)))
1360     (if ignore-msgdb
1361         (progn
1362           (setq seen-list (nconc (elmo-msgdb-seen-list
1363                                   (elmo-folder-msgdb folder))
1364                                  seen-list))
1365           (elmo-folder-clear folder (eq ignore-msgdb 'visible-only))))
1366     (unless no-check (elmo-folder-check folder))
1367     (condition-case nil
1368         (progn
1369           (message "Checking folder diff...")
1370           ;; TODO: killed list is loaded in elmo-folder-open and
1371           ;; list-messages use internal killed-list-folder.
1372           (setq diff (elmo-list-diff (elmo-folder-list-messages
1373                                       folder
1374                                       (eq 'visible-only ignore-msgdb))
1375                                      (unless ignore-msgdb
1376                                        (sort (mapcar
1377                                               'car
1378                                               number-alist)
1379                                              '<))))
1380           (message "Checking folder diff...done")
1381           (setq new-list (elmo-folder-confirm-appends (car diff)))
1382           ;; Set killed list.
1383           (when (and (not (eq (length (car diff))
1384                               (length new-list)))
1385                      (setq diff-2 (elmo-list-diff (car diff) new-list)))
1386             (elmo-msgdb-append-to-killed-list folder (car diff-2)))
1387           (setq delete-list (cadr diff))
1388           (if (or (equal diff '(nil nil))
1389                   (equal diff '(nil))
1390                   (and (eq (length (car diff)) 0)
1391                        (eq (length (cadr diff)) 0)))
1392               (progn
1393                 (elmo-folder-update-number folder)
1394                 (elmo-folder-process-crosspost folder)
1395                 0 ; no updates.
1396                 )
1397             (if delete-list (elmo-msgdb-delete-msgs
1398                              (elmo-folder-msgdb folder) delete-list))
1399             (when new-list
1400               (setq new-msgdb (elmo-folder-msgdb-create
1401                                folder new-list seen-list))
1402               (elmo-msgdb-change-mark (elmo-folder-msgdb folder)
1403                                       elmo-msgdb-new-mark
1404                                       elmo-msgdb-unread-uncached-mark)
1405               ;; Clear seen-list.
1406               (if (elmo-folder-persistent-p folder)
1407                   (setq seen-list (elmo-msgdb-seen-save
1408                                    (elmo-folder-msgdb-path folder) nil)))
1409               (setq before-append nil)
1410               (setq crossed (elmo-folder-append-msgdb folder new-msgdb))
1411               ;; process crosspost.
1412               ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).
1413               (elmo-folder-process-crosspost folder)
1414               (elmo-folder-set-message-modified-internal folder t)
1415               (elmo-folder-set-mark-modified-internal folder t))
1416             ;; return value.
1417             (or crossed 0)))
1418       (quit
1419        ;; Resume to the original status.
1420        (if before-append
1421            (elmo-folder-set-msgdb-internal folder old-msgdb))
1422        (elmo-folder-set-killed-list-internal folder killed-list)
1423        nil))))
1424
1425 (defun elmo-folder-messages (folder)
1426   "Return number of messages in the FOLDER."
1427   (length
1428    (elmo-msgdb-get-number-alist
1429     (elmo-folder-msgdb folder))))
1430
1431 (defun elmo-msgdb-load (folder &optional silent)
1432   (unless silent
1433     (message "Loading msgdb for %s..." (elmo-folder-name-internal folder)))
1434   (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder))))
1435     (elmo-folder-set-info-max-by-numdb folder
1436                                        (elmo-msgdb-get-number-alist msgdb))
1437
1438     (unless silent
1439       (message "Loading msgdb for %s...done"
1440                (elmo-folder-name-internal folder)))
1441     msgdb))
1442
1443 (defun elmo-msgdb-delete-path (folder)
1444   (let ((path (elmo-folder-msgdb-path folder)))
1445     (if (file-directory-p path)
1446         (elmo-delete-directory path t))))
1447
1448 (defun elmo-msgdb-rename-path (old-folder new-folder)
1449   (let* ((old (directory-file-name (elmo-folder-msgdb-path old-folder)))
1450          (new (directory-file-name (elmo-folder-msgdb-path new-folder)))
1451          (new-dir (directory-file-name (file-name-directory new))))
1452     (if (not (file-directory-p old))
1453         ()
1454       (if (file-exists-p new)
1455           (error "Already exists directory: %s" new)
1456         (if (not (file-exists-p new-dir))
1457             (elmo-make-directory new-dir))
1458         (rename-file old new)))))
1459
1460 (defun elmo-setup-subscribed-newsgroups (groups)
1461   "Setup subscribed newsgroups.
1462 GROUPS is a list of newsgroup name string.
1463 Return a hashtable for newsgroups."
1464   (let ((hashtb (or elmo-newsgroups-hashtb
1465                     (setq elmo-newsgroups-hashtb
1466                           (elmo-make-hash (length groups))))))
1467     (dolist (group groups)
1468       (or (elmo-get-hash-val group hashtb)
1469           (elmo-set-hash-val group nil hashtb)))
1470     (setq elmo-newsgroups-hashtb hashtb)))
1471
1472 (defvar elmo-crosspost-message-alist-modified nil)
1473 (defun elmo-crosspost-message-alist-load ()
1474   "Load crosspost message alist."
1475   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
1476   (setq elmo-crosspost-message-alist-modified nil))
1477
1478 (defun elmo-crosspost-message-alist-save ()
1479   "Save crosspost message alist."
1480   (when elmo-crosspost-message-alist-modified
1481     (let ((alist elmo-crosspost-message-alist)
1482           newsgroups)
1483       (while alist
1484         (setq newsgroups
1485               (elmo-delete-if
1486                '(lambda (x)
1487                   (not (intern-soft x elmo-newsgroups-hashtb)))
1488                (nth 1 (car alist))))
1489         (if newsgroups
1490             (setcar (cdar alist) newsgroups)
1491           (setq elmo-crosspost-message-alist
1492                 (delete (car alist) elmo-crosspost-message-alist)))
1493         (setq alist (cdr alist)))
1494       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
1495       (setq elmo-crosspost-message-alist-modified nil))))
1496
1497 (defun elmo-folder-make-temporary-directory (folder)
1498   ;; Make a temporary directory for FOLDER.
1499   (let ((temp-dir (make-temp-name
1500                    (concat
1501                     (file-name-as-directory (elmo-folder-msgdb-path folder))
1502                     "elmo"))))
1503     (elmo-make-directory temp-dir)
1504     temp-dir))
1505
1506 (defun elmo-init ()
1507   "Initialize ELMO module."
1508   (elmo-crosspost-message-alist-load)
1509   (elmo-resque-obsolete-variables)
1510   (elmo-dop-queue-load))
1511
1512 (defun elmo-quit ()
1513   "Quit and cleanup ELMO."
1514   (elmo-crosspost-message-alist-save)
1515   (elmo-dop-queue-save)
1516   ;; Not implemented yet.
1517   (let ((types elmo-folder-type-alist)
1518         class)
1519     (while types
1520       (setq class
1521             (luna-find-class
1522              (intern (format "elmo-%s-folder" (symbol-name (cdr (car types)))))))
1523       ;; Call all folder's `elmo-quit' method.
1524       (if class
1525           (dolist (func (luna-class-find-functions class 'elmo-quit))
1526             (funcall func nil)))
1527       (setq types (cdr types)))))
1528
1529
1530 ;;; Define folders.
1531 (elmo-define-folder ?% 'imap4)
1532 (elmo-define-folder ?-  'nntp)
1533 (elmo-define-folder ?\+ 'localdir)
1534 (elmo-define-folder ?\* 'multi)
1535 (elmo-define-folder ?\/ 'filter)
1536 (elmo-define-folder ?\$ 'archive)
1537 (elmo-define-folder ?&  'pop3)
1538 (elmo-define-folder ?=  'localnews)
1539 (elmo-define-folder ?|  'pipe)
1540 (elmo-define-folder ?.  'maildir)
1541 (elmo-define-folder ?'  'internal)
1542 (elmo-define-folder ?\[  'nmz)
1543 (elmo-define-folder ?@  'shimbun)
1544
1545 ;;; Obsolete variables.
1546 (elmo-define-obsolete-variable 'elmo-default-imap4-mailbox
1547                                'elmo-imap4-default-mailbox)
1548 (elmo-define-obsolete-variable 'elmo-default-imap4-server
1549                                'elmo-imap4-default-server)
1550 (elmo-define-obsolete-variable 'elmo-default-imap4-authenticate-type
1551                                'elmo-imap4-default-authenticate-type)
1552 (elmo-define-obsolete-variable 'elmo-default-imap4-user
1553                                'elmo-imap4-default-user)
1554 (elmo-define-obsolete-variable 'elmo-default-imap4-port
1555                                'elmo-imap4-default-port)
1556 (elmo-define-obsolete-variable 'elmo-default-imap4-stream-type
1557                                'elmo-imap4-default-stream-type)
1558 (elmo-define-obsolete-variable 'elmo-default-nntp-server
1559                                'elmo-nntp-default-server)
1560 (elmo-define-obsolete-variable 'elmo-default-nntp-user
1561                                'elmo-nntp-default-user)
1562 (elmo-define-obsolete-variable 'elmo-default-nntp-port
1563                                'elmo-nntp-default-port)
1564 (elmo-define-obsolete-variable 'elmo-default-nntp-stream-type
1565                                'elmo-nntp-default-stream-type)
1566 (elmo-define-obsolete-variable 'elmo-default-pop3-server
1567                                'elmo-pop3-default-server)
1568 (elmo-define-obsolete-variable 'elmo-default-pop3-user
1569                                'elmo-pop3-default-user)
1570 (elmo-define-obsolete-variable 'elmo-default-pop3-authenticate-type
1571                                'elmo-pop3-default-authenticate-type)
1572 (elmo-define-obsolete-variable 'elmo-default-pop3-port
1573                                'elmo-pop3-default-port)
1574 (elmo-define-obsolete-variable 'elmo-default-pop3-stream-type
1575                                'elmo-pop3-default-stream-type)
1576 (elmo-define-obsolete-variable 'elmo-cache-dirname
1577                                'elmo-cache-directory)
1578 (elmo-define-obsolete-variable 'elmo-msgdb-dir
1579                                'elmo-msgdb-directory)
1580
1581 ;; Obsolete functions.
1582 ;; 2001-12-11: *-dir -> *-directory
1583 (defalias 'elmo-folder-make-temp-dir 'elmo-folder-make-temporary-directory)
1584 (make-obsolete 'elmo-folder-make-temp-dir
1585                'elmo-folder-make-temporary-directory)
1586
1587
1588 ;; autoloads
1589 (autoload 'elmo-dop-queue-flush "elmo-dop")
1590
1591 (require 'product)
1592 (product-provide (provide 'elmo) (require 'elmo-version))
1593
1594 ;;; elmo.el ends here