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