X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-msgdb.el;h=47dcd3d0785338ba2b7b5a8589f4532466c4a40e;hb=23f4de4ce7e0ab2ada5db8c7949ee3fda670d9ea;hp=18f9eaf9448bfe2508f7963c8317773ee5ae52d0;hpb=89547e4fbf1f6e5a452013500961a1b115f6cd0c;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 18f9eaf..47dcd3d 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -1,8 +1,10 @@ ;;; elmo-msgdb.el -- Message Database for Elmo. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 2000 Masahiro MURATA ;; Author: Yuuichi Teranishi +;; Masahiro MURATA ;; Keywords: mail, net news ;; This file is part of ELMO (Elisp Library for Message Orchestration). @@ -132,7 +134,7 @@ FOLDER should be a sring of folder name or folder spec." (defsubst elmo-msgdb-append-element (list element) (if list - ;(append list (list element)) +;;; (append list (list element)) (nconc list (list element)) ;; list is nil (list element))) @@ -272,12 +274,12 @@ FOLDER should be a sring of folder name or folder spec." ret-val)) (defun elmo-msgdb-mark-append (alist id mark) - "Append mark" + "Append mark." (setq alist (elmo-msgdb-append-element alist (list id mark)))) (defun elmo-msgdb-mark-alist-to-seen-list (number-alist mark-alist seen-marks) - "Make seen-list from mark-alist" + "Make seen-list from MARK-ALIST." (let ((seen-mark-list (string-to-char-list seen-marks)) ret-val ent) (while number-alist @@ -421,18 +423,18 @@ header separator." number-list)) (string-to-int (elmo-filter-value condition))))) ((string= key "first") - (setq result (< (- + (setq result (< (- (length number-list) (length (memq (elmo-msgdb-overview-entity-get-number entity) number-list))) (string-to-int (elmo-filter-value condition))))) ((string= key "from") - (setq result (string-match + (setq result (string-match (elmo-filter-value condition) (elmo-msgdb-overview-entity-get-from entity)))) ((string= key "subject") - (setq result (string-match + (setq result (string-match (elmo-filter-value condition) (elmo-msgdb-overview-entity-get-subject entity)))) ((string= key "to") @@ -500,8 +502,8 @@ content of MSGDB is changed." (if (and (not reserve-cache) message-id) (elmo-cache-delete message-id folder (car msg-list))) - ;; This is no good!!!! - ;(setq overview (delete (assoc message-id overview) overview)) +;;; This is no good!!!! +;;; (setq overview (delete (assoc message-id overview) overview)) (setq overview (delq (setq ov-entity @@ -554,7 +556,7 @@ content of MSGDB is changed." (defsubst elmo-msgdb-overview-entity-set-number (entity number) (and entity (aset (cdr entity) 0 number)) entity) - ;(setcar (cadr entity) number) entity) +;;;(setcar (cadr entity) number) entity) (defsubst elmo-msgdb-overview-entity-set-from (entity from) (and entity (aset (cdr entity) 2 from)) @@ -652,6 +654,30 @@ content of MSGDB is changed." (elmo-msgdb-killed-list-load dir) msgs)))) +(defun elmo-msgdb-killed-list-length (killed-list) + (let ((killed killed-list) + (ret-val 0)) + (while (car killed) + (if (consp (car killed)) + (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed)))) + (setq ret-val (+ ret-val 1))) + (setq killed (cdr killed))) + ret-val)) + +(defun elmo-msgdb-max-of-killed (killed-list) + (let ((klist killed-list) + (max 0) + k) + (while (car klist) + (if (< max + (setq k + (if (consp (car klist)) + (cdar klist) + (car klist)))) + (setq max k)) + (setq klist (cdr klist))) + max)) + (defun elmo-living-messages (messages killed-list) (if killed-list (delq nil @@ -751,7 +777,7 @@ Header region is supposed to be narrowed." (message "Sorting...") (let ((overview (elmo-msgdb-get-overview msgdb))) (setq overview (elmo-msgdb-overview-sort-by-date overview)) - (message "Sorting...done.") + (message "Sorting...done") (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb)))) (defun elmo-msgdb-clear-overview-hashtb (entity hashtb) @@ -805,17 +831,106 @@ Header region is supposed to be narrowed." (elmo-delete-directory path t)))) (defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec) - (let* ((old (directory-file-name (elmo-msgdb-expand-path old-spec))) - (new (directory-file-name (elmo-msgdb-expand-path new-spec))) + (let* ((old (directory-file-name (elmo-msgdb-expand-path old-folder))) + (new (directory-file-name (elmo-msgdb-expand-path new-folder))) (new-dir (directory-file-name (file-name-directory new)))) (if (not (file-directory-p old)) () (if (file-exists-p new) - (error "already exists directory: %s" new) + (error "Already exists directory: %s" new) (if (not (file-exists-p new-dir)) (elmo-make-directory new-dir)) (rename-file old new))))) +(defun elmo-generic-folder-diff (spec folder &optional number-list) + (let ((cached-in-db-max (elmo-folder-get-info-max folder)) + (in-folder (elmo-call-func folder "max-of-folder")) + (in-db t) + unsync messages + in-db-max) + (if (or number-list (not cached-in-db-max)) + (let ((number-list (or number-list + (mapcar 'car + (elmo-msgdb-number-load + (elmo-msgdb-expand-path folder)))))) + ;; No info-cache. + (setq in-db (sort number-list '<)) + (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db) + 0)) + (if (not number-list) + (elmo-folder-set-info-hashtb folder in-db-max nil))) + (setq in-db-max cached-in-db-max)) + (setq unsync (if (and in-db + (car in-folder)) + (- (car in-folder) in-db-max) + (if (and in-folder + (null in-db)) + (cdr in-folder) + (if (null (car in-folder)) + nil)))) + (setq messages (cdr in-folder)) + (if (and unsync messages (> unsync messages)) + (setq unsync messages)) + (cons (or unsync 0) (or messages 0)))) + +(defun elmo-generic-list-folder-unread (spec number-alist mark-alist + unread-marks) + (delq nil + (mapcar + (function (lambda (x) + (if (member (cadr (assq (car x) mark-alist)) unread-marks) + (car x)))) + mark-alist))) + +(defsubst elmo-folder-get-info (folder &optional hashtb) + (elmo-get-hash-val folder + (or hashtb elmo-folder-info-hashtb))) + +(defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread) + (let ((info (elmo-folder-get-info folder))) + (when info + (or new (setq new (nth 0 info))) + (or unread (setq unread (nth 1 info))) + (or numbers (setq numbers (nth 2 info))) + (or max (setq max (nth 3 info)))) + (elmo-set-hash-val folder + (list new unread numbers max) + elmo-folder-info-hashtb))) + +(defun elmo-folder-set-info-max-by-numdb (folder msgdb-number) + (let ((num-db (sort (mapcar 'car msgdb-number) '<))) + (elmo-folder-set-info-hashtb + folder + (or (nth (max 0 (1- (length num-db))) num-db) 0) + nil ;;(length num-db) + ))) + +(defun elmo-folder-get-info-max (folder) + "Get folder info from cache." + (nth 3 (elmo-folder-get-info folder))) + +(defun elmo-folder-get-info-length (folder) + (nth 2 (elmo-folder-get-info folder))) + +(defun elmo-folder-get-info-unread (folder) + (nth 1 (elmo-folder-get-info folder))) + +(defun elmo-folder-info-make-hashtb (info-alist hashtb) + (let* ((hashtb (or hashtb + (elmo-make-hash (length info-alist))))) + (mapcar + '(lambda (x) + (let ((info (cadr x))) + (and (intern-soft (car x) hashtb) + (elmo-set-hash-val (car x) + (list (nth 2 info) ;; new + (nth 3 info) ;; unread + (nth 1 info) ;; length + (nth 0 info)) ;; max + hashtb)))) + info-alist) + (setq elmo-folder-info-hashtb hashtb))) + (require 'product) (product-provide (provide 'elmo-msgdb) (require 'elmo-version))