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