1 ;;; elmo2.el -- ELMO main file (I don't remember why this is 2).
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
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)
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.
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.
38 (product-provide (provide 'elmo2) (require 'elmo-version))
41 (require 'elmo-localdir)
46 ; (require 'elmo-multi)
47 (require 'elmo-filter)
48 (require 'elmo-archive)
49 ;(require 'elmo-cache2)
52 (if (or (featurep 'dbm)
55 (featurep 'berkeley-db))
56 (require 'elmo-database))
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)
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)))
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
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)))
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)))
88 ;; list elmo-list-folders (folder)
89 (defun elmo-list-folders (folder &optional hierarchy)
90 (elmo-call-func folder "list-folders" hierarchy))
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)))
98 ;; bool elmo-folder-creatable-p (folder)
99 (defun elmo-folder-creatable-p (folder)
100 (elmo-call-func folder "folder-creatable-p"))
102 ;; bool elmo-create-folder (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)))
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))))
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)
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)
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)))))
137 (defun elmo-read-msg-no-cache (folder msg outbuf)
138 "Read messsage specified by FOLDER and MSG(number) into OUTBUF
140 (elmo-call-func folder "read-msg" msg outbuf))
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))
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)
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)))))))
158 (defun elmo-prefetch-msg (folder msg outbuf msgdb)
159 "Read message into outbuf with cacheing."
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)))
167 ret-val part-num real-fld-num)
169 (if (elmo-cache-exists-p message-id)
171 ;; cache doesn't exist.
172 (setq real-fld-num (elmo-get-real-folder-number
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))
180 ((elmo-folder-local-p (car real-fld-num)))
181 (t (setq ret-val (elmo-call-func (car real-fld-num)
183 (cdr real-fld-num) outbuf))))
185 (elmo-cache-save message-id
186 (elmo-string-partial-p ret-val)
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))
198 (setq msg (car msgs))
199 (setq msgid (cdr (assq msg number-alist)))
200 (message "%s:Prefetching... %d/%d message(s)"
202 (setq count (+ 1 count)) len)
203 (elmo-force-cache-msg folder msg msgid)
204 (setq msgs (cdr msgs)))))
206 ;; elmo-read-msg (folder msg outbuf msgdb)
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)))
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))
226 ret-val part-num real-fld-num)
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)))
233 ;; cache doesn't exist.
234 (setq real-fld-num (elmo-get-real-folder-number
236 (if (setq ret-val (elmo-call-func (car real-fld-num)
238 (cdr real-fld-num) outbuf))
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)
247 (defun elmo-copy-msgs (src-folder msgs dst-folder &optional msgdb same-number)
248 (let* ((src-spec (elmo-folder-get-spec src-folder))
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))))
260 (defun elmo-move-msgs (src-folder msgs dst-folder
261 &optional msgdb all done
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))
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*"))
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)
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
292 (error "Copy message to %s failed" dst-folder))
295 (setq real-fld-num (elmo-get-real-folder-number src-folder
297 (setq message-id (cdr (setq pair (assq (car messages) number-alist))))
299 (if (and (not (eq dst-folder 'null))
300 (not (and unread-marks
303 (cadr (assq (car messages) mark-alist))
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)
311 ;; online and identical system...so copy 'em!
313 (elmo-copy-msgs (car real-fld-num)
314 (list (cdr real-fld-num))
318 (error "Copy message to %s failed" dst-folder))
319 ;; use cache if exists.
320 ;; if there's other message with same message-id,
322 (elmo-read-msg src-folder (car messages)
324 (and (elmo-folder-plugged-p src-folder)
329 (cdr (memq pair 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)
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)
345 (elmo-display-progress
346 'elmo-move-msgs progress-message
347 (/ (* i 100) all-msg-num)))
348 (setq messages (cdr messages)))
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)
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))
362 (message "move: delete messages from %s failed." src-folder)
366 (not no-delete-info))
367 (message "Cleaning up src folder...done")
372 (message "Copying messages...done")
375 (message "No message was moved.")
376 (message "Moving messages failed.")
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)))
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)))
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))
401 (if (elmo-condition-find-key condition "body")
402 (elmo-search folder condition number-list)
404 (if (elmo-msgdb-search-internal condition (car overview)
408 (elmo-msgdb-overview-entity-get-number (car overview))
411 (elmo-display-progress
412 'elmo-msgdb-search "Searching..." (/ (* i 100) length))
413 (setq overview (cdr overview)))
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)))
424 (defun elmo-make-folder-numbers-list (folder msgs)
425 (let ((msg-list msgs)
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)))
437 (defun elmo-call-func-on-markable-msgs (folder func-name msgs msgdb)
438 "Returns t if marked."
440 (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
442 (while folder-numbers
445 (elmo-folder-get-spec
446 (car (car folder-numbers)))))
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
456 (cdr (car folder-numbers)) ; real number
459 (setq folder-numbers (cdr folder-numbers)))
462 (defun elmo-unmark-important (folder msgs msgdb)
463 (elmo-call-func-on-markable-msgs folder "unmark-important" msgs msgdb))
465 (defun elmo-mark-as-important (folder msgs msgdb)
466 (elmo-call-func-on-markable-msgs folder "mark-as-important" msgs msgdb))
468 (defun elmo-mark-as-read (folder msgs msgdb)
469 (elmo-call-func-on-markable-msgs folder "mark-as-read" msgs msgdb))
471 (defun elmo-mark-as-unread (folder msgs msgdb)
472 (elmo-call-func-on-markable-msgs folder "mark-as-unread" msgs msgdb))
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)))
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))
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)
495 (message "Loading msgdb for %s...done" folder)
496 (elmo-folder-set-info-max-by-numdb folder (nth 1 ret-val))
499 ;; boolean elmo-msgdb-save (folder msgdb)
500 (defun elmo-msgdb-save (folder msgdb)
501 (message "Saving msgdb for %s..." folder)
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!!
510 (message "Saving msgdb for %s...done" folder)
511 (elmo-folder-set-info-max-by-numdb folder (cadr msgdb)))
513 (defun elmo-msgdb-add-msgs-to-seen-list-subr (msgs msgdb seen-marks 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))
520 (if (setq ent (assq (car msgs) mark-alist))
521 (if (memq (string-to-char (cadr ent)) seen-mark-list)
523 (cons (cdr (assq (car msgs) number-alist)) seen-list)))
524 ;; no mark ... seen...
526 (cons (cdr (assq (car msgs) number-alist)) seen-list)))
527 (setq msgs (cdr msgs)))
530 (defun elmo-msgdb-add-msgs-to-seen-list (folder msgs msgdb seen-marks)
532 (unless (eq folder 'null) ;; black hole
533 (let* ((dir (elmo-msgdb-expand-path folder))
534 (seen-list (elmo-msgdb-seen-load dir)))
536 (elmo-msgdb-add-msgs-to-seen-list-subr
537 msgs msgdb seen-marks seen-list))
538 (elmo-msgdb-seen-save dir seen-list))))
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))
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)))
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")))
555 (elmo-call-func folder "append-msg" string msg no-see)))))
557 (defun elmo-check-validity (folder)
558 (elmo-call-func folder "check-validity"
560 elmo-msgdb-validity-filename
561 (elmo-msgdb-expand-path folder))))
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"))))
569 (defun elmo-sync-validity (folder)
570 (elmo-call-func folder "sync-validity"
572 elmo-msgdb-validity-filename
573 (elmo-msgdb-expand-path folder))))
575 (defun elmo-use-cache-p (folder number)
576 (elmo-call-func folder "use-cache-p" number)
579 (defun elmo-local-file-p (folder number)
580 (elmo-call-func folder "local-file-p" number))
582 (defun elmo-folder-portinfo (folder)
584 (elmo-call-func folder "portinfo")
587 (defun elmo-folder-plugged-p (folder)
589 (or (elmo-folder-local-p folder)
590 (elmo-call-func folder "plugged-p"))))
592 (defun elmo-folder-set-plugged (folder plugged &optional add)
593 (if (elmo-folder-local-p folder)
595 (elmo-call-func folder "set-plugged" plugged add)))
597 (defun elmo-generic-sync-number-alist (spec number-alist)
598 "Just return number-alist."
601 (defun elmo-generic-list-folder-unread (spec number-alist mark-alist
605 (function (lambda (x)
606 (if (member (cadr (assq (car x) mark-alist)) unread-marks)
610 (defun elmo-generic-list-folder-important (spec number-alist)
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))
619 (if (eq (length (setq
621 (elmo-call-func folder "sync-number-alist" numlist)))
624 (elmo-msgdb-set-number-alist msgdb new-numlist)
625 (message "Synchronize number...done")
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))
632 (defun elmo-strict-folder-diff (fld &optional number-alist)
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)
642 (setq diff (elmo-list-diff
646 (setq append-list (car diff))
647 (setq delete-list (cadr diff))
651 (- 0 (length delete-list))
653 (length in-folder))))
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))
659 (defun elmo-list-folder-important (folder number-alist)
661 ;; Server side importants...(append only.)
662 (if (elmo-folder-plugged-p folder)
663 (setq importants (elmo-call-func folder "list-folder-important"
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
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)))
677 (defun elmo-generic-commit (folder)
680 (defun elmo-commit (folder)
681 (elmo-call-func folder "commit"))
683 (defun elmo-clear-killed (folder)
684 (elmo-msgdb-killed-list-save (elmo-msgdb-expand-path folder) nil))
686 (defvar elmo-folder-diff-async-callback nil)
687 (defvar elmo-folder-diff-async-callback-data nil)
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.
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
705 (elmo-folder-diff folder)))))
707 (defun elmo-folder-diff (folder &optional number-list)
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))
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))
720 (if (or number-list (not cached-in-db-max))
721 (let ((number-list (or number-list
723 (elmo-msgdb-number-load
724 (elmo-msgdb-expand-path folder))))))
726 (setq in-db (sort number-list '<))
727 (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
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
734 (- (car in-folder) in-db-max)
738 (if (null (car in-folder))
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))))
745 (defsubst elmo-folder-get-info (folder &optional hashtb)
746 (elmo-get-hash-val folder
747 (or hashtb elmo-folder-info-hashtb)))
749 (defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
750 (let ((info (elmo-folder-get-info folder)))
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)))
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
764 (or (nth (max 0 (1- (length num-db))) num-db) 0)
765 nil ;;(length num-db)
768 (defun elmo-folder-get-info-max (folder)
769 "Get folder info from cache."
770 (nth 3 (elmo-folder-get-info folder)))
772 (defun elmo-folder-get-info-length (folder)
773 (nth 2 (elmo-folder-get-info folder)))
775 (defun elmo-folder-get-info-unread (folder)
776 (nth 1 (elmo-folder-get-info folder)))
778 (defun elmo-folder-info-make-hashtb (info-alist hashtb)
779 (let* ((hashtb (or hashtb
780 (elmo-make-hash (length info-alist)))))
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
792 (setq elmo-folder-info-hashtb hashtb)))
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)
798 (setq elmo-crosspost-message-alist
799 (nconc elmo-crosspost-message-alist
800 (list (list message-id folders type))))))
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)))
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))))))
812 (defun elmo-get-msgs-with-mark (mark-alist mark)
815 (if (string= (cadr (car mark-alist)) mark)
816 (cons (car (car mark-alist)) ret-val))
817 (setq mark-alist (cdr mark-alist)))
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)))
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)))
829 (if (or force-reload read)
833 (elmo-read-msg fld msg
837 (elmo-buffer-cache-delete)
838 (error "read message %s/%s is quitted" fld msg))
840 (elmo-buffer-cache-delete)
841 (signal (car err) (cdr err))
842 nil))) ;; will not be used
843 hit)) ;; retrun value
845 (defun elmo-read-msg-with-buffer-cache (fld msg outbuf msgdb &optional force-reload)
846 (if elmo-use-buffer-cache
848 (when (setq hit (elmo-buffer-cache-message
849 (elmo-string fld) msg
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)))
858 (defun elmo-folder-pipe-p (folder)
859 (let ((type (elmo-folder-get-type folder)))
862 (let ((flds (cdr (elmo-folder-get-spec folder))))
865 (if (elmo-folder-pipe-p (car flds))
872 (nth 2 (elmo-folder-get-spec folder))))
877 (defun elmo-multi-p (folder)
878 (let ((type (elmo-folder-get-type folder)))
884 (elmo-pipe-spec-dst (elmo-folder-get-spec folder))))
887 (nth 2 (elmo-folder-get-spec folder))))
892 (defun elmo-get-real-folder-number (folder number)
893 (let ((type (elmo-folder-get-type folder)))
896 (elmo-multi-get-real-folder-number folder number))
898 (elmo-get-real-folder-number
899 (elmo-pipe-spec-dst (elmo-folder-get-spec folder) )
902 (elmo-get-real-folder-number
903 (nth 2 (elmo-folder-get-spec folder)) number))
908 (defun elmo-folder-get-primitive-spec-list (folder &optional spec-list)
909 (let ((type (elmo-folder-get-type folder))
912 ((or (eq type 'multi)
914 (let ((flds (cdr (elmo-folder-get-spec folder)))
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)))))
923 (elmo-folder-get-primitive-spec-list
924 (nth 2 (elmo-folder-get-spec folder)))))
926 (setq specs (list (elmo-folder-get-spec folder)))
930 (defun elmo-folder-get-primitive-folder-list (folder)
931 (let* ((type (elmo-folder-get-type folder)))
933 ((or (eq type 'multi)
935 (let ((flds (cdr (elmo-folder-get-spec folder)))
938 (setq ret-val (append ret-val
939 (elmo-folder-get-primitive-folder-list
941 (setq flds (cdr flds)))
944 (elmo-folder-get-primitive-folder-list
945 (nth 2 (elmo-folder-get-spec folder))))
950 (defun elmo-folder-contains-multi (folder)
951 (let ((cur-spec (elmo-folder-get-spec folder)))
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)
961 (t (setq cur-spec nil)))))
964 (defun elmo-folder-contains-type (folder type)
965 (let ((spec (elmo-folder-get-spec folder)))
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)))
975 (if (elmo-folder-contains-type (car folders) type)
977 (setq folders (cdr folders))))))
978 ((eq (car spec) type)
982 (defun elmo-folder-number-get-spec (folder number)
983 (let ((type (elmo-folder-get-type folder)))
986 (elmo-multi-folder-number-get-spec folder number))
988 (elmo-folder-number-get-spec
989 (elmo-pipe-spec-dst (elmo-folder-get-spec folder)) number))
991 (elmo-folder-number-get-spec
992 (nth 2 (elmo-folder-get-spec folder)) number))
994 (elmo-folder-get-spec folder)
997 (defun elmo-folder-number-get-type (folder number)
998 (car (elmo-folder-number-get-spec folder number)))
1000 (defun elmo-multi-folder-number-get-spec (folder number)
1001 (let* ((spec (elmo-folder-get-spec folder))
1003 (fld (nth (- (/ number elmo-multi-divide-number) 1) flds)))
1004 (elmo-folder-number-get-spec fld number)))
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")
1013 ;;; elmo2.el ends here