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