-;;; elmo-msgdb.el -- Message Database for Elmo.
+;;; elmo-msgdb.el --- Message Database for ELMO.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Keywords: mail, net news
;; This file is part of ELMO (Elisp Library for Message Orchestration).
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile (require 'cl))
(require 'elmo-vars)
(require 'elmo-util)
(require 'emu)
(require 'std11)
-(require 'elmo-cache)
-
-(defun elmo-msgdb-expand-path (folder)
- "Expand msgdb path for FOLDER.
-FOLDER should be a sring of folder name or folder spec."
- (convert-standard-filename
- (let* ((spec (if (stringp folder)
- (elmo-folder-get-spec folder)
- folder))
- (type (car spec))
- fld)
- (cond
- ((eq type 'imap4)
- (setq fld (elmo-imap4-spec-mailbox spec))
- (if (string= "inbox" (downcase fld))
- (setq fld "inbox"))
- (if (eq (string-to-char fld) ?/)
- (setq fld (substring fld 1 (length fld))))
- (expand-file-name
- fld
- (expand-file-name (or (elmo-imap4-spec-username spec) "nobody")
- (expand-file-name (or
- (elmo-imap4-spec-hostname spec)
- "nowhere")
- (expand-file-name
- "imap"
- elmo-msgdb-dir)))))
- ((eq type 'nntp)
- (expand-file-name
- (elmo-nntp-spec-group spec)
- (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere")
- (expand-file-name "nntp"
- elmo-msgdb-dir))))
- ((eq type 'maildir)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "maildir"
- elmo-msgdb-dir)))
- ((eq type 'folder)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "folder"
- elmo-msgdb-dir)))
- ((eq type 'multi)
- (setq fld (concat "*" (mapconcat 'identity (cdr spec) ",")))
- (expand-file-name (elmo-safe-filename fld)
- (expand-file-name "multi"
- elmo-msgdb-dir)))
- ((eq type 'filter)
- (expand-file-name
- (elmo-replace-msgid-as-filename folder)
- (expand-file-name "filter"
- elmo-msgdb-dir)))
- ((eq type 'archive)
- (expand-file-name
- (directory-file-name
- (concat
- (elmo-replace-in-string
- (elmo-replace-in-string
- (elmo-replace-in-string
- (nth 1 spec)
- "/" "_")
- ":" "__")
- "~" "___")
- "/" (nth 3 spec)))
- (expand-file-name (concat (symbol-name type) "/"
- (symbol-name (nth 2 spec)))
- elmo-msgdb-dir)))
- ((eq type 'pop3)
- (expand-file-name
- (elmo-safe-filename (elmo-pop3-spec-username spec))
- (expand-file-name (elmo-pop3-spec-hostname spec)
- (expand-file-name
- "pop"
- elmo-msgdb-dir))))
- ((eq type 'localnews)
- (expand-file-name
- (elmo-replace-in-string (nth 1 spec) "/" ".")
- (expand-file-name "localnews"
- elmo-msgdb-dir)))
- ((eq type 'internal)
- (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec))
- (nth 2 spec)))
- (expand-file-name "internal"
- elmo-msgdb-dir)))
- ((eq type 'cache)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "internal/cache"
- elmo-msgdb-dir)))
- (t ; local dir or undefined type
- ;; absolute path
- (setq fld (nth 1 spec))
- (if (file-name-absolute-p fld)
- (setq fld (elmo-safe-filename fld)))
- (expand-file-name fld
- (expand-file-name (symbol-name type)
- elmo-msgdb-dir)))))))
+(require 'mime)
+
+(defcustom elmo-msgdb-new-mark "N"
+ "Mark for new message."
+ :type '(string :tag "Mark")
+ :group 'elmo)
+
+(defcustom elmo-msgdb-unread-uncached-mark "U"
+ "Mark for unread and uncached message."
+ :type '(string :tag "Mark")
+ :group 'elmo)
+
+(defcustom elmo-msgdb-unread-cached-mark "!"
+ "Mark for unread but already cached message."
+ :type '(string :tag "Mark")
+ :group 'elmo)
+
+(defcustom elmo-msgdb-read-uncached-mark "u"
+ "Mark for read but uncached message."
+ :type '(string :tag "Mark")
+ :group 'elmo)
+
+(defcustom elmo-msgdb-answered-cached-mark "&"
+ "Mark for answered and cached message."
+ :type '(string :tag "Mark")
+ :group 'elmo)
+
+(defcustom elmo-msgdb-answered-uncached-mark "A"
+ "Mark for answered but cached message."
+ :type '(string :tag "Mark")
+ :group 'elmo)
+
+(defcustom elmo-msgdb-important-mark "$"
+ "Mark for important message."
+ :type '(string :tag "Mark")
+ :group 'elmo)
+
+;;; MSGDB interface.
+;;
+;; MSGDB elmo-load-msgdb PATH
+;; MARK elmo-msgdb-get-mark MSGDB NUMBER
+
+;; CACHED elmo-msgdb-get-cached MSGDB NUMBER
+;; VOID elmo-msgdb-set-cached MSGDB NUMBER CACHED USE-CACHE
+;; VOID elmo-msgdb-set-flag MSGDB FOLDER NUMBER FLAG
+;; VOID elmo-msgdb-unset-flag MSGDB FOLDER NUMBER FLAG
+
+;; LIST-OF-NUMBERS elmo-msgdb-count-marks MSGDB
+;; NUMBER elmo-msgdb-get-number MSGDB MESSAGE-ID
+;; FIELD-VALUE elmo-msgdb-get-field MSGDB NUMBER FIELD
+;; MSGDB elmo-msgdb-append MSGDB MSGDB-APPEND
+;; MSGDB elmo-msgdb-clear MSGDB
+;; elmo-msgdb-delete-msgs MSGDB NUMBERS
+;; elmo-msgdb-sort-by-date MSGDB
+
+;;;
+;; LIST-OF-NUMBERS elmo-msgdb-list-messages MSGDB
+
+;; elmo-flag-table-load
+;; elmo-flag-table-set
+;; elmo-flag-table-get
+;; elmo-flag-table-save
+
+;; elmo-msgdb-append-entity MSGDB ENTITY MARK-OR-FLAGS
+
+;; ENTITY elmo-msgdb-make-entity ARGS
+;; VALUE elmo-msgdb-entity-field ENTITY
+;;
+
+;; OVERVIEW elmo-msgdb-get-overview MSGDB
+;; NUMBER-ALIST elmo-msgdb-get-number-alist MSGDB
+;; MARK-ALIST elmo-msgdb-get-mark-alist MSGDB
+;; elmo-msgdb-change-mark MSGDB BEFORE AFTER
+
+;; (for internal use?)
+;; LIST-OF-MARKS elmo-msgdb-unread-marks
+;; LIST-OF-MARKS elmo-msgdb-answered-marks
+;; LIST-OF-MARKS elmo-msgdb-uncached-marks
+;; elmo-msgdb-overview-save DIR OBJ
+
+;; elmo-msgdb-message-entity MSGDB KEY
+
+;;; Abolish
+;; elmo-msgdb-overview-entity-get-references ENTITY
+;; elmo-msgdb-overview-entity-set-references ENTITY
+;; elmo-msgdb-get-parent-entity ENTITY MSGDB
+;; elmo-msgdb-overview-enitty-get-number ENTITY
+;; elmo-msgdb-overview-enitty-get-from-no-decode ENTITY
+;; elmo-msgdb-overview-enitty-get-from ENTITY
+;; elmo-msgdb-overview-enitty-get-subject-no-decode ENTITY
+;; elmo-msgdb-overview-enitty-get-subject ENTITY
+;; elmo-msgdb-overview-enitty-get-date ENTITY
+;; elmo-msgdb-overview-enitty-get-to ENTITY
+;; elmo-msgdb-overview-enitty-get-cc ENTITY
+;; elmo-msgdb-overview-enitty-get-size ENTITY
+;; elmo-msgdb-overview-enitty-get-id ENTITY
+;; elmo-msgdb-overview-enitty-get-extra-field ENTITY
+;; elmo-msgdb-overview-enitty-get-extra ENTITY
+;; elmo-msgdb-overview-get-entity ID MSGDB
+
+;; elmo-msgdb-killed-list-load DIR
+;; elmo-msgdb-killed-list-save DIR
+;; elmo-msgdb-append-to-killed-list FOLDER MSG
+;; elmo-msgdb-killed-list-length KILLED-LIST
+;; elmo-msgdb-max-of-killed KILLED-LIST
+;; elmo-msgdb-killed-message-p KILLED-LIST MSG
+;; elmo-living-messages MESSAGES KILLED-LIST
+;; elmo-msgdb-finfo-load
+;; elmo-msgdb-finfo-save
+;; elmo-msgdb-flist-load
+;; elmo-msgdb-flist-save
+
+;; elmo-crosspost-alist-load
+;; elmo-crosspost-alist-save
+
+;; elmo-msgdb-create-overview-from-buffer NUMBER SIZE TIME
+;; elmo-msgdb-copy-overview-entity ENTITY
+;; elmo-msgdb-create-overview-entity-from-file NUMBER FILE
+;; elmo-msgdb-overview-sort-by-date OVERVIEW
+;; elmo-msgdb-clear-index
+
+;; elmo-folder-get-info
+;; elmo-folder-get-info-max
+;; elmo-folder-get-info-length
+;; elmo-folder-get-info-unread
+
+;; elmo-msgdb-list-flagged MSGDB FLAG
+;; (MACRO) elmo-msgdb-do-each-entity
+
+(defun elmo-load-msgdb (path)
+ "Load the MSGDB from PATH."
+ (let ((inhibit-quit t))
+ (elmo-make-msgdb (elmo-msgdb-overview-load path)
+ (elmo-msgdb-number-load path)
+ (elmo-msgdb-mark-load path)
+ path)))
+
+(defun elmo-make-msgdb (&optional overview number-alist mark-alist path)
+ "Make a MSGDB."
+ (let ((msgdb (list overview number-alist mark-alist nil path)))
+ (elmo-msgdb-make-index msgdb)
+ msgdb))
+
+(defun elmo-msgdb-list-messages (msgdb)
+ "Return a list of message numbers in the MSGDB."
+ (mapcar 'elmo-msgdb-overview-entity-get-number
+ (elmo-msgdb-get-overview msgdb)))
+
+(defsubst elmo-msgdb-mark-to-flags (mark)
+ (append
+ (and (string= mark elmo-msgdb-new-mark)
+ '(new))
+ (and (string= mark elmo-msgdb-important-mark)
+ '(important))
+ (and (member mark (elmo-msgdb-unread-marks))
+ '(unread))
+ (and (member mark (elmo-msgdb-answered-marks))
+ '(answered))
+ (and (not (member mark (elmo-msgdb-uncached-marks)))
+ '(cached))))
+
+(defsubst elmo-msgdb-flags-to-mark (flags cached use-cache)
+ (cond ((memq 'new flags)
+ elmo-msgdb-new-mark)
+ ((memq 'important flags)
+ elmo-msgdb-important-mark)
+ ((memq 'answered flags)
+ (if cached
+ elmo-msgdb-answered-cached-mark
+ elmo-msgdb-answered-uncached-mark))
+ ((memq 'unread flags)
+ (if cached
+ elmo-msgdb-unread-cached-mark
+ elmo-msgdb-unread-uncached-mark))
+ (t
+ (if (or cached (not use-cache))
+ nil
+ elmo-msgdb-read-uncached-mark))))
+
+(defsubst elmo-msgdb-get-mark (msgdb number)
+ "Get mark string from MSGDB which corresponds to the message with NUMBER."
+ (cadr (elmo-get-hash-val (format "#%d" number)
+ (elmo-msgdb-get-mark-hashtb msgdb))))
+
+(defsubst elmo-msgdb-set-mark (msgdb number mark)
+ "Set MARK of the message with NUMBER in the MSGDB.
+if MARK is nil, mark is removed."
+ (let ((elem (elmo-get-hash-val (format "#%d" number)
+ (elmo-msgdb-get-mark-hashtb msgdb))))
+ (if elem
+ (if mark
+ ;; Set mark of the elem
+ (setcar (cdr elem) mark)
+ ;; Delete elem from mark-alist
+ (elmo-msgdb-set-mark-alist
+ msgdb
+ (delq elem (elmo-msgdb-get-mark-alist msgdb)))
+ (elmo-clear-hash-val (format "#%d" number)
+ (elmo-msgdb-get-mark-hashtb msgdb)))
+ (when mark
+ ;; Append new element.
+ (elmo-msgdb-set-mark-alist
+ msgdb
+ (nconc
+ (elmo-msgdb-get-mark-alist msgdb)
+ (list (setq elem (list number mark)))))
+ (elmo-set-hash-val (format "#%d" number) elem
+ (elmo-msgdb-get-mark-hashtb msgdb))))
+ ;; return value.
+ t))
+
+(defun elmo-msgdb-get-cached (msgdb number)
+ "Return non-nil if message is cached."
+ (not (member (elmo-msgdb-get-mark msgdb number)
+ (elmo-msgdb-uncached-marks))))
+
+(defun elmo-msgdb-set-cached (msgdb number cached use-cache)
+ "Set message cache status.
+If mark is changed, return non-nil."
+ (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
+ (cur-flag (cond
+ ((string= cur-mark elmo-msgdb-important-mark)
+ 'important)
+ ((member cur-mark (elmo-msgdb-answered-marks))
+ 'answered)
+ ((not (member cur-mark (elmo-msgdb-unread-marks)))
+ 'read)))
+ (cur-cached (elmo-file-cache-exists-p
+ (elmo-msgdb-get-field msgdb number 'message-id))))
+ (unless (eq cached cur-cached)
+ (case cur-flag
+ (read
+ (elmo-msgdb-set-mark msgdb number
+ (if (and use-cache (not cached))
+ elmo-msgdb-read-uncached-mark)))
+ (important nil)
+ (answered
+ (elmo-msgdb-set-mark msgdb number
+ (if cached
+ elmo-msgdb-answered-cached-mark
+ elmo-msgdb-answered-uncached-mark)))
+ (t
+ (elmo-msgdb-set-mark msgdb number
+ (if cached
+ elmo-msgdb-unread-cached-mark
+ elmo-msgdb-unread-uncached-mark)))))))
+
+(defsubst elmo-msgdb-flags (msgdb number)
+ (elmo-msgdb-mark-to-flags (elmo-msgdb-get-mark msgdb number)))
+
+(defun elmo-msgdb-set-flag (msgdb folder number flag)
+ "Set message flag.
+MSGDB is the ELMO msgdb.
+FOLDER is a ELMO folder structure.
+NUMBER is a message number to set flag.
+FLAG is a symbol which is one of the following:
+`read' ... Messages which are already read.
+`important' ... Messages which are marked as important.
+`answered' ... Messages which are marked as answered."
+ (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
+ (use-cache (elmo-message-use-cache-p folder number))
+ (cur-flag (cond
+ ((string= cur-mark elmo-msgdb-important-mark)
+ 'important)
+ ((member cur-mark (elmo-msgdb-answered-marks))
+ 'answered)
+ ((not (member cur-mark (elmo-msgdb-unread-marks)))
+ 'read)))
+ (cur-cached (elmo-file-cache-exists-p
+ (elmo-msgdb-get-field msgdb number 'message-id)))
+ mark-modified)
+ (case flag
+ (read
+ (case cur-flag
+ ((read important)) ; answered mark is overriden.
+ (t (elmo-msgdb-set-mark msgdb number
+ (if (and use-cache (not cur-cached))
+ elmo-msgdb-read-uncached-mark))
+ (setq mark-modified t))))
+ (important
+ (unless (eq cur-flag 'important)
+ (elmo-msgdb-set-mark msgdb number elmo-msgdb-important-mark)
+ (setq mark-modified t)))
+ (answered
+ (unless (or (eq cur-flag 'answered) (eq cur-flag 'important))
+ (elmo-msgdb-set-mark msgdb number
+ (if cur-cached
+ elmo-msgdb-answered-cached-mark
+ elmo-msgdb-answered-uncached-mark)))
+ (setq mark-modified t)))
+ (if mark-modified (elmo-folder-set-mark-modified-internal folder t))))
+
+(defun elmo-msgdb-unset-flag (msgdb folder number flag)
+ "Unset message flag.
+MSGDB is the ELMO msgdb.
+FOLDER is a ELMO folder structure.
+NUMBER is a message number to be set flag.
+FLAG is a symbol which is one of the following:
+`read' ... Messages which are already read.
+`important' ... Messages which are marked as important.
+`answered' ... Messages which are marked as answered."
+ (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
+ (use-cache (elmo-message-use-cache-p folder number))
+ (cur-flag (cond
+ ((string= cur-mark elmo-msgdb-important-mark)
+ 'important)
+ ((member cur-mark (elmo-msgdb-answered-marks))
+ 'answered)
+ ((not (member cur-mark (elmo-msgdb-unread-marks)))
+ 'read)))
+ (cur-cached (elmo-file-cache-exists-p
+ (elmo-msgdb-get-field msgdb number 'message-id)))
+ mark-modified)
+ (case flag
+ (read
+ (when (or (eq cur-flag 'read) (eq cur-flag 'answered))
+ (elmo-msgdb-set-mark msgdb number
+ (if cur-cached
+ elmo-msgdb-unread-cached-mark
+ elmo-msgdb-unread-uncached-mark))
+ (setq mark-modified t)))
+ (important
+ (when (eq cur-flag 'important)
+ (elmo-msgdb-set-mark msgdb number nil)
+ (setq mark-modified t)))
+ (answered
+ (when (eq cur-flag 'answered)
+ (elmo-msgdb-set-mark msgdb number
+ (if (and use-cache (not cur-cached))
+ elmo-msgdb-read-uncached-mark))
+ (setq mark-modified t))))
+ (if mark-modified (elmo-folder-set-mark-modified-internal folder t))))
+
+(defvar elmo-msgdb-unread-marks-internal nil)
+(defsubst elmo-msgdb-unread-marks ()
+ "Return an unread mark list"
+ (or elmo-msgdb-unread-marks-internal
+ (setq elmo-msgdb-unread-marks-internal
+ (list elmo-msgdb-new-mark
+ elmo-msgdb-unread-uncached-mark
+ elmo-msgdb-unread-cached-mark))))
+
+(defvar elmo-msgdb-answered-marks-internal nil)
+(defsubst elmo-msgdb-answered-marks ()
+ "Return an answered mark list"
+ (or elmo-msgdb-answered-marks-internal
+ (setq elmo-msgdb-answered-marks-internal
+ (list elmo-msgdb-answered-cached-mark
+ elmo-msgdb-answered-uncached-mark))))
+
+(defvar elmo-msgdb-uncached-marks-internal nil)
+(defsubst elmo-msgdb-uncached-marks ()
+ (or elmo-msgdb-uncached-marks-internal
+ (setq elmo-msgdb-uncached-marks-internal
+ (list elmo-msgdb-new-mark
+ elmo-msgdb-answered-uncached-mark
+ elmo-msgdb-unread-uncached-mark
+ elmo-msgdb-read-uncached-mark))))
+
+(defun elmo-msgdb-append-entity (msgdb entity &optional mark)
+ (when entity
+ (let ((number (elmo-msgdb-overview-entity-get-number entity))
+ (message-id (elmo-msgdb-overview-entity-get-id entity)))
+ (elmo-msgdb-set-overview
+ msgdb
+ (nconc (elmo-msgdb-get-overview msgdb)
+ (list entity)))
+ (elmo-msgdb-set-number-alist
+ msgdb
+ (nconc (elmo-msgdb-get-number-alist msgdb)
+ (list (cons number message-id))))
+ (when mark
+ (elmo-msgdb-set-mark-alist
+ msgdb
+ (nconc (elmo-msgdb-get-mark-alist msgdb)
+ (list (list number mark)))))
+ (elmo-msgdb-make-index
+ msgdb
+ (list entity)
+ (list (list number mark))))))
+
+(defsubst elmo-msgdb-get-number (msgdb message-id)
+ "Get number of the message which corrensponds to MESSAGE-ID from MSGDB."
+ (elmo-msgdb-overview-entity-get-number
+ (elmo-msgdb-overview-get-entity message-id msgdb)))
+
+(defsubst elmo-msgdb-get-field (msgdb number field)
+ "Get FIELD value of the message with NUMBER from MSGDB."
+ (case field
+ (message-id (elmo-msgdb-overview-entity-get-id
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (subject (elmo-msgdb-overview-entity-get-subject
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (size (elmo-msgdb-overview-entity-get-size
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (date (elmo-msgdb-overview-entity-get-date
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (to (elmo-msgdb-overview-entity-get-to
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (cc (elmo-msgdb-overview-entity-get-cc
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))))
+
+(defun elmo-msgdb-append (msgdb msgdb-append)
+ "Return a list of messages which have duplicated message-id."
+ (let (duplicates)
+ (elmo-msgdb-set-overview
+ msgdb
+ (nconc (elmo-msgdb-get-overview msgdb)
+ (elmo-msgdb-get-overview msgdb-append)))
+ (elmo-msgdb-set-number-alist
+ msgdb
+ (nconc (elmo-msgdb-get-number-alist msgdb)
+ (elmo-msgdb-get-number-alist msgdb-append)))
+ (elmo-msgdb-set-mark-alist
+ msgdb
+ (nconc (elmo-msgdb-get-mark-alist msgdb)
+ (elmo-msgdb-get-mark-alist msgdb-append)))
+ (setq duplicates (elmo-msgdb-make-index
+ msgdb
+ (elmo-msgdb-get-overview msgdb-append)
+ (elmo-msgdb-get-mark-alist msgdb-append)))
+ (elmo-msgdb-set-path
+ msgdb
+ (or (elmo-msgdb-get-path msgdb)
+ (elmo-msgdb-get-path msgdb-append)))
+ duplicates))
+
+(defun elmo-msgdb-merge (folder msgdb-merge)
+ "Return a list of messages which have duplicated message-id."
+ (let (msgdb duplicates)
+ (setq msgdb (or (elmo-folder-msgdb-internal folder)
+ (elmo-make-msgdb nil nil nil
+ (elmo-folder-msgdb-path folder))))
+ (setq duplicates (elmo-msgdb-append msgdb msgdb-merge))
+ (elmo-folder-set-msgdb-internal folder msgdb)
+ duplicates))
+
+(defsubst elmo-msgdb-clear (&optional msgdb)
+ (if msgdb
+ (progn
+ (elmo-msgdb-set-overview msgdb nil)
+ (elmo-msgdb-set-number-alist msgdb nil)
+ (elmo-msgdb-set-mark-alist msgdb nil)
+ (elmo-msgdb-set-index msgdb nil)
+ msgdb)
+ (elmo-make-msgdb)))
+
+(defun elmo-msgdb-delete-msgs (msgdb msgs)
+ "Delete MSGS from MSGDB
+content of MSGDB is changed."
+ (let* ((overview (car msgdb))
+ (number-alist (cadr msgdb))
+ (mark-alist (caddr msgdb))
+ (index (elmo-msgdb-get-index msgdb))
+ (newmsgdb (list overview number-alist mark-alist index
+ (nth 4 msgdb)))
+ ov-entity)
+ ;; remove from current database.
+ (while msgs
+ (setq overview
+ (delq
+ (setq ov-entity
+ (elmo-msgdb-overview-get-entity (car msgs) newmsgdb))
+ overview))
+ (setq number-alist (delq (assq (car msgs) number-alist) number-alist))
+ (setq mark-alist (delq (assq (car msgs) mark-alist) mark-alist))
+ ;;
+ (when index (elmo-msgdb-clear-index msgdb ov-entity))
+ (setq msgs (cdr msgs)))
+ (elmo-msgdb-set-overview msgdb overview)
+ (elmo-msgdb-set-number-alist msgdb number-alist)
+ (elmo-msgdb-set-mark-alist msgdb mark-alist)
+ (elmo-msgdb-set-index msgdb index)
+ t)) ;return value
+
+(defun elmo-msgdb-sort-by-date (msgdb)
+ (message "Sorting...")
+ (let ((overview (elmo-msgdb-get-overview msgdb)))
+ (elmo-msgdb-set-overview
+ msgdb
+ (elmo-msgdb-overview-sort-by-date overview))
+ (message "Sorting...done")
+ msgdb))
+;;;
(defsubst elmo-msgdb-append-element (list element)
(if list
;;; (append list (list element))
(cadr msgdb))
(defsubst elmo-msgdb-get-mark-alist (msgdb)
(caddr msgdb))
-(defsubst elmo-msgdb-get-location (msgdb)
- (cadddr msgdb))
-(defsubst elmo-msgdb-get-overviewht (msgdb)
+;(defsubst elmo-msgdb-get-location (msgdb)
+; (cadddr msgdb))
+
+(defsubst elmo-msgdb-get-index (msgdb)
+ (nth 3 msgdb))
+
+(defsubst elmo-msgdb-get-entity-hashtb (msgdb)
+ (car (nth 3 msgdb)))
+
+(defsubst elmo-msgdb-get-mark-hashtb (msgdb)
+ (cdr (nth 3 msgdb)))
+
+(defsubst elmo-msgdb-get-path (msgdb)
(nth 4 msgdb))
;;
(elmo-msgdb-append-element ret-val (cons number id)))
ret-val))
-;;;
-;; parsistent mark handling
-;; (for global!)
-
-(defvar elmo-msgdb-global-mark-alist nil)
-
-(defun elmo-msgdb-global-mark-delete (msgid)
- (let* ((path (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir))
- (malist (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load path))))
- match)
- (when (setq match (assoc msgid malist))
- (setq elmo-msgdb-global-mark-alist
- (delete match elmo-msgdb-global-mark-alist))
- (elmo-object-save path elmo-msgdb-global-mark-alist))))
-
-(defun elmo-msgdb-global-mark-set (msgid mark)
- (let* ((path (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir))
- (malist (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load path))))
- match)
- (if (setq match (assoc msgid malist))
- (setcdr match mark)
- (setq elmo-msgdb-global-mark-alist
- (nconc elmo-msgdb-global-mark-alist
- (list (cons msgid mark)))))
- (elmo-object-save path elmo-msgdb-global-mark-alist)))
-
-(defun elmo-msgdb-global-mark-get (msgid)
- (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load
- (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir)))))))
-
-;;
-;; number <-> location handling
+;;; flag table
;;
-(defsubst elmo-msgdb-location-load (dir)
- (elmo-object-load
- (expand-file-name
- elmo-msgdb-location-filename
- dir)))
-
-(defsubst elmo-msgdb-location-add (alist number location)
- (let ((ret-val alist))
- (setq ret-val
- (elmo-msgdb-append-element ret-val (cons number location)))
- ret-val))
-
-(defsubst elmo-msgdb-location-save (dir alist)
+(defvar elmo-flag-table-filename "flag-table")
+(defun elmo-flag-table-load (dir)
+ "Load flag hashtable for MSGDB."
+ (let ((table (elmo-make-hash))
+ ;; For backward compatibility
+ (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
+ seen-list)
+ (when (file-exists-p seen-file)
+ (setq seen-list (elmo-object-load seen-file))
+ (delete-file seen-file))
+ (dolist (msgid seen-list)
+ (elmo-set-hash-val msgid 'read table))
+ (dolist (pair (elmo-object-load
+ (expand-file-name elmo-flag-table-filename dir)))
+ (elmo-set-hash-val (car pair) (cdr pair) table))
+ table))
+
+(defun elmo-flag-table-set (flag-table msg-id flag)
+ (elmo-set-hash-val msg-id flag flag-table))
+
+(defun elmo-flag-table-get (flag-table msg-id)
+ (elmo-get-hash-val msg-id flag-table))
+
+(defun elmo-flag-table-save (dir flag-table)
(elmo-object-save
- (expand-file-name
- elmo-msgdb-location-filename
- dir) alist))
-
-(defun elmo-list-folder-by-location (spec locations &optional msgdb)
- (let* ((path (elmo-msgdb-expand-path spec))
- (location-alist (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load path)))
- (locations-in-db (mapcar 'cdr location-alist))
- result new-locs new-alist deleted-locs i
- modified)
- (setq new-locs
- (elmo-delete-if (function
- (lambda (x) (member x locations-in-db)))
- locations))
- (setq deleted-locs
- (elmo-delete-if (function
- (lambda (x) (member x locations)))
- locations-in-db))
- (setq modified new-locs)
- (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
- (mapcar
- (function
- (lambda (x)
- (setq location-alist
- (delq (rassoc x location-alist) location-alist))))
- deleted-locs)
- (while new-locs
- (setq i (1+ i))
- (setq new-alist (cons (cons i (car new-locs)) new-alist))
- (setq new-locs (cdr new-locs)))
- (setq result (nconc location-alist new-alist))
- (setq result (sort result (lambda (x y) (< (car x)(car y)))))
- (if modified (elmo-msgdb-location-save path result))
- (mapcar 'car result)))
-
+ (expand-file-name elmo-flag-table-filename dir)
+ (if flag-table
+ (let (list)
+ (mapatoms (lambda (atom)
+ (setq list (cons (cons (symbol-name atom)
+ (symbol-value atom))
+ list)))
+ flag-table)
+ list))))
;;;
;; persistent mark handling
;; (for each folder)
-(defun elmo-msgdb-mark-set (alist id mark)
- (let ((ret-val alist)
- entity)
- (setq entity (assq id alist))
- (if entity
- (if (eq mark nil)
- ;; delete this entity
- (setq ret-val (delq entity alist))
- ;; set mark
- (setcar (cdr entity) mark))
- (if mark
- (setq ret-val (elmo-msgdb-append-element ret-val
- (list id mark)))))
- ret-val))
(defun elmo-msgdb-mark-append (alist id 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."
- (let ((seen-mark-list (string-to-char-list seen-marks))
- ret-val ent)
- (while number-alist
- (if (setq ent (assq (car (car number-alist)) mark-alist))
- (if (and (cadr ent)
- (memq (string-to-char (cadr ent)) seen-mark-list))
- (setq ret-val (cons (cdr (car number-alist)) ret-val)))
- (setq ret-val (cons (cdr (car number-alist)) ret-val)))
- (setq number-alist (cdr number-alist)))
- ret-val))
+(defsubst elmo-msgdb-length (msgdb)
+ (length (elmo-msgdb-get-overview msgdb)))
+
+(defun elmo-msgdb-flag-table (msgdb &optional flag-table)
+ ;; Make a table of msgid flag (read, answered)
+ (let ((flag-table (or flag-table (elmo-make-hash (elmo-msgdb-length msgdb))))
+ mark)
+ (dolist (ov (elmo-msgdb-get-overview msgdb))
+ (setq mark (elmo-msgdb-get-mark
+ msgdb
+ (elmo-msgdb-overview-entity-get-number ov)))
+ (cond
+ ((null mark)
+ (elmo-set-hash-val
+ (elmo-msgdb-overview-entity-get-id ov)
+ 'read
+ flag-table))
+ ((and mark (member mark (elmo-msgdb-answered-marks)))
+ (elmo-set-hash-val
+ (elmo-msgdb-overview-entity-get-id ov)
+ 'answered
+ flag-table))
+ ((and mark (not (member mark
+ (elmo-msgdb-unread-marks))))
+ (elmo-set-hash-val
+ (elmo-msgdb-overview-entity-get-id ov)
+ 'read
+ flag-table))))
+ flag-table))
;;
;; mime decode cache
;;
;; overview handling
;;
-
-(defsubst elmo-msgdb-get-field-value (field-name beg end buffer)
- (save-excursion
- (save-restriction
- (set-buffer buffer)
- (narrow-to-region beg end)
- (elmo-field-body field-name))))
-
(defun elmo-multiple-field-body (name &optional boundary)
(save-excursion
(save-restriction
(expand-file-name elmo-msgdb-mark-filename dir)
obj))
-(defsubst elmo-msgdb-seen-save (dir obj)
- (elmo-object-save
- (expand-file-name elmo-msgdb-seen-filename dir)
- obj))
+(defun elmo-msgdb-change-mark (msgdb before after)
+ "Set the BEFORE marks to AFTER."
+ (let ((mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ entity)
+ (while mark-alist
+ (setq entity (car mark-alist))
+ (when (string= (cadr entity) before)
+ (setcar (cdr entity) after))
+ (setq mark-alist (cdr mark-alist)))))
+
+(defsubst elmo-msgdb-mark (flag cached &optional new)
+ (if new
+ (case flag
+ (read
+ (if cached
+ nil
+ elmo-msgdb-read-uncached-mark))
+ (important
+ elmo-msgdb-important-mark)
+ (answered
+ (if cached
+ elmo-msgdb-answered-cached-mark
+ elmo-msgdb-answered-uncached-mark))
+ (t
+ (if cached
+ elmo-msgdb-unread-cached-mark
+ elmo-msgdb-new-mark)))
+ (case flag
+ (unread
+ (if cached
+ elmo-msgdb-unread-cached-mark
+ elmo-msgdb-unread-uncached-mark))
+ (important
+ elmo-msgdb-important-mark)
+ (answered
+ (if cached
+ elmo-msgdb-answered-cached-mark
+ elmo-msgdb-answered-uncached-mark)))))
(defsubst elmo-msgdb-overview-save (dir overview)
(elmo-object-save
(expand-file-name elmo-msgdb-overview-filename dir)
overview))
-(defun elmo-msgdb-search-internal-primitive (condition entity number-list)
- (let ((key (elmo-filter-key condition))
- result)
- (cond
- ((string= key "last")
- (setq result (<= (length (memq
- (elmo-msgdb-overview-entity-get-number entity)
- number-list))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "first")
- (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
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-from entity))))
- ((string= key "subject")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-subject entity))))
- ((string= key "to")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-to entity))))
- ((string= key "cc")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-cc entity))))
- ((or (string= key "since")
- (string= key "before"))
- (let ((res (string< (timezone-make-date-sortable
- (elmo-msgdb-overview-entity-get-date entity))
- (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition))))))
- (setq result (if (string= key "before") res (not res)))))
- ((member key elmo-msgdb-extra-fields)
- (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
- (if (stringp extval)
+(defun elmo-msgdb-match-condition-primitive (condition mark entity numbers)
+ (catch 'unresolved
+ (let ((key (elmo-filter-key condition))
+ (case-fold-search t)
+ result)
+ (cond
+ ((string= key "last")
+ (setq result (<= (length (memq
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ numbers))
+ (string-to-int (elmo-filter-value condition)))))
+ ((string= key "first")
+ (setq result (< (-
+ (length numbers)
+ (length (memq
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ numbers)))
+ (string-to-int (elmo-filter-value condition)))))
+ ((string= key "flag")
+ (setq result
+ (cond
+ ((string= (elmo-filter-value condition) "any")
+ (not (or (null mark)
+ (string= mark elmo-msgdb-read-uncached-mark))))
+ ((string= (elmo-filter-value condition) "digest")
+ (not (or (null mark)
+ (string= mark elmo-msgdb-read-uncached-mark)
+ (string= mark elmo-msgdb-answered-cached-mark)
+ (string= mark elmo-msgdb-answered-uncached-mark))))
+;; (member mark (append (elmo-msgdb-answered-marks)
+;; (list elmo-msgdb-important-mark)
+;; (elmo-msgdb-unread-marks))))
+ ((string= (elmo-filter-value condition) "unread")
+ (member mark (elmo-msgdb-unread-marks)))
+ ((string= (elmo-filter-value condition) "important")
+ (string= mark elmo-msgdb-important-mark))
+ ((string= (elmo-filter-value condition) "answered")
+ (member mark (elmo-msgdb-answered-marks))))))
+ ((string= key "from")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-from entity))))
+ ((string= key "subject")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-subject entity))))
+ ((string= key "to")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-to entity))))
+ ((string= key "cc")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-cc entity))))
+ ((or (string= key "since")
+ (string= key "before"))
+ (let ((field-date (elmo-date-make-sortable-string
+ (timezone-fix-time
+ (elmo-msgdb-overview-entity-get-date entity)
+ (current-time-zone) nil)))
+ (specified-date
+ (elmo-date-make-sortable-string
+ (elmo-date-get-datevec
+ (elmo-filter-value condition)))))
+ (setq result (if (string= key "since")
+ (or (string= specified-date field-date)
+ (string< specified-date field-date))
+ (string< field-date specified-date)))))
+ ((member key elmo-msgdb-extra-fields)
+ (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
+ (when (stringp extval)
(setq result (string-match
(elmo-filter-value condition)
- extval))))))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (setq result (not result)))
- result))
-
-(defun elmo-msgdb-search-internal (condition entity number-list)
+ extval)))))
+ (t
+ (throw 'unresolved condition)))
+ (if (eq (elmo-filter-type condition) 'unmatch)
+ (not result)
+ result))))
+
+(defun elmo-msgdb-match-condition-internal (condition mark entity numbers)
(cond
((vectorp condition)
- (elmo-msgdb-search-internal-primitive condition entity number-list))
+ (elmo-msgdb-match-condition-primitive condition mark entity numbers))
((eq (car condition) 'and)
- (and (elmo-msgdb-search-internal-primitive
- (nth 1 condition) entity number-list)
- (elmo-msgdb-search-internal-primitive
- (nth 2 condition) entity number-list)))
+ (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
+ mark entity numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-match-condition-internal
+ (nth 2 condition) mark entity numbers)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'and lhs rhs))
+ (rhs
+ lhs))))
+ (lhs
+ (elmo-msgdb-match-condition-internal (nth 2 condition)
+ mark entity numbers)))))
((eq (car condition) 'or)
- (or (elmo-msgdb-search-internal-primitive
- (nth 1 condition) entity number-list)
- (elmo-msgdb-search-internal-primitive
- (nth 2 condition) entity number-list)))))
-
-(defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
- "Delete MSGS from FOLDER in MSGDB.
-content of MSGDB is changed."
- (save-excursion
- (let* ((msg-list msgs)
- (dir (elmo-msgdb-expand-path folder))
- (overview (or (car msgdb)
- (elmo-msgdb-overview-load dir)))
- (number-alist (or (cadr msgdb)
- (elmo-msgdb-number-load dir)))
- (mark-alist (or (caddr msgdb)
- (elmo-msgdb-mark-load dir)))
- (loc-alist (or (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load dir)))
- (hashtb (or (elmo-msgdb-get-overviewht msgdb)
- (elmo-msgdb-make-overview-hashtb overview)))
- (newmsgdb (list overview number-alist mark-alist (nth 3 msgdb) hashtb))
- ov-entity message-id)
- ;; remove from current database.
- (while msg-list
- (setq message-id (cdr (assq (car msg-list) number-alist)))
- (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))
- (setq overview
- (delq
- (setq ov-entity
- (elmo-msgdb-overview-get-entity (car msg-list) newmsgdb))
- overview))
- (when (and elmo-use-overview-hashtb hashtb)
- (elmo-msgdb-clear-overview-hashtb ov-entity hashtb))
- (setq number-alist
- (delq (assq (car msg-list) number-alist) number-alist))
- (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
- (setq loc-alist (delq (assq (car msg-list) loc-alist) loc-alist))
- ;; XXX Should consider when folder is not persistent.
- ;; (elmo-msgdb-location-save dir loc-alist)
- (setq msg-list (cdr msg-list)))
- (setcar msgdb overview)
- (setcar (cdr msgdb) number-alist)
- (setcar (cddr msgdb) mark-alist)
- (setcar (nthcdr 4 msgdb) hashtb))
- t)) ;return value
+ (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
+ mark entity numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-match-condition-internal (nth 2 condition)
+ mark entity numbers)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'or lhs rhs))
+ (rhs
+ t)
+ (t
+ lhs))))
+ (lhs
+ t)
+ (t
+ (elmo-msgdb-match-condition-internal (nth 2 condition)
+ mark entity numbers)))))))
+
+(defun elmo-msgdb-match-condition (msgdb condition number numbers)
+ "Check whether the condition of the message is satisfied or not.
+MSGDB is the msgdb to search from.
+CONDITION is the search condition.
+NUMBER is the message number to check.
+NUMBERS is the target message number list.
+Return CONDITION itself if no entity exists in msgdb."
+ (let ((entity (elmo-msgdb-overview-get-entity number msgdb)))
+ (if entity
+ (elmo-msgdb-match-condition-internal condition
+ (elmo-msgdb-get-mark msgdb number)
+ entity numbers)
+ condition)))
(defsubst elmo-msgdb-set-overview (msgdb overview)
(setcar msgdb overview))
(defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
(setcar (cddr msgdb) mark-alist))
+(defsubst elmo-msgdb-set-index (msgdb index)
+ (setcar (cdddr msgdb) index))
+
+(defsubst elmo-msgdb-set-path (msgdb path)
+ (setcar (cddddr msgdb) path))
+
(defsubst elmo-msgdb-overview-entity-get-references (entity)
(and entity (aref (cdr entity) 1)))
+(defsubst elmo-msgdb-overview-entity-set-references (entity references)
+ (and entity (aset (cdr entity) 1 references))
+ entity)
+
;; entity -> parent-entity
(defsubst elmo-msgdb-overview-get-parent-entity (entity database)
(setq entity (elmo-msgdb-overview-entity-get-references entity))
;; entity is parent-id.
(and entity (assoc entity database)))
-
+
+(defsubst elmo-msgdb-get-parent-entity (entity msgdb)
+ (setq entity (elmo-msgdb-overview-entity-get-references entity))
+ ;; entity is parent-id.
+ (and entity (elmo-msgdb-overview-get-entity entity msgdb)))
+
(defsubst elmo-msgdb-overview-entity-get-number (entity)
(and entity (aref (cdr entity) 0)))
(defsubst elmo-msgdb-overview-entity-get-date (entity)
(and entity (aref (cdr entity) 4)))
+(defsubst elmo-msgdb-overview-entity-set-date (entity date)
+ (and entity (aset (cdr entity) 4 date))
+ entity)
+
(defsubst elmo-msgdb-overview-entity-get-to (entity)
(and entity (aref (cdr entity) 5)))
(and entity (car entity)))
(defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
- (let ((extra (and entity (aref (cdr entity) 8))))
+ (let ((field-name (downcase field-name))
+ (extra (and entity (aref (cdr entity) 8))))
(and extra
(cdr (assoc field-name extra)))))
-(defun elmo-msgdb-overview-get-entity-by-number (database number)
- (when number
- (let ((db database)
- entity)
- (while db
- (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
- (setq entity (car db)
- db nil) ; exit loop
- (setq db (cdr db))))
- entity)))
+(defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
+ (let ((field-name (downcase field-name))
+ (extras (and entity (aref (cdr entity) 8)))
+ extra)
+ (if (setq extra (assoc field-name extras))
+ (setcdr extra value)
+ (elmo-msgdb-overview-entity-set-extra
+ entity
+ (cons (cons field-name value) extras)))))
+
+(defsubst elmo-msgdb-overview-entity-get-extra (entity)
+ (and entity (aref (cdr entity) 8)))
+
+(defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
+ (and entity (aset (cdr entity) 8 extra))
+ entity)
+;;; New APIs
+(defsubst elmo-msgdb-message-entity (msgdb key)
+ (elmo-get-hash-val
+ (cond ((stringp key) key)
+ ((numberp key) (format "#%d" key)))
+ (elmo-msgdb-get-entity-hashtb msgdb)))
+
+(defun elmo-msgdb-make-message-entity (&rest args)
+ "Make an message entity."
+ (cons (plist-get args :message-id)
+ (vector (plist-get args :number)
+ (plist-get args :references)
+ (plist-get args :from)
+ (plist-get args :subject)
+ (plist-get args :date)
+ (plist-get args :to)
+ (plist-get args :cc)
+ (plist-get args :size)
+ (plist-get args :extra))))
+
+(defsubst elmo-msgdb-message-entity-field (entity field &optional decode)
+ (and entity
+ (let ((field-value
+ (case field
+ (to (aref (cdr entity) 5))
+ (cc (aref (cdr entity) 6))
+ (date (aref (cdr entity) 4))
+ (subject (aref (cdr entity) 3))
+ (from (aref (cdr entity) 2))
+ (message-id (car entity))
+ (references (aref (cdr entity) 1))
+ (size (aref (cdr entity) 7))
+ (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
+ (if (and decode (memq field '(from subject)))
+ (elmo-msgdb-get-decoded-cache field-value)
+ field-value))))
+
+(defsubst elmo-msgdb-message-entity-set-field (entity field value)
+ (and entity
+ (case field
+ (to (aset (cdr entity) 5 value))
+ (cc (aset (cdr entity) 6 value))
+ (date (aset (cdr entity) 4 value))
+ (subject (aset (cdr entity) 3 value))
+ (from (aset (cdr entity) 2 value))
+ (message-id (setcar entity value))
+ (references (aset (cdr entity) 1 value))
+ (size (aset (cdr entity) 7 value))
+ (t
+ (let ((extras (and entity (aref (cdr entity) 8)))
+ extra)
+ (if (setq extra (assoc field extras))
+ (setcdr extra value)
+ (aset (cdr entity) 8 (cons (cons (symbol-name field)
+ value) extras))))))))
+
+;;;
(defun elmo-msgdb-overview-get-entity (id msgdb)
(when id
- (let ((ovht (elmo-msgdb-get-overviewht msgdb)))
- (if ovht ;; use overview hash
+ (let ((ht (elmo-msgdb-get-entity-hashtb msgdb)))
+ (if ht
(if (stringp id) ;; ID is message-id
- (elmo-get-hash-val id ovht)
- (elmo-get-hash-val (format "#%d" id) ovht))
- (let* ((overview (elmo-msgdb-get-overview msgdb))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (message-id (if (stringp id)
- id ;; ID is message-id
- (cdr (assq id number-alist))))
- entity)
- (if message-id
- (assoc message-id overview)
- ;; ID is number. message-id is nil or no exists in number-alist.
- (elmo-msgdb-overview-get-entity-by-number overview id)))))))
+ (elmo-get-hash-val id ht)
+ (elmo-get-hash-val (format "#%d" id) ht))))))
;;
;; deleted message handling
(defun elmo-msgdb-set-as-killed (killed-list msg)
(elmo-number-set-append killed-list msg))
-(defun elmo-msgdb-append-to-killed-list (folder msgs)
- (let ((dir (elmo-msgdb-expand-path folder)))
- (elmo-msgdb-killed-list-save
- dir
- (elmo-number-set-append-list
- (elmo-msgdb-killed-list-load dir)
- msgs))))
-
(defun elmo-msgdb-killed-list-length (killed-list)
(let ((killed killed-list)
(ret-val 0))
(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
(defun elmo-msgdb-finfo-load ()
(elmo-object-load (expand-file-name
elmo-msgdb-finfo-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
elmo-mime-charset t))
(defun elmo-msgdb-finfo-save (finfo)
(elmo-object-save (expand-file-name
elmo-msgdb-finfo-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
finfo elmo-mime-charset))
-(defun elmo-msgdb-flist-load (folder)
+(defun elmo-msgdb-flist-load (fname)
(let ((flist-file (expand-file-name
elmo-msgdb-flist-filename
- (elmo-msgdb-expand-path (list 'folder folder)))))
- (elmo-object-load flist-file nil t)))
+ (expand-file-name
+ (elmo-safe-filename fname)
+ (expand-file-name "folder" elmo-msgdb-directory)))))
+ (elmo-object-load flist-file elmo-mime-charset t)))
-(defun elmo-msgdb-flist-save (folder flist)
+(defun elmo-msgdb-flist-save (fname flist)
(let ((flist-file (expand-file-name
elmo-msgdb-flist-filename
- (elmo-msgdb-expand-path (list 'folder folder)))))
- (elmo-object-save flist-file flist)))
+ (expand-file-name
+ (elmo-safe-filename fname)
+ (expand-file-name "folder" elmo-msgdb-directory)))))
+ (elmo-object-save flist-file flist elmo-mime-charset)))
(defun elmo-crosspost-alist-load ()
(elmo-object-load (expand-file-name
elmo-crosspost-alist-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
nil t))
(defun elmo-crosspost-alist-save (alist)
(elmo-object-save (expand-file-name
elmo-crosspost-alist-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
alist))
+(defun elmo-msgdb-get-message-id-from-buffer ()
+ (let ((msgid (elmo-field-body "message-id")))
+ (if msgid
+ (if (string-match "<\\(.+\\)>$" msgid)
+ msgid
+ (concat "<" msgid ">")) ; Invaild message-id.
+ ;; no message-id, so put dummy msgid.
+ (concat "<" (timezone-make-date-sortable
+ (elmo-field-body "date"))
+ (nth 1 (eword-extract-address-components
+ (or (elmo-field-body "from") "nobody"))) ">"))))
+
(defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
"Create overview entity from current buffer.
Header region is supposed to be narrowed."
(save-excursion
(let ((extras elmo-msgdb-extra-fields)
+ (default-mime-charset default-mime-charset)
message-id references from subject to cc date
- extra field-body)
+ extra field-body charset)
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq message-id (elmo-field-body "message-id"))
+ (setq message-id (elmo-msgdb-get-message-id-from-buffer))
+ (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
+ (setq charset (intern-soft charset))
+ (setq default-mime-charset charset))
(setq references
(or (elmo-msgdb-get-last-message-id
(elmo-field-body "in-reply-to"))
(elmo-msgdb-get-last-message-id
(elmo-field-body "references"))))
- (setq from (elmo-mime-string (elmo-delete-char
- ?\"
- (or
- (elmo-field-body "from")
- elmo-no-from))))
- (setq subject (elmo-mime-string (or (elmo-field-body "subject")
- elmo-no-subject)))
+ (setq from (elmo-replace-in-string
+ (elmo-mime-string (or (elmo-field-body "from")
+ elmo-no-from))
+ "\t" " ")
+ subject (elmo-replace-in-string
+ (elmo-mime-string (or (elmo-field-body "subject")
+ elmo-no-subject))
+ "\t" " "))
(setq date (or (elmo-field-body "date") time))
(setq to (mapconcat 'identity (elmo-multiple-field-body "to") ","))
(setq cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
from subject date to cc
size extra))
)))
-
+
+(defun elmo-msgdb-copy-overview-entity (entity)
+ (cons (car entity)
+ (copy-sequence (cdr entity))))
+
+(defsubst elmo-msgdb-insert-file-header (file)
+ "Insert the header of the article."
+ (let ((beg 0)
+ insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook
+ format-alist)
+ (when (file-exists-p file)
+ ;; Read until header separator is found.
+ (while (and (eq elmo-msgdb-file-header-chop-length
+ (nth 1
+ (insert-file-contents-as-binary
+ file nil beg
+ (incf beg elmo-msgdb-file-header-chop-length))))
+ (prog1 (not (search-forward "\n\n" nil t))
+ (goto-char (point-max))))))))
+
+(defsubst elmo-msgdb-create-overview-entity-from-file (number file)
+ (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook header-end
+ (attrib (file-attributes file))
+ ret-val size mtime)
+ (with-temp-buffer
+ (if (not (file-exists-p file))
+ ()
+ (setq size (nth 7 attrib))
+ (setq mtime (timezone-make-date-arpa-standard
+ (current-time-string (nth 5 attrib)) (current-time-zone)))
+ ;; insert header from file.
+ (catch 'done
+ (condition-case nil
+ (elmo-msgdb-insert-file-header file)
+ (error (throw 'done nil)))
+ (goto-char (point-min))
+ (setq header-end
+ (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
+ (point)
+ (point-max)))
+ (narrow-to-region (point-min) header-end)
+ (elmo-msgdb-create-overview-from-buffer number size mtime))))))
+
(defun elmo-msgdb-overview-sort-by-date (overview)
(sort overview
(function
(elmo-msgdb-overview-entity-get-date y)))
(error))))))
-(defun elmo-msgdb-sort-by-date (msgdb)
- (message "Sorting...")
- (let ((overview (elmo-msgdb-get-overview msgdb)))
- (setq overview (elmo-msgdb-overview-sort-by-date overview))
- (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)
- (let (number)
- (when (and entity
- elmo-use-overview-hashtb
- hashtb)
+(defun elmo-msgdb-clear-index (msgdb entity)
+ (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
+ (mhash (elmo-msgdb-get-mark-hashtb msgdb))
+ number)
+ (when (and entity ehash)
(and (setq number (elmo-msgdb-overview-entity-get-number entity))
- (elmo-clear-hash-val (format "#%d" number) hashtb))
+ (elmo-clear-hash-val (format "#%d" number) ehash))
(and (car entity) ;; message-id
- (elmo-clear-hash-val (car entity) hashtb)))))
-
-(defun elmo-msgdb-make-overview-hashtb (overview &optional hashtb)
- (if elmo-use-overview-hashtb
- (let ((hashtb (or hashtb ;; append
- (elmo-make-hash (length overview)))))
- (while overview
- ;; key is message-id
- (if (caar overview)
- (elmo-set-hash-val (caar overview) (car overview) hashtb))
- ;; key is number
- (elmo-set-hash-val
- (format "#%d" (elmo-msgdb-overview-entity-get-number (car overview)))
- (car overview) hashtb)
- (setq overview (cdr overview)))
- hashtb)
- nil))
-
-(defsubst elmo-msgdb-append (msgdb msgdb-append &optional set-hash)
- (list
- (nconc (car msgdb) (car msgdb-append))
- (nconc (cadr msgdb) (cadr msgdb-append))
- (nconc (caddr msgdb) (caddr msgdb-append))
- (nconc (cadddr msgdb) (cadddr msgdb-append))
- (and set-hash
- (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 4 msgdb)))))
+ (elmo-clear-hash-val (car entity) ehash)))
+ (when (and entity mhash)
+ (and (setq number (elmo-msgdb-overview-entity-get-number entity))
+ (elmo-clear-hash-val (format "#%d" number) mhash)))))
+
+(defun elmo-msgdb-make-index-return (msgdb &optional overview mark-alist)
+ "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
+If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
+Return the updated INDEX."
+ (when msgdb
+ (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
+ (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
+ (index (elmo-msgdb-get-index msgdb))
+ (ehash (or (car index) ;; append
+ (elmo-make-hash (length overview))))
+ (mhash (or (cdr index) ;; append
+ (elmo-make-hash (length overview)))))
+ (while overview
+ ;; key is message-id
+ (if (caar overview)
+ (elmo-set-hash-val (caar overview) (car overview) ehash))
+ ;; key is number
+ (elmo-set-hash-val
+ (format "#%d"
+ (elmo-msgdb-overview-entity-get-number (car overview)))
+ (car overview) ehash)
+ (setq overview (cdr overview)))
+ (while mark-alist
+ ;; key is number
+ (elmo-set-hash-val
+ (format "#%d" (car (car mark-alist)))
+ (car mark-alist) mhash)
+ (setq mark-alist (cdr mark-alist)))
+ (setq index (or index (cons ehash mhash)))
+ (elmo-msgdb-set-index msgdb index)
+ index)))
+
+(defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
+ "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
+If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
+Return a list of message numbers which have duplicated message-ids."
+ (when msgdb
+ (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
+ (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
+ (index (elmo-msgdb-get-index msgdb))
+ (ehash (or (car index) ;; append
+ (elmo-make-hash (length overview))))
+ (mhash (or (cdr index) ;; append
+ (elmo-make-hash (length overview))))
+ duplicates)
+ (while overview
+ ;; key is message-id
+ (if (elmo-get-hash-val (caar overview) ehash) ; duplicated.
+ (setq duplicates (cons
+ (elmo-msgdb-overview-entity-get-number
+ (car overview))
+ duplicates)))
+ (if (caar overview)
+ (elmo-set-hash-val (caar overview) (car overview) ehash))
+ ;; key is number
+ (elmo-set-hash-val
+ (format "#%d"
+ (elmo-msgdb-overview-entity-get-number (car overview)))
+ (car overview) ehash)
+ (setq overview (cdr overview)))
+ (while mark-alist
+ ;; key is number
+ (elmo-set-hash-val
+ (format "#%d" (car (car mark-alist)))
+ (car mark-alist) mhash)
+ (setq mark-alist (cdr mark-alist)))
+ (setq index (or index (cons ehash mhash)))
+ (elmo-msgdb-set-index msgdb index)
+ duplicates)))
+
+(defsubst elmo-folder-get-info (folder &optional hashtb)
+ (elmo-get-hash-val folder
+ (or hashtb elmo-folder-info-hashtb)))
+
+(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)))
-(defsubst elmo-msgdb-clear (&optional msgdb)
- (if msgdb
- (list
- (setcar msgdb nil)
- (setcar (cdr msgdb) nil)
- (setcar (cddr msgdb) nil)
- (setcar (cdddr msgdb) nil)
- (setcar (nthcdr 4 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
- (list nil nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
-
-(defun elmo-msgdb-delete-path (folder &optional spec)
- (let ((path (elmo-msgdb-expand-path (or spec folder))))
- (if (file-directory-p path)
- (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)))
- (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)
- (if (not (file-exists-p new-dir))
- (elmo-make-directory new-dir))
- (rename-file old new)))))
+(defsubst elmo-msgdb-location-load (dir)
+ (elmo-object-load
+ (expand-file-name
+ elmo-msgdb-location-filename
+ dir)))
+
+(defsubst elmo-msgdb-location-add (alist number location)
+ (let ((ret-val alist))
+ (setq ret-val
+ (elmo-msgdb-append-element ret-val (cons number location)))
+ ret-val))
+
+(defsubst elmo-msgdb-location-save (dir alist)
+ (elmo-object-save
+ (expand-file-name
+ elmo-msgdb-location-filename
+ dir) alist))
+
+(defun elmo-msgdb-list-flagged (msgdb flag)
+ (let ((case-fold-search nil)
+ mark-regexp matched)
+ (case flag
+ (new
+ (setq mark-regexp (regexp-quote elmo-msgdb-new-mark)))
+ (unread
+ (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks))))
+ (answered
+ (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-answered-marks))))
+ (important
+ (setq mark-regexp (regexp-quote elmo-msgdb-important-mark)))
+ (read
+ (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks))))
+ (digest
+ (setq mark-regexp (elmo-regexp-opt
+ (append (elmo-msgdb-unread-marks)
+ (list elmo-msgdb-important-mark)))))
+ (any
+ (setq mark-regexp (elmo-regexp-opt
+ (append
+ (elmo-msgdb-unread-marks)
+ (elmo-msgdb-answered-marks)
+ (list elmo-msgdb-important-mark))))))
+ (when mark-regexp
+ (if (eq flag 'read)
+ (dolist (number (elmo-msgdb-list-messages msgdb))
+ (let ((mark (elmo-msgdb-get-mark msgdb number)))
+ (unless (and mark (string-match mark-regexp mark))
+ (setq matched (cons number matched)))))
+ (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
+ (if (string-match mark-regexp (cadr elem))
+ (setq matched (cons (car elem) matched))))))
+ matched))
(require 'product)
(product-provide (provide 'elmo-msgdb) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff