elmo/elmo2.el

   1 ;;; elmo2.el -- ELMO main file (I don't remember why this is 2).
   2
   3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7 ;; Time-stamp: <00/04/20 10:03:08 teranisi>
   8
   9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31 ;;
  32
  33 (require 'elmo-vars)
  34 (require 'elmo-msgdb)
  35 (require 'elmo-cache)
  36 (require 'elmo-util)
  37 (require 'elmo-dop)
  38 (provide 'elmo2)
  39
  40 (eval-when-compile
  41   (require 'elmo-localdir)
  42   (require 'elmo-imap4)
  43   (require 'elmo-nntp)
  44   (require 'elmo-pop3)
  45   (require 'elmo-pipe)
  46 ;  (require 'elmo-multi)
  47   (require 'elmo-filter)
  48   (require 'elmo-archive)
  49   ;(require 'elmo-cache2)
  50   )
  51
  52 (if (or (featurep 'dbm)
  53         (featurep 'gnudbm)
  54         (featurep 'berkdb)
  55         (featurep 'berkeley-db))
  56     (require 'elmo-database))
  57
  58 (defun elmo-quit ()
  59   (interactive)
  60   (if (featurep 'elmo-imap4)
  61       (elmo-imap4-flush-connection))
  62   (if (featurep 'elmo-nntp)
  63       (elmo-nntp-flush-connection))
  64   (if (featurep 'elmo-pop3)
  65       (elmo-pop3-flush-connection))
  66   (if (get-buffer elmo-work-buf-name)
  67       (kill-buffer elmo-work-buf-name))
  68   )
  69
  70 (defun elmo-cleanup-variables ()
  71   (setq elmo-folder-info-hashtb nil
  72         elmo-nntp-groups-hashtb nil
  73         elmo-nntp-list-folders-cache nil
  74         ))
  75
  76 ;;  (cons of max . estimated message number) elmo-max-of-folder (folder)
  77 (defun elmo-max-of-folder (folder)
  78   (if (elmo-folder-plugged-p folder)
  79       (elmo-call-func folder "max-of-folder")
  80     (elmo-dop-max-of-folder folder)))
  81
  82 ;;  list elmo-list-folder (folder)
  83 (defun elmo-list-folder (folder)
  84   (if (elmo-folder-plugged-p folder)
  85       (elmo-call-func folder "list-folder")
  86     (elmo-dop-list-folder folder)))
  87
  88 ;;  list elmo-list-folders (folder)
  89
  90 (defun elmo-list-folders (folder &optional hierarchy)
  91   (elmo-call-func folder "list-folders" hierarchy))
  92
  93 ;; bool elmo-folder-exists-p (folder)
  94 (defun elmo-folder-exists-p (folder)
  95   (if (elmo-folder-plugged-p folder)
  96       (elmo-call-func folder "folder-exists-p")
  97     (elmo-dop-folder-exists-p folder)))
  98
  99 ;; bool elmo-folder-creatable-p (folder)
 100 (defun elmo-folder-creatable-p (folder)
 101   (elmo-call-func folder "folder-creatable-p"))
 102
 103 ;; bool elmo-create-folder (folder)
 104 ;; create folder
 105 (defun elmo-create-folder (folder)
 106   (if (elmo-folder-plugged-p folder)
 107       (elmo-call-func folder "create-folder")
 108     (elmo-dop-create-folder folder)))
 109
 110 (defun elmo-delete-folder (folder)
 111   (let ((type (elmo-folder-get-type folder)))
 112     (if (or (not (memq type '(localdir localnews archive imap4 maildir)))
 113             (if (elmo-folder-plugged-p folder)
 114                 (elmo-call-func folder "delete-folder")
 115               (elmo-dop-delete-folder folder)))
 116         ;; If folder doesn't support delete folder, delete msgdb path only.
 117         (elmo-msgdb-delete-path folder))))
 118
 119 (defun elmo-rename-folder (old-folder new-folder)
 120   (let ((old-type (elmo-folder-get-type old-folder))
 121         (new-type (elmo-folder-get-type new-folder)))
 122     (if (not (eq old-type new-type))
 123         (error "not same folder type")
 124       (unless (and (memq old-type '(localdir localnews archive imap4))
 125                    (elmo-folder-identical-system-p old-folder new-folder))
 126         (error "rename folder not supported"))
 127       (if (elmo-folder-plugged-p old-folder)
 128           (and
 129            (if (or (file-exists-p (elmo-msgdb-expand-path new-folder))
 130                    (elmo-folder-exists-p new-folder))
 131                (error "already exists folder: %s" new-folder)
 132              t)
 133            (elmo-call-func old-folder "rename-folder"
 134                            (elmo-folder-get-spec new-folder))
 135            (elmo-msgdb-rename-path old-folder new-folder))
 136         (elmo-dop-rename-folder old-folder new-folder)))))
 137
 138 (defun elmo-read-msg-no-cache (folder msg outbuf &optional msgdb force-reload)
 139   "Read messsage into outbuf without cacheing.
 140 If msgdb is specified, use cache."
 141   (let (ret-val)
 142     (when (and (not force-reload)
 143                msgdb)
 144       (set-buffer outbuf)
 145       (erase-buffer)
 146       (setq ret-val
 147             (elmo-cache-read
 148              ;; message-id
 149              (cdr (assq msg (elmo-msgdb-get-number-alist msgdb)))
 150              folder msg)))
 151     (if (not ret-val)
 152         (elmo-call-func folder "read-msg" msg outbuf))))
 153
 154 (defun elmo-force-cache-msg (folder number msgid &optional loc-alist)
 155   "Force cache message."
 156   (let* ((cache-file (elmo-cache-get-path msgid))
 157          dir)
 158     (when cache-file
 159       (setq dir (directory-file-name (file-name-directory cache-file)))
 160       (if (not (file-exists-p dir))
 161           (elmo-make-directory dir))
 162       (if (elmo-local-file-p folder number)
 163           (elmo-copy-file (elmo-get-msg-filename folder number loc-alist)
 164                           cache-file)
 165         (with-temp-buffer
 166           (elmo-call-func folder "read-msg" number (current-buffer))
 167           (as-binary-output-file
 168            (write-region (point-min) (point-max) cache-file nil 'no-msg)))))))
 169
 170 (defun elmo-prefetch-msg (folder msg outbuf msgdb)
 171   "Read message into outbuf with cacheing."
 172   (save-excursion
 173     (let* ((number-alist (elmo-msgdb-get-number-alist
 174                           (or msgdb (elmo-msgdb-load folder))))
 175            (dir (elmo-msgdb-expand-path folder))
 176            (message-id (cdr (assq msg number-alist)))
 177            type
 178            cache-status
 179            ret-val part-num real-fld-num)
 180       (set-buffer outbuf)
 181       (if (elmo-cache-exists-p message-id)
 182           t
 183         ;; cache doesn't exist.
 184         (setq real-fld-num (elmo-get-real-folder-number
 185                             folder msg))
 186         (setq type (elmo-folder-get-type (car real-fld-num)))
 187         (cond ((eq type 'imap4)
 188                (setq ret-val (elmo-imap4-prefetch-msg
 189                               (elmo-folder-get-spec (car real-fld-num))
 190                               (cdr real-fld-num)
 191                               outbuf)))
 192               ((elmo-folder-local-p (car real-fld-num)))
 193               (t (setq ret-val (elmo-call-func (car real-fld-num)
 194                                                "read-msg"
 195                                                (cdr real-fld-num) outbuf))))
 196         (if ret-val
 197             (elmo-cache-save message-id
 198                              (elmo-string-partial-p ret-val)
 199                              folder msg))
 200         (and ret-val t)))))
 201
 202 (defun elmo-prefetch-msgs (folder msgs)
 203   "prefetch messages for queueing."
 204   (let* ((msgdb (elmo-msgdb-load folder))
 205          (number-alist (elmo-msgdb-get-number-alist msgdb))
 206          (len (length msgs))
 207          (count 0)
 208          msgid msg)
 209     (while msgs
 210       (setq msg (car msgs))
 211       (setq msgid (cdr (assq msg number-alist)))
 212       (message "%s:Prefetching... %d/%d message(s)"
 213                folder
 214                (setq count (+ 1 count)) len)
 215       (elmo-force-cache-msg folder msg msgid)
 216       (setq msgs (cdr msgs)))))
 217
 218 ;;  elmo-read-msg (folder msg outbuf msgdb)
 219 ;;; read message
 220 (defun elmo-read-msg (folder msg outbuf msgdb &optional force-reload)
 221   "Read message into outbuf."
 222   (let ((inhibit-read-only t))
 223     (if (not (elmo-use-cache-p folder msg))
 224         (elmo-read-msg-no-cache folder msg outbuf msgdb force-reload)
 225       (elmo-read-msg-with-cache folder msg outbuf msgdb force-reload))))
 226
 227 (defun elmo-read-msg-with-cache (folder msg outbuf msgdb
 228                                         &optional force-reload)
 229   "Read message into outbuf with cacheing."
 230   (let* ((number-alist (elmo-msgdb-get-number-alist
 231                         (or msgdb (elmo-msgdb-load folder))))
 232          (dir (elmo-msgdb-expand-path folder))
 233          (message-id (cdr (assq msg number-alist)))
 234          (type (elmo-folder-number-get-type folder msg))
 235          cache-status
 236          ret-val part-num real-fld-num)
 237     (set-buffer outbuf)
 238     (if (and (not force-reload)
 239              (not (elmo-local-file-p folder msg)))
 240         (setq ret-val (elmo-cache-read message-id folder msg)))
 241     (if ret-val
 242         t
 243       ;; cache doesn't exist.
 244       (setq real-fld-num (elmo-get-real-folder-number
 245                           folder msg))
 246       (if (setq ret-val (elmo-call-func (car real-fld-num)
 247                                         "read-msg"
 248                                         (cdr real-fld-num) outbuf))
 249           (if (not (elmo-local-file-p folder msg))
 250               (elmo-cache-save message-id
 251                                (elmo-string-partial-p ret-val)
 252                                folder msg)))
 253       (and ret-val t))))
 254
 255 (defun elmo-copy-msgs (src-folder msgs dst-folder &optional msgdb same-number)
 256   (let* ((src-spec (elmo-folder-get-spec src-folder))
 257          (loc-alist (if msgdb
 258                         (elmo-msgdb-get-location msgdb)
 259                       (elmo-msgdb-location-load
 260                        (elmo-msgdb-expand-path nil src-spec)))))
 261     (if (eq (car src-spec) 'archive)
 262         (elmo-archive-copy-msgs-froms
 263          (elmo-folder-get-spec dst-folder)
 264          msgs src-spec loc-alist same-number)
 265       (elmo-call-func dst-folder "copy-msgs"
 266                       msgs src-spec loc-alist same-number))))
 267
 268 (defun elmo-move-msgs (src-folder msgs dst-folder
 269                                   &optional msgdb all done
 270                                   no-delete-info
 271                                   no-delete
 272                                   same-number
 273                                   unread-marks)
 274   (save-excursion
 275     (let* ((db (or msgdb (elmo-msgdb-load src-folder)))
 276            (number-alist (elmo-msgdb-get-number-alist db))
 277            (mark-alist   (elmo-msgdb-get-mark-alist db))
 278            (messages msgs)
 279            (len (length msgs))
 280            (all-msg-num (or all len))
 281            (done-msg-num (or done 0))
 282            (tmp-buf (get-buffer-create " *elmo-move-msg*"))
 283            ;elmo-no-cache-flag
 284            ret-val real-fld-num done-copy dir
 285            mes-string message-id src-cache i percent unseen seen-list)
 286       (setq i done-msg-num)
 287       (set-buffer tmp-buf)
 288       (when (and (not (eq dst-folder 'null))
 289                  (elmo-folder-direct-copy-p src-folder dst-folder))
 290         (message (concat (if no-delete "Copying" "Moving")
 291                          " %d message(s)...") (length messages))
 292         (unless (elmo-copy-msgs src-folder
 293                                 messages
 294                                 dst-folder
 295                                 db
 296                                 same-number)
 297           (error "Copy message to %s failed" dst-folder))
 298         (setq done-copy t))
 299       (while messages
 300         (setq real-fld-num (elmo-get-real-folder-number src-folder
 301                                                         (car messages)))
 302         (setq message-id (cdr (assq (car messages) number-alist)))
 303         ;; seen-list.
 304         (if (and (not (eq dst-folder 'null))
 305                  (not (and unread-marks
 306                            (member
 307                             (cadr (assq (car messages) mark-alist))
 308                             unread-marks))))
 309             (setq seen-list (cons message-id seen-list)))
 310         (unless (or (eq dst-folder 'null) done-copy)
 311           (if (and (elmo-folder-plugged-p src-folder)
 312                    (elmo-folder-plugged-p dst-folder)
 313                    (elmo-folder-identical-system-p (car real-fld-num)
 314                                                    dst-folder))
 315               ;; online and identical system...so copy 'em!
 316               (unless
 317                   (elmo-copy-msgs (car real-fld-num)
 318                                   (list (cdr real-fld-num))
 319                                   dst-folder
 320                                   db
 321                                   same-number)
 322                 (error "Copy message to %s failed" dst-folder))
 323             ;; use cache if exists.
 324             (elmo-read-msg src-folder (car messages) tmp-buf msgdb)
 325             (unless (elmo-append-msg dst-folder (buffer-string) message-id
 326                                      (if same-number (car messages))
 327                                      ;; null means all unread.
 328                                      (or (null unread-marks)
 329                                          unseen))
 330               (error "move: append message to %s failed" dst-folder))))
 331         ;; delete src cache if it is partial.
 332         (elmo-cache-delete-partial message-id src-folder (car messages))
 333         (setq ret-val (append ret-val (list (car messages))))
 334         (setq i (+ i 1))
 335         (setq percent (/ (* i 100) all-msg-num))
 336         (if no-delete
 337             (elmo-display-progress
 338              'elmo-move-msgs "Copying messages..."
 339              percent)
 340           (elmo-display-progress
 341            'elmo-move-msgs "Moving messages..."
 342            percent))
 343         (setq messages (cdr messages)))
 344       ;; Save seen-list.
 345       (unless (eq dst-folder 'null)
 346         (setq dir (elmo-msgdb-expand-path dst-folder))
 347         (elmo-msgdb-seen-save dir
 348                               (append (elmo-msgdb-seen-load dir) seen-list)))
 349       (kill-buffer tmp-buf)
 350       (if (and (not no-delete) ret-val)
 351           (progn
 352             (if (not no-delete-info)
 353                 (message "Cleaning up src folder..."))
 354             (if (and (elmo-delete-msgs src-folder ret-val db)
 355                      (elmo-msgdb-delete-msgs src-folder ret-val db t))
 356                 (setq ret-val t)
 357               (message "move: delete messages from %s failed." src-folder)
 358               (setq ret-val nil)
 359               )
 360             (if (and ret-val
 361                      (not no-delete-info))
 362                 (message "Cleaning up src folder...done.")
 363               )
 364             ret-val)
 365         (if no-delete
 366             (progn
 367               (message "Copying messages...done.")
 368               t)
 369           (if (eq len 0)
 370               (message "No message was moved.")
 371             (message "Moving messages failed.")
 372             nil ; failure
 373             ))))))
 374
 375 ;;  boolean elmo-delete-msgs (folder msgs)
 376 (defun elmo-delete-msgs (folder msgs &optional msgdb)
 377   ;; remove from real folder.
 378   (if (elmo-folder-plugged-p folder)
 379       (elmo-call-func folder "delete-msgs" msgs)
 380     (elmo-dop-delete-msgs folder msgs msgdb)))
 381
 382 ;;
 383 ;; Server side search.
 384 ;;
 385 (defun elmo-search (folder condition &optional from-msgs)
 386   (let ((type (elmo-folder-get-type folder)))
 387     (if (elmo-folder-plugged-p folder)
 388         (elmo-call-func folder "search" condition from-msgs)
 389       (elmo-cache-search-all folder condition from-msgs))))
 390
 391 (defun elmo-msgdb-create (folder numlist new-mark already-mark
 392                                  seen-mark important-mark seen-list)
 393   (if (elmo-folder-plugged-p folder)
 394       (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
 395                       seen-mark important-mark seen-list)
 396     (elmo-dop-msgdb-create folder numlist new-mark already-mark
 397                            seen-mark important-mark seen-list)))
 398
 399 (defun elmo-make-folder-numbers-list (folder msgs)
 400   (let ((msg-list msgs)
 401         pair fld-list
 402         ret-val)
 403     (while msg-list
 404       (when (> (car msg-list) 0)
 405         (setq pair (elmo-get-real-folder-number folder (car msg-list)))
 406         (if (setq fld-list (assoc (car pair) ret-val))
 407             (setcdr fld-list (cons (cdr pair) (cdr fld-list)))
 408           (setq ret-val (cons (cons (car pair) (list (cdr pair))) ret-val))))
 409       (setq msg-list (cdr msg-list)))
 410     ret-val))
 411
 412 (defun elmo-call-func-on-markable-msgs (folder func-name msgs msgdb)
 413   (save-match-data
 414     (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
 415           type)
 416       (while folder-numbers
 417         (if (or (eq
 418                  (setq type (car
 419                              (elmo-folder-get-spec
 420                               (car (car folder-numbers)))))
 421                  'imap4)
 422                 (memq type '(maildir internal)))
 423             (if (elmo-folder-plugged-p folder)
 424                 (elmo-call-func (car (car folder-numbers)) func-name
 425                                 (cdr (car folder-numbers)))
 426               (if elmo-enable-disconnected-operation
 427                   (elmo-dop-call-func-on-msgs
 428                    (car (car folder-numbers)) ; real folder
 429                    func-name
 430                    (cdr (car folder-numbers)) ; real number
 431                    msgdb)
 432                 (error "Unplugged"))))
 433         (setq folder-numbers (cdr folder-numbers))))))
 434
 435 (defun elmo-unmark-important (folder msgs msgdb)
 436   (elmo-call-func-on-markable-msgs folder "unmark-important" msgs msgdb))
 437
 438 (defun elmo-mark-as-important (folder msgs msgdb)
 439   (elmo-call-func-on-markable-msgs folder "mark-as-important" msgs msgdb))
 440
 441 (defun elmo-mark-as-read (folder msgs msgdb)
 442   (elmo-call-func-on-markable-msgs folder "mark-as-read" msgs msgdb))
 443
 444 (defun elmo-mark-as-unread (folder msgs msgdb)
 445   (elmo-call-func-on-markable-msgs folder "mark-as-unread" msgs msgdb))
 446
 447 (defun elmo-msgdb-create-as-numlist (folder numlist new-mark already-mark
 448                                             seen-mark important-mark seen-list)
 449   (if (elmo-folder-plugged-p folder)
 450       (elmo-call-func folder "msgdb-create-as-numlist" numlist
 451                       new-mark already-mark seen-mark important-mark seen-list)
 452     (elmo-dop-msgdb-create-as-numlist
 453      folder numlist new-mark already-mark
 454      seen-mark important-mark seen-list)))
 455
 456 ;;   msgdb elmo-msgdb-load        (folder)
 457 (defun elmo-msgdb-load (folder &optional spec)
 458   (message "Loading msgdb for %s..." folder)
 459   (let* ((path (elmo-msgdb-expand-path folder spec))
 460          (ret-val
 461           (list (elmo-msgdb-overview-load path)
 462                 (elmo-msgdb-number-load path)
 463                 (elmo-msgdb-mark-load path)
 464                 (elmo-msgdb-location-load path))))
 465     (message "Loading msgdb for %s...done." folder)
 466     (elmo-folder-set-info-max-by-numdb folder (nth 1 ret-val))
 467     ret-val))
 468
 469 ;;   boolean elmo-msgdb-save (folder msgdb)
 470 (defun elmo-msgdb-save (folder msgdb)
 471   (message "Saving msgdb for %s..." folder)
 472   (save-excursion
 473     (let ((path (elmo-msgdb-expand-path folder)))
 474       (elmo-msgdb-overview-save path (car msgdb))
 475       (elmo-msgdb-number-save path (cadr msgdb))
 476       (elmo-msgdb-mark-save path (caddr msgdb))
 477       (elmo-msgdb-location-save path (cadddr msgdb))
 478     ;(elmo-sync-validity folder);; for validity check!!
 479       ))
 480   (message "Saving msgdb for %s...done." folder)
 481   (elmo-folder-set-info-max-by-numdb folder (cadr msgdb)))
 482
 483 (defun elmo-msgdb-add-msgs-to-seen-list-subr (msgs msgdb seen-marks seen-list)
 484   "Add to seen list."
 485   (let* ((seen-mark-list (string-to-char-list seen-marks))
 486          (number-alist (elmo-msgdb-get-number-alist msgdb))
 487          (mark-alist   (elmo-msgdb-get-mark-alist msgdb))
 488          ent)
 489     (while msgs
 490       (if (setq ent (assq (car msgs) mark-alist))
 491           (if (memq (string-to-char (cadr ent)) seen-mark-list)
 492               (setq seen-list
 493                     (cons (cdr (assq (car msgs) number-alist)) seen-list)))
 494         ;; no mark ... seen...
 495         (setq seen-list
 496               (cons (cdr (assq (car msgs) number-alist)) seen-list)))
 497       (setq msgs (cdr msgs)))
 498     seen-list))
 499
 500 (defun elmo-msgdb-add-msgs-to-seen-list (folder msgs msgdb seen-marks)
 501   "Add to seen list."
 502   (unless (eq folder 'null) ;; black hole
 503     (let* ((dir (elmo-msgdb-expand-path folder))
 504            (seen-list (elmo-msgdb-seen-load dir)))
 505       (setq seen-list
 506             (elmo-msgdb-add-msgs-to-seen-list-subr
 507              msgs msgdb seen-marks seen-list))
 508       (elmo-msgdb-seen-save dir seen-list))))
 509
 510 ;;  msgdb elmo-append-msg (folder string)
 511 (defun elmo-append-msg (folder string &optional message-id msg no-see)
 512   (let ((type (elmo-folder-get-type folder))
 513         filename)
 514     (cond ((eq type 'imap4)
 515            (if (elmo-folder-plugged-p folder)
 516                (elmo-call-func folder "append-msg" string msg no-see)
 517              (elmo-dop-append-msg folder string message-id)))
 518           ((eq type 'cache)
 519            (if message-id
 520                (elmo-cache-append-msg
 521                 (elmo-folder-get-spec folder)
 522                 string message-id msg no-see)
 523              (error "elmo-cache-append-msg require message-id")))
 524           (t
 525            (elmo-call-func folder "append-msg" string msg no-see)))))
 526
 527 (defun elmo-check-validity (folder)
 528   (elmo-call-func folder "check-validity"
 529                   (expand-file-name
 530                    elmo-msgdb-validity-filename
 531                    (elmo-msgdb-expand-path folder))))
 532
 533 (defun elmo-pack-number (folder msgdb arg)
 534   (if (string-match "^[\\+=].*" folder)
 535       (elmo-call-func folder "pack-number" msgdb arg)
 536     (error "pack-number not supported")))
 537
 538 (defun elmo-sync-validity (folder)
 539   (elmo-call-func folder "sync-validity"
 540                   (expand-file-name
 541                    elmo-msgdb-validity-filename
 542                    (elmo-msgdb-expand-path folder))))
 543
 544 (defun elmo-use-cache-p (folder number)
 545   (elmo-call-func folder "use-cache-p" number)
 546   )
 547
 548 (defun elmo-local-file-p (folder number)
 549   (elmo-call-func folder "local-file-p" number))
 550
 551 (defun elmo-folder-portinfo (folder)
 552   (condition-case nil
 553       (elmo-call-func folder "portinfo")
 554     (error)))
 555
 556 (defun elmo-folder-plugged-p (folder)
 557   (and folder
 558        (or (elmo-folder-local-p folder)
 559            (elmo-call-func folder "plugged-p"))))
 560
 561 (defun elmo-folder-set-plugged (folder plugged &optional add)
 562   (if (elmo-folder-local-p folder)
 563       nil       ;; nop
 564     (elmo-call-func folder "set-plugged" plugged add)))
 565
 566 (defun elmo-generic-sync-number-alist (spec number-alist)
 567   "Just return number-alist."
 568   number-alist)
 569
 570 (defun elmo-generic-list-folder-unread (spec mark-alist unread-marks)
 571   (elmo-delete-if
 572    'null
 573    (mapcar
 574     (function (lambda (x)
 575                 (if (member (cadr (assq (car x) mark-alist)) unread-marks)
 576                     (car x))))
 577     mark-alist)))
 578
 579 (defun elmo-generic-list-folder-important (spec overview)
 580   nil)
 581
 582 (defun elmo-update-number (folder msgdb)
 583   (when (elmo-folder-plugged-p folder)
 584     (message "Synchronize number...")
 585     (let* ((numlist (elmo-msgdb-get-number-alist msgdb))
 586            (len (length numlist))
 587            new-numlist)
 588       (if (eq (length (setq
 589                        new-numlist
 590                        (elmo-call-func folder "sync-number-alist" numlist)))
 591               len)
 592           nil
 593         (elmo-msgdb-set-number-alist msgdb new-numlist)
 594         (message "Synchronize number...done.")
 595         new-numlist))))
 596
 597 (defun elmo-get-msg-filename (folder number &optional loc-alist)
 598   "Available if elmo-local-file-p is t."
 599   (elmo-call-func folder "get-msg-filename" number loc-alist))
 600
 601 (defun elmo-strict-folder-diff (fld &optional number-alist)
 602   (interactive)
 603   (let* ((dir (elmo-msgdb-expand-path fld))
 604          (nalist (or number-alist
 605                      (elmo-msgdb-number-load dir)))
 606          (in-db (sort (mapcar 'car nalist) '<))
 607          (in-folder  (elmo-list-folder fld))
 608          append-list delete-list diff)
 609     (cons (if (equal in-folder in-db)
 610               0
 611             (setq diff (elmo-list-diff
 612                         in-folder in-db
 613                         nil
 614                         ))
 615             (setq append-list (car diff))
 616             (setq delete-list (cadr diff))
 617             (if append-list
 618                 (length append-list)
 619               (if delete-list
 620                   (- 0 (length delete-list))
 621                 0)))
 622           (length in-folder))))
 623
 624 (defun elmo-list-folder-unread (folder mark-alist unread-marks)
 625   (elmo-call-func folder "list-folder-unread" mark-alist unread-marks))
 626
 627 (defun elmo-list-folder-important (folder overview)
 628   (let (importants)
 629     ;; server side importants...(append only.)
 630     (if (elmo-folder-plugged-p folder)
 631         (setq importants (elmo-call-func folder "list-folder-important"
 632                                          overview)))
 633     (or elmo-msgdb-global-mark-alist
 634         (setq elmo-msgdb-global-mark-alist
 635               (elmo-object-load (expand-file-name
 636                                  elmo-msgdb-global-mark-filename
 637                                  elmo-msgdb-dir))))
 638     (while overview
 639       (car overview)
 640       (if (assoc (elmo-msgdb-overview-entity-get-id (car overview))
 641                  elmo-msgdb-global-mark-alist)
 642           (setq importants (cons
 643                             (elmo-msgdb-overview-entity-get-number
 644                              (car overview))
 645                             importants)))
 646       (setq overview (cdr overview)))
 647     importants))
 648
 649 (defun elmo-generic-commit (folder)
 650   nil)
 651
 652 (defun elmo-commit (folder)
 653   (elmo-call-func folder "commit"))
 654
 655 ;; returns cons cell of (unsync . number-of-messages-in-folder)
 656 (defun elmo-folder-diff (fld &optional number-alist)
 657   (interactive)
 658   (let ((type (elmo-folder-get-type fld)))
 659     (cond ((eq type 'multi)
 660            (elmo-multi-folder-diff fld))
 661           ((and (eq type 'filter)
 662                 (or (elmo-multi-p fld)
 663                     (not
 664                      (vectorp (nth 1 (elmo-folder-get-spec fld)))))
 665                 ;; not partial...unsync number is unknown.
 666                 (cons nil
 667                       (cdr (elmo-folder-diff
 668                             (nth 2 (elmo-folder-get-spec fld)))))))
 669           ((and (eq type 'imap4)
 670                 elmo-use-server-diff)
 671            (elmo-call-func fld "server-diff")) ;; imap4 server side diff.
 672           (t
 673            (let ((cached-in-db-max (elmo-folder-get-info-max fld))
 674                  (in-folder (elmo-max-of-folder fld))
 675                  (in-db t)
 676                  unsync nomif
 677                  in-db-max)
 678              (if (or number-alist
 679                      (not cached-in-db-max))
 680                  (let* ((dir (elmo-msgdb-expand-path fld))
 681                         (nalist (or number-alist
 682                                     (elmo-msgdb-number-load dir))))
 683                    ;; No info-cache.
 684                    (setq in-db (sort (mapcar 'car nalist) '<))
 685                    (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
 686                                        0))
 687                    (if (not number-alist)
 688                        ;; Number-alist is not used.
 689                        (elmo-folder-set-info-hashtb fld in-db-max
 690                                                     nil))
 691 ;;                                                 (or
 692 ;;                                                  (and in-db (length in-db))
 693 ;;                                                  0)))
 694                    )
 695                ;; info-cache exists.
 696                (setq in-db-max cached-in-db-max))
 697              (setq unsync (if (and in-db
 698                                    (car in-folder))
 699                               (- (car in-folder) in-db-max)
 700                             (if (and in-folder
 701                                      (null in-db))
 702                                 (cdr in-folder)
 703                               (if (null (car in-folder))
 704                                   nil))))
 705              (setq nomif (cdr in-folder))
 706              (if (and unsync nomif (> unsync nomif))
 707                  (setq unsync nomif))
 708              (cons (or unsync 0) (or nomif 0)))))))
 709
 710 (defsubst elmo-folder-get-info (folder &optional hashtb)
 711   (elmo-get-hash-val folder
 712                      (or hashtb elmo-folder-info-hashtb)))
 713
 714 (defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
 715   (let ((info (elmo-folder-get-info folder)))
 716     (when info
 717       (or new     (setq new     (nth 0 info)))
 718       (or unread  (setq unread  (nth 1 info)))
 719       (or numbers (setq numbers (nth 2 info)))
 720       (or max     (setq max     (nth 3 info))))
 721     (elmo-set-hash-val folder
 722                        (list new unread numbers max)
 723                        elmo-folder-info-hashtb)))
 724
 725 (defun elmo-multi-get-number-alist-list (number-alist)
 726   (let ((alist (sort number-alist (function (lambda (x y) (< (car x)
 727                                                              (car y))))))
 728         (cur-number 0)
 729         one-alist ret-val num)
 730     (while alist
 731       (setq cur-number (+ cur-number 1))
 732       (setq one-alist nil)
 733       (while (and alist
 734                   (eq 0
 735                       (/ (- (setq num (car (car alist)))
 736                             (* elmo-multi-divide-number cur-number))
 737                          elmo-multi-divide-number)))
 738         (setq one-alist (nconc
 739                          one-alist
 740                          (list
 741                           (cons
 742                            (% num (* elmo-multi-divide-number cur-number))
 743                            (cdr (car alist))))))
 744         (setq alist (cdr alist)))
 745       (setq ret-val (nconc ret-val (list one-alist))))
 746     ret-val))
 747
 748 (defun elmo-multi-folder-diff (fld)
 749   (let ((flds (cdr (elmo-folder-get-spec fld)))
 750         (num-alist-list
 751          (elmo-multi-get-number-alist-list
 752           (elmo-msgdb-number-load (elmo-msgdb-expand-path fld))))
 753         (count 0)
 754         diffs (unsync 0) (nomif 0))
 755     (while flds
 756       (setq diffs (nconc diffs (list (elmo-folder-diff (car flds)
 757                                                        (nth count
 758                                                             num-alist-list)
 759                                                        ))))
 760       (setq count (+ 1 count))
 761       (setq flds (cdr flds)))
 762     (while diffs
 763       (setq unsync (+ unsync (car (car diffs))))
 764       (setq nomif  (+ nomif (cdr (car diffs))))
 765       (setq diffs (cdr diffs)))
 766     (elmo-folder-set-info-hashtb fld nil nomif)
 767     (cons unsync nomif)))
 768
 769 (defun elmo-folder-set-info-max-by-numdb (folder msgdb-number)
 770   (let ((num-db (sort (mapcar 'car msgdb-number) '<)))
 771     (elmo-folder-set-info-hashtb
 772      folder
 773      (or (nth (max 0 (1- (length num-db))) num-db) 0)
 774      nil ;;(length num-db)
 775      )))
 776
 777 (defun elmo-folder-get-info-max (folder)
 778   "Get folder info from cache."
 779   (nth 3 (elmo-folder-get-info folder)))
 780
 781 (defun elmo-folder-get-info-length (folder)
 782   (nth 2 (elmo-folder-get-info folder)))
 783
 784 (defun elmo-folder-get-info-unread (folder)
 785   (nth 1 (elmo-folder-get-info folder)))
 786
 787 (defun elmo-folder-info-make-hashtb (info-alist hashtb)
 788   (let* ((hashtb (or hashtb
 789                      (elmo-make-hash (length info-alist)))))
 790     (mapcar
 791      '(lambda (x)
 792         (let ((info (cadr x)))
 793           (and (intern-soft (car x) hashtb)
 794                (elmo-set-hash-val (car x)
 795                                   (list (nth 2 info)   ;; new
 796                                         (nth 3 info)   ;; unread
 797                                         (nth 1 info)   ;; length
 798                                         (nth 0 info))  ;; max
 799                                   hashtb))))
 800      info-alist)
 801     (setq elmo-folder-info-hashtb hashtb)))
 802
 803 (defun elmo-crosspost-message-set (message-id folders &optional type)
 804   (if (assoc message-id elmo-crosspost-message-alist)
 805       (setcdr (assoc message-id elmo-crosspost-message-alist)
 806               (list folders type))
 807     (setq elmo-crosspost-message-alist
 808           (nconc elmo-crosspost-message-alist
 809                  (list (list message-id folders type))))))
 810
 811 (defun elmo-crosspost-message-delete (message-id folders)
 812   (let* ((id-fld (assoc message-id elmo-crosspost-message-alist))
 813          (folder-list (nth 1 id-fld)))
 814     (when id-fld
 815       (if (setq folder-list (elmo-delete-lists folders folder-list))
 816           (setcar (cdr id-fld) folder-list)
 817         (setq elmo-crosspost-message-alist
 818               (delete id-fld elmo-crosspost-message-alist))))))
 819
 820
 821 (defun elmo-get-msgs-with-mark (mark-alist mark)
 822   (let (ret-val)
 823     (while mark-alist
 824       (if (string= (cadr (car mark-alist)) mark)
 825           (cons (car (car mark-alist)) ret-val))
 826       (setq mark-alist (cdr mark-alist)))
 827     (nreverse ret-val)))
 828
 829 (defun elmo-buffer-cache-message (fld msg &optional msgdb force-reload)
 830   (let* ((msg-id (cdr (assq msg (elmo-msgdb-get-number-alist msgdb))))
 831          (hit (elmo-buffer-cache-hit (list fld msg msg-id)))
 832          (read nil))
 833     (if hit
 834         (elmo-buffer-cache-sort
 835          (elmo-buffer-cache-entry-make (list fld msg msg-id) hit))
 836       (setq hit (elmo-buffer-cache-add (list fld msg msg-id)))
 837       (setq read t))
 838     (if (or force-reload read)
 839         (condition-case err
 840             (save-excursion
 841               (set-buffer hit)
 842               (elmo-read-msg fld msg
 843                              (current-buffer)
 844                              msgdb force-reload))
 845           (quit
 846            (elmo-buffer-cache-delete)
 847            (error "read message %s/%s is quitted" fld msg))
 848           (error
 849            (elmo-buffer-cache-delete)
 850            (signal (car err) (cdr err))
 851            nil))) ;; will not be used
 852     hit)) ;; retrun value
 853
 854 (defun elmo-read-msg-with-buffer-cache (fld msg outbuf msgdb &optional force-reload)
 855   (if elmo-use-buffer-cache
 856       (let (hit start end)
 857         (when (setq hit (elmo-buffer-cache-message
 858                          (elmo-string fld) msg
 859                          msgdb force-reload))
 860           (erase-buffer)
 861           (save-excursion
 862             (set-buffer hit)
 863             (setq start (point-min) end (point-max)))
 864           (insert-buffer-substring hit start end)))
 865     (elmo-read-msg fld msg outbuf msgdb force-reload)))
 866
 867 (defun elmo-folder-pipe-p (folder)
 868   (let ((type (elmo-folder-get-type folder)))
 869     (cond
 870      ((eq type 'multi)
 871       (let ((flds (cdr (elmo-folder-get-spec folder))))
 872         (catch 'done
 873           (while flds
 874             (if (elmo-folder-pipe-p (car flds))
 875                 (throw 'done t)))
 876           nil)))
 877      ((eq type 'pipe)
 878       t)
 879      ((eq type 'filter)
 880       (elmo-folder-pipe-p
 881        (nth 2 (elmo-folder-get-spec folder))))
 882      (t
 883       nil
 884       ))))
 885
 886 (defun elmo-multi-p (folder)
 887   (let ((type (elmo-folder-get-type folder)))
 888     (cond
 889      ((eq type 'multi)
 890       t)
 891      ((eq type 'pipe)
 892       (elmo-multi-p
 893        (elmo-pipe-spec-dst (elmo-folder-get-spec folder))))
 894      ((eq type 'filter)
 895       (elmo-multi-p
 896        (nth 2 (elmo-folder-get-spec folder))))
 897      (t
 898       nil
 899       ))))
 900
 901 (defun elmo-get-real-folder-number (folder number)
 902   (let ((type (elmo-folder-get-type folder)))
 903     (cond
 904      ((eq type 'multi)
 905       (elmo-multi-get-real-folder-number folder number))
 906      ((eq type 'pipe)
 907       (elmo-get-real-folder-number
 908        (elmo-pipe-spec-dst (elmo-folder-get-spec folder) )
 909        number))
 910      ((eq type 'filter)
 911       (elmo-get-real-folder-number
 912        (nth 2 (elmo-folder-get-spec folder)) number))
 913      (t
 914       (cons folder number)
 915       ))))
 916
 917 (defun elmo-folder-get-primitive-spec-list (folder &optional spec-list)
 918   (let ((type (elmo-folder-get-type folder))
 919         specs)
 920     (cond
 921      ((or (eq type 'multi)
 922           (eq type 'pipe))
 923       (let ((flds (cdr (elmo-folder-get-spec folder)))
 924             spec)
 925         (while flds
 926           (setq spec (elmo-folder-get-primitive-spec-list (car flds)))
 927           (if (not (memq (car spec) specs))
 928               (setq specs (append specs spec)))
 929           (setq flds (cdr flds)))))
 930      ((eq type 'filter)
 931       (setq specs
 932             (elmo-folder-get-primitive-spec-list
 933              (nth 2 (elmo-folder-get-spec folder)))))
 934      (t
 935       (setq specs (list (elmo-folder-get-spec folder)))
 936       ))
 937     specs))
 938
 939 (defun elmo-folder-get-primitive-folder-list (folder)
 940   (let* ((type (elmo-folder-get-type folder)))
 941     (cond
 942      ((or (eq type 'multi)
 943           (eq type 'pipe))
 944       (let ((flds (cdr (elmo-folder-get-spec folder)))
 945             ret-val)
 946         (while flds
 947           (setq ret-val (append ret-val
 948                                 (elmo-folder-get-primitive-folder-list
 949                                  (car flds))))
 950           (setq flds (cdr flds)))
 951         ret-val))
 952      ((eq type 'filter)
 953       (elmo-folder-get-primitive-folder-list
 954        (nth 2 (elmo-folder-get-spec folder))))
 955      (t
 956       (list folder)
 957       ))))
 958
 959 (defun elmo-folder-contains-multi (folder)
 960   (let ((cur-spec (elmo-folder-get-spec folder)))
 961     (catch 'done
 962       (while cur-spec
 963         (cond
 964          ((eq (car cur-spec) 'filter)
 965           (setq cur-spec (elmo-folder-get-spec (nth 2 cur-spec))))
 966          ((eq (car cur-spec) 'pipe)
 967           (setq cur-spec (elmo-folder-get-spec (elmo-pipe-spec-src cur-spec))))
 968          ((eq (car cur-spec) 'multi)
 969           (throw 'done nil))
 970          (t (setq cur-spec nil)))))
 971     cur-spec))
 972
 973 (defun elmo-folder-contains-type (folder type)
 974   (let ((spec (elmo-folder-get-spec folder)))
 975     (cond
 976      ((eq (car spec) 'filter)
 977       (elmo-folder-contains-type (nth 2 spec) type))
 978      ((eq (car spec) 'pipe)
 979       (elmo-folder-contains-type (elmo-pipe-spec-dst spec) type))
 980      ((eq (car spec) 'multi)
 981       (let ((folders (cdr spec)))
 982         (catch 'done
 983           (while folders
 984             (if (elmo-folder-contains-type (car folders) type)
 985                 (throw 'done t))
 986             (setq folders (cdr folders))))))
 987      ((eq (car spec) type)
 988       t)
 989      (t nil))))
 990
 991 (defun elmo-folder-number-get-spec (folder number)
 992   (let ((type (elmo-folder-get-type folder)))
 993     (cond
 994      ((eq type 'multi)
 995       (elmo-multi-folder-number-get-spec folder number))
 996      ((eq type 'pipe)
 997       (elmo-folder-number-get-spec
 998        (elmo-pipe-spec-dst (elmo-folder-get-spec folder)) number))
 999      ((eq type 'filter)
1000       (elmo-folder-number-get-spec
1001        (nth 2 (elmo-folder-get-spec folder)) number))
1002      (t
1003       (elmo-folder-get-spec folder)
1004       ))))
1005
1006 (defun elmo-folder-number-get-type (folder number)
1007   (car (elmo-folder-number-get-spec folder number)))
1008
1009 (defun elmo-multi-folder-number-get-spec (folder number)
1010   (let* ((spec (elmo-folder-get-spec folder))
1011          (flds (cdr spec))
1012          (fld (nth (- (/ number elmo-multi-divide-number) 1) flds)))
1013     (elmo-folder-number-get-spec fld number)))
1014
1015 ;; autoloads
1016 (autoload 'elmo-imap4-get-connection "elmo-imap4")
1017 (autoload 'elmo-nntp-make-groups-hashtb "elmo-nntp")
1018 (autoload 'elmo-nntp-post "elmo-nntp")
1019 (autoload 'elmo-localdir-max-of-folder "elmo-localdir")
1020 (autoload 'elmo-localdir-msgdb-create-overview-entity-from-file "elmo-localdir")
1021 (autoload 'elmo-multi-folder-diff "elmo-multi")
1022 (autoload 'elmo-archive-copy-msgs-froms "elmo-archive")
1023
1024 ;;; elmo2.el ends here