elmo/elmo2.el

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