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