elmo/modb-legacy.el

   1 ;;; modb-legacy.el --- Legacy Implement of MODB.
   2
   3 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;;      Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   7 ;; Keywords: mail, net news
   8
   9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31 ;;
  32
  33 (eval-when-compile (require 'cl))
  34
  35 (require 'elmo-util)
  36 (require 'modb)
  37
  38 ;;; legacy implement
  39 ;;
  40
  41 (defconst modb-legacy-new-mark "N"
  42   "Mark for new message.")
  43
  44 (defconst modb-legacy-unread-uncached-mark "U"
  45   "Mark for unread and uncached message.")
  46
  47 (defconst modb-legacy-unread-cached-mark "!"
  48   "Mark for unread but already cached message.")
  49
  50 (defconst modb-legacy-read-uncached-mark "u"
  51   "Mark for read but uncached message.")
  52
  53 (defconst modb-legacy-answered-cached-mark "&"
  54   "Mark for answered and cached message.")
  55
  56 (defconst modb-legacy-answered-uncached-mark "A"
  57   "Mark for answered but cached message.")
  58
  59 (defconst modb-legacy-important-mark "$"
  60   "Mark for important message.")
  61
  62 (eval-and-compile
  63   (luna-define-class modb-legacy (modb-generic)
  64                      (overview number-alist mark-alist index))
  65   (luna-define-internal-accessors 'modb-legacy))
  66
  67 ;; for internal use only
  68 (defsubst elmo-msgdb-get-overview (msgdb)
  69   (modb-legacy-overview-internal msgdb))
  70
  71 (defsubst elmo-msgdb-get-number-alist (msgdb)
  72   (modb-legacy-number-alist-internal msgdb))
  73
  74 (defsubst elmo-msgdb-get-mark-alist (msgdb)
  75   (modb-legacy-mark-alist-internal msgdb))
  76
  77 (defsubst elmo-msgdb-get-index (msgdb)
  78   (modb-legacy-index-internal msgdb))
  79
  80 (defsubst elmo-msgdb-get-entity-hashtb (msgdb)
  81   (car (modb-legacy-index-internal msgdb)))
  82
  83 (defsubst elmo-msgdb-get-mark-hashtb (msgdb)
  84   (cdr (modb-legacy-index-internal msgdb)))
  85
  86 (defsubst elmo-msgdb-get-path (msgdb)
  87   (elmo-msgdb-location msgdb))
  88
  89 (defsubst elmo-msgdb-set-overview (msgdb overview)
  90   (modb-legacy-set-overview-internal msgdb overview))
  91
  92 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
  93   (modb-legacy-set-number-alist-internal msgdb number-alist))
  94
  95 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
  96   (modb-legacy-set-mark-alist-internal msgdb mark-alist))
  97
  98 (defsubst elmo-msgdb-set-index (msgdb index)
  99   (modb-legacy-set-index-internal msgdb index))
 100
 101 (defsubst elmo-msgdb-set-path (msgdb path)
 102   (modb-generic-set-location-internal msgdb path))
 103
 104 ;;;
 105 ;; Internal use only (obsolete interface)
 106 ;;
 107 ;;
 108 ;; mime decode cache
 109 ;;
 110 (defvar elmo-msgdb-decoded-cache-hashtb nil)
 111 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
 112
 113 (defsubst elmo-msgdb-get-decoded-cache (string)
 114   (if elmo-use-decoded-cache
 115       (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
 116                         (setq elmo-msgdb-decoded-cache-hashtb
 117                               (elmo-make-hash 2048))))
 118             decoded)
 119         (or (elmo-get-hash-val string hashtb)
 120             (progn
 121               (elmo-set-hash-val
 122                string
 123                (setq decoded
 124                      (decode-mime-charset-string string elmo-mime-charset))
 125                hashtb)
 126               decoded)))
 127     (decode-mime-charset-string string elmo-mime-charset)))
 128
 129 (defsubst elmo-msgdb-overview-entity-get-id (entity)
 130   (and entity (car entity)))
 131
 132 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 133   (and entity (aref (cdr entity) 0)))
 134
 135 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 136   (and entity (aset (cdr entity) 0 number))
 137   entity)
 138
 139 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 140   (and entity (aref (cdr entity) 1)))
 141
 142 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 143   (and entity (aset (cdr entity) 1 references))
 144   entity)
 145
 146 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 147   (and entity (aref (cdr entity) 2)))
 148
 149 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 150   (and entity
 151        (aref (cdr entity) 2)
 152        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
 153
 154 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 155   (and entity (aset (cdr entity) 2 from))
 156   entity)
 157
 158 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 159   (and entity
 160        (aref (cdr entity) 3)
 161        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
 162
 163 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 164   (and entity (aref (cdr entity) 3)))
 165
 166 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 167   (and entity (aset (cdr entity) 3 subject))
 168   entity)
 169
 170 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 171   (and entity (aref (cdr entity) 4)))
 172
 173 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
 174   (and entity (aset (cdr entity) 4 date))
 175   entity)
 176
 177 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 178   (and entity (aref (cdr entity) 5)))
 179
 180 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 181   (and entity (aref (cdr entity) 6)))
 182
 183 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 184   (and entity (aref (cdr entity) 7)))
 185
 186 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 187   (and entity (aset (cdr entity) 7 size))
 188   entity)
 189
 190 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 191   (and entity (aref (cdr entity) 8)))
 192
 193 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 194   (and entity (aset (cdr entity) 8 extra))
 195   entity)
 196
 197 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
 198   (let ((field-name (downcase field-name))
 199         (extra (and entity (aref (cdr entity) 8))))
 200     (and extra
 201          (cdr (assoc field-name extra)))))
 202
 203 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
 204   (let ((field-name (downcase field-name))
 205         (extras (and entity (aref (cdr entity) 8)))
 206         extra)
 207     (if (setq extra (assoc field-name extras))
 208         (setcdr extra value)
 209       (elmo-msgdb-overview-entity-set-extra
 210        entity
 211        (cons (cons field-name value) extras)))))
 212
 213 ;;; load & save
 214 (defun elmo-msgdb-number-load (dir)
 215   (elmo-object-load
 216    (expand-file-name elmo-msgdb-number-filename dir)))
 217
 218 (defun elmo-msgdb-overview-load (dir)
 219   (elmo-object-load
 220    (expand-file-name elmo-msgdb-overview-filename dir)))
 221
 222 (defun elmo-msgdb-mark-load (dir)
 223   (elmo-object-load
 224    (expand-file-name elmo-msgdb-mark-filename dir)))
 225
 226 (defun elmo-msgdb-number-save (dir obj)
 227   (elmo-object-save
 228    (expand-file-name elmo-msgdb-number-filename dir)
 229    obj))
 230
 231 (defun elmo-msgdb-mark-save (dir obj)
 232   (elmo-object-save
 233    (expand-file-name elmo-msgdb-mark-filename dir)
 234    obj))
 235
 236 (defsubst elmo-msgdb-overview-save (dir overview)
 237   (elmo-object-save
 238    (expand-file-name elmo-msgdb-overview-filename dir)
 239    overview))
 240
 241 ;;;
 242
 243
 244 (defvar modb-legacy-unread-marks-internal nil)
 245 (defsubst modb-legacy-unread-marks ()
 246   "Return an unread mark list"
 247   (or modb-legacy-unread-marks-internal
 248       (setq modb-legacy-unread-marks-internal
 249             (list modb-legacy-new-mark
 250                   modb-legacy-unread-uncached-mark
 251                   modb-legacy-unread-cached-mark))))
 252
 253 (defvar modb-legacy-answered-marks-internal nil)
 254 (defsubst modb-legacy-answered-marks ()
 255   "Return an answered mark list"
 256   (or modb-legacy-answered-marks-internal
 257       (setq modb-legacy-answered-marks-internal
 258             (list modb-legacy-answered-cached-mark
 259                   modb-legacy-answered-uncached-mark))))
 260
 261 (defvar modb-legacy-uncached-marks-internal nil)
 262 (defsubst modb-legacy-uncached-marks ()
 263   (or modb-legacy-uncached-marks-internal
 264       (setq modb-legacy-uncached-marks-internal
 265             (list modb-legacy-new-mark
 266                   modb-legacy-answered-uncached-mark
 267                   modb-legacy-unread-uncached-mark
 268                   modb-legacy-read-uncached-mark))))
 269
 270 (defsubst modb-legacy-mark-to-flags (mark)
 271   (append
 272    (and (string= mark modb-legacy-new-mark)
 273         '(new))
 274    (and (string= mark modb-legacy-important-mark)
 275         '(important))
 276    (and (member mark (modb-legacy-unread-marks))
 277         '(unread))
 278    (and (member mark (modb-legacy-answered-marks))
 279         '(answered))
 280    (and (not (member mark (modb-legacy-uncached-marks)))
 281         '(cached))))
 282
 283 (defsubst modb-legacy-flags-to-mark (flags)
 284   (cond ((memq 'new flags)
 285          modb-legacy-new-mark)
 286         ((memq 'important flags)
 287          modb-legacy-important-mark)
 288         ((memq 'answered flags)
 289          (if (memq 'cached flags)
 290              modb-legacy-answered-cached-mark
 291            modb-legacy-answered-uncached-mark))
 292         ((memq 'unread flags)
 293          (if (memq 'cached flags)
 294              modb-legacy-unread-cached-mark
 295            modb-legacy-unread-uncached-mark))
 296         (t
 297          (if (memq 'cached flags)
 298              nil
 299            modb-legacy-read-uncached-mark))))
 300
 301 (defsubst elmo-msgdb-get-mark (msgdb number)
 302   "Get mark string from MSGDB which corresponds to the message with NUMBER."
 303   (cadr (elmo-get-hash-val (format "#%d" number)
 304                            (elmo-msgdb-get-mark-hashtb msgdb))))
 305
 306 (defsubst elmo-msgdb-set-mark (msgdb number mark)
 307   "Set MARK of the message with NUMBER in the MSGDB.
 308 if MARK is nil, mark is removed."
 309   (let ((elem (elmo-get-hash-val (format "#%d" number)
 310                                  (elmo-msgdb-get-mark-hashtb msgdb))))
 311     (if elem
 312         (if mark
 313             ;; Set mark of the elem
 314             (setcar (cdr elem) mark)
 315           ;; Delete elem from mark-alist
 316           (elmo-msgdb-set-mark-alist
 317            msgdb
 318            (delq elem (elmo-msgdb-get-mark-alist msgdb)))
 319           (elmo-clear-hash-val (format "#%d" number)
 320                                (elmo-msgdb-get-mark-hashtb msgdb)))
 321       (when mark
 322         ;; Append new element.
 323         (elmo-msgdb-set-mark-alist
 324          msgdb
 325          (nconc
 326           (elmo-msgdb-get-mark-alist msgdb)
 327           (list (setq elem (list number mark)))))
 328         (elmo-set-hash-val (format "#%d" number) elem
 329                            (elmo-msgdb-get-mark-hashtb msgdb))))
 330     (modb-generic-set-flag-modified-internal msgdb t)
 331     ;; return value.
 332     t))
 333
 334 (defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
 335   "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
 336 If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
 337 Return a list of message numbers which have duplicated message-ids."
 338   (when msgdb
 339     (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
 340            (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
 341            (index (elmo-msgdb-get-index msgdb))
 342            (ehash (or (car index) ;; append
 343                       (elmo-make-hash (length overview))))
 344            (mhash (or (cdr index) ;; append
 345                       (elmo-make-hash (length overview))))
 346            duplicates)
 347       (while overview
 348         ;; key is message-id
 349         (if (elmo-get-hash-val (caar overview) ehash) ; duplicated.
 350             (setq duplicates (cons
 351                               (elmo-msgdb-overview-entity-get-number
 352                                (car overview))
 353                               duplicates)))
 354         (if (caar overview)
 355             (elmo-set-hash-val (caar overview) (car overview) ehash))
 356         ;; key is number
 357         (elmo-set-hash-val
 358          (format "#%d"
 359                  (elmo-msgdb-overview-entity-get-number (car overview)))
 360          (car overview) ehash)
 361         (setq overview (cdr overview)))
 362       (while mark-alist
 363         ;; key is number
 364         (elmo-set-hash-val
 365          (format "#%d" (car (car mark-alist)))
 366          (car mark-alist) mhash)
 367         (setq mark-alist (cdr mark-alist)))
 368       (setq index (or index (cons ehash mhash)))
 369       (elmo-msgdb-set-index msgdb index)
 370       duplicates)))
 371
 372 (defun elmo-msgdb-clear-index (msgdb entity)
 373   (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
 374         (mhash (elmo-msgdb-get-mark-hashtb msgdb))
 375         number)
 376     (when (and entity ehash)
 377       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 378            (elmo-clear-hash-val (format "#%d" number) ehash))
 379       (and (car entity) ;; message-id
 380            (elmo-clear-hash-val (car entity) ehash)))
 381     (when (and entity mhash)
 382       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 383            (elmo-clear-hash-val (format "#%d" number) mhash)))))
 384
 385 ;;; Implement
 386 ;;
 387 (luna-define-method elmo-msgdb-load ((msgdb modb-legacy))
 388   (let ((inhibit-quit t)
 389         (path (elmo-msgdb-location msgdb)))
 390     (when (file-exists-p (expand-file-name elmo-msgdb-mark-filename path))
 391       (modb-legacy-set-overview-internal
 392        msgdb
 393        (elmo-msgdb-overview-load path))
 394       (modb-legacy-set-number-alist-internal
 395        msgdb
 396        (elmo-msgdb-number-load path))
 397       (modb-legacy-set-mark-alist-internal
 398        msgdb
 399        (elmo-msgdb-mark-load path))
 400       (elmo-msgdb-make-index msgdb)
 401       t)))
 402
 403 (luna-define-method elmo-msgdb-save ((msgdb modb-legacy))
 404   (let ((path (elmo-msgdb-location msgdb)))
 405     (when (elmo-msgdb-message-modified-p msgdb)
 406       (elmo-msgdb-overview-save
 407        path
 408        (modb-legacy-overview-internal msgdb))
 409       (elmo-msgdb-number-save
 410        path
 411        (modb-legacy-number-alist-internal msgdb))
 412       (modb-generic-set-message-modified-internal msgdb nil))
 413     (when (elmo-msgdb-flag-modified-p msgdb)
 414       (elmo-msgdb-mark-save
 415        path
 416        (modb-legacy-mark-alist-internal msgdb))
 417       (modb-generic-set-flag-modified-internal msgdb nil))))
 418
 419 (luna-define-method elmo-msgdb-append :around ((msgdb modb-legacy)
 420                                                msgdb-append)
 421   (if (eq (luna-class-name msgdb-append)
 422           'modb-legacy)
 423       (let (duplicates)
 424         (elmo-msgdb-set-overview
 425          msgdb
 426          (nconc (elmo-msgdb-get-overview msgdb)
 427                 (elmo-msgdb-get-overview msgdb-append)))
 428         (elmo-msgdb-set-number-alist
 429          msgdb
 430          (nconc (elmo-msgdb-get-number-alist msgdb)
 431                 (elmo-msgdb-get-number-alist msgdb-append)))
 432         (elmo-msgdb-set-mark-alist
 433          msgdb
 434          (nconc (elmo-msgdb-get-mark-alist msgdb)
 435                 (elmo-msgdb-get-mark-alist msgdb-append)))
 436         (setq duplicates (elmo-msgdb-make-index
 437                           msgdb
 438                           (elmo-msgdb-get-overview msgdb-append)
 439                           (elmo-msgdb-get-mark-alist msgdb-append)))
 440         (elmo-msgdb-set-path
 441          msgdb
 442          (or (elmo-msgdb-get-path msgdb)
 443              (elmo-msgdb-get-path msgdb-append)))
 444         (modb-generic-set-message-modified-internal msgdb t)
 445         (modb-generic-set-flag-modified-internal msgdb t)
 446         duplicates)
 447     (luna-call-next-method)))
 448
 449 (luna-define-method elmo-msgdb-clear :after ((msgdb modb-legacy))
 450   (elmo-msgdb-set-overview msgdb nil)
 451   (elmo-msgdb-set-number-alist msgdb nil)
 452   (elmo-msgdb-set-mark-alist msgdb nil)
 453   (elmo-msgdb-set-index msgdb nil))
 454
 455 (luna-define-method elmo-msgdb-length ((msgdb modb-legacy))
 456   (length (modb-legacy-overview-internal msgdb)))
 457
 458 (luna-define-method elmo-msgdb-flags ((msgdb modb-legacy) number)
 459   (modb-legacy-mark-to-flags (elmo-msgdb-get-mark msgdb number)))
 460
 461 (luna-define-method elmo-msgdb-set-flag ((msgdb modb-legacy)
 462                                          number flag)
 463   (case flag
 464     (read
 465      (elmo-msgdb-unset-flag msgdb number 'unread))
 466     (uncached
 467      (elmo-msgdb-unset-flag msgdb number 'cached))
 468     (t
 469      (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
 470             (flags (modb-legacy-mark-to-flags cur-mark))
 471             new-mark)
 472        (and (memq 'new flags)
 473             (setq flags (delq 'new flags)))
 474        (or (memq flag flags)
 475            (setq flags (cons flag flags)))
 476        (when (and (eq flag 'unread)
 477                   (memq 'answered flags))
 478          (setq flags (delq 'answered flags)))
 479        (setq new-mark (modb-legacy-flags-to-mark flags))
 480        (unless (string= new-mark cur-mark)
 481          (elmo-msgdb-set-mark msgdb number new-mark))))))
 482
 483 (luna-define-method elmo-msgdb-unset-flag ((msgdb modb-legacy)
 484                                            number flag)
 485   (case flag
 486     (read
 487      (elmo-msgdb-set-flag msgdb number 'unread))
 488     (uncached
 489      (elmo-msgdb-set-flag msgdb number 'cached))
 490     (t
 491      (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
 492             (flags (modb-legacy-mark-to-flags cur-mark))
 493             new-mark)
 494        (and (memq 'new flags)
 495             (setq flags (delq 'new flags)))
 496        (and (memq flag flags)
 497             (setq flags (delq flag flags)))
 498        (when (and (eq flag 'unread)
 499                   (memq 'answered flags))
 500          (setq flags (delq 'answered flags)))
 501        (setq new-mark (modb-legacy-flags-to-mark flags))
 502        (unless (string= new-mark cur-mark)
 503          (elmo-msgdb-set-mark msgdb number new-mark))))))
 504
 505 (luna-define-method elmo-msgdb-list-messages ((msgdb modb-legacy))
 506   (mapcar 'elmo-msgdb-overview-entity-get-number
 507           (elmo-msgdb-get-overview msgdb)))
 508
 509 (luna-define-method elmo-msgdb-list-flagged ((msgdb modb-legacy) flag)
 510   (let ((case-fold-search nil)
 511         mark-regexp matched)
 512     (case flag
 513       (new
 514        (setq mark-regexp (regexp-quote modb-legacy-new-mark)))
 515       (unread
 516        (setq mark-regexp (elmo-regexp-opt (modb-legacy-unread-marks))))
 517       (answered
 518        (setq mark-regexp (elmo-regexp-opt (modb-legacy-answered-marks))))
 519       (important
 520        (setq mark-regexp (regexp-quote modb-legacy-important-mark)))
 521       (read
 522        (setq mark-regexp (elmo-regexp-opt (modb-legacy-unread-marks))))
 523       (digest
 524        (setq mark-regexp (elmo-regexp-opt
 525                           (append (modb-legacy-unread-marks)
 526                                   (list modb-legacy-important-mark)))))
 527       (any
 528        (setq mark-regexp (elmo-regexp-opt
 529                           (append
 530                            (modb-legacy-unread-marks)
 531                            (modb-legacy-answered-marks)
 532                            (list modb-legacy-important-mark))))))
 533     (when mark-regexp
 534       (if (eq flag 'read)
 535           (dolist (number (elmo-msgdb-list-messages msgdb))
 536             (let ((mark (elmo-msgdb-get-mark msgdb number)))
 537               (unless (and mark (string-match mark-regexp mark))
 538                 (setq matched (cons number matched)))))
 539         (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
 540           (if (string-match mark-regexp (cadr elem))
 541               (setq matched (cons (car elem) matched))))))
 542     matched))
 543
 544 (luna-define-method elmo-msgdb-append-entity ((msgdb modb-legacy)
 545                                               entity &optional flags)
 546   (when entity
 547     (let ((number (elmo-msgdb-overview-entity-get-number entity))
 548           (message-id (elmo-msgdb-overview-entity-get-id entity))
 549           mark)
 550       (elmo-msgdb-set-overview
 551        msgdb
 552        (nconc (elmo-msgdb-get-overview msgdb)
 553               (list entity)))
 554       (elmo-msgdb-set-number-alist
 555        msgdb
 556        (nconc (elmo-msgdb-get-number-alist msgdb)
 557               (list (cons number message-id))))
 558       (modb-generic-set-message-modified-internal msgdb t)
 559       (when (setq mark (modb-legacy-flags-to-mark flags))
 560         (elmo-msgdb-set-mark-alist
 561          msgdb
 562          (nconc (elmo-msgdb-get-mark-alist msgdb)
 563                 (list (list number mark))))
 564         (modb-generic-set-flag-modified-internal msgdb t))
 565       (elmo-msgdb-make-index
 566        msgdb
 567        (list entity)
 568        (list (list number mark))))))
 569
 570 (luna-define-method elmo-msgdb-delete-messages ((msgdb modb-legacy)
 571                                                 numbers)
 572   (let* ((overview (elmo-msgdb-get-overview msgdb))
 573          (number-alist (elmo-msgdb-get-number-alist msgdb))
 574          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
 575          (index (elmo-msgdb-get-index msgdb))
 576          ov-entity)
 577     ;; remove from current database.
 578     (dolist (number numbers)
 579       (setq overview
 580             (delq
 581              (setq ov-entity
 582                    (elmo-msgdb-message-entity msgdb number))
 583              overview))
 584       (setq number-alist (delq (assq number number-alist) number-alist))
 585       (setq mark-alist (delq (assq number mark-alist) mark-alist))
 586       ;;
 587       (when index (elmo-msgdb-clear-index msgdb ov-entity)))
 588     (elmo-msgdb-set-overview msgdb overview)
 589     (elmo-msgdb-set-number-alist msgdb number-alist)
 590     (elmo-msgdb-set-mark-alist msgdb mark-alist)
 591     (elmo-msgdb-set-index msgdb index)
 592     (modb-generic-set-message-modified-internal msgdb t)
 593     (modb-generic-set-flag-modified-internal msgdb t)
 594     t)) ;return value
 595
 596 (luna-define-method elmo-msgdb-sort-entities ((msgdb modb-legacy)
 597                                               predicate &optional app-data)
 598   (message "Sorting...")
 599   (let ((overview (elmo-msgdb-get-overview msgdb)))
 600     (elmo-msgdb-set-overview
 601      msgdb
 602      (sort overview (lambda (a b) (funcall predicate a b app-data))))
 603     (message "Sorting...done")
 604     msgdb))
 605
 606 (luna-define-method elmo-msgdb-message-entity ((msgdb modb-legacy) key)
 607   (elmo-get-hash-val
 608    (cond ((stringp key) key)
 609          ((numberp key) (format "#%d" key)))
 610    (elmo-msgdb-get-entity-hashtb msgdb)))
 611
 612 ;;; Message entity handling.
 613 (defsubst modb-legacy-make-message-entity (args)
 614   "Make an message entity."
 615   (cons (plist-get args :message-id)
 616         (vector (plist-get args :number)
 617                 (plist-get args :references)
 618                 (plist-get args :from)
 619                 (plist-get args :subject)
 620                 (plist-get args :date)
 621                 (plist-get args :to)
 622                 (plist-get args :cc)
 623                 (plist-get args :size)
 624                 (plist-get args :extra))))
 625
 626 (luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-legacy)
 627                                                     args)
 628   (modb-legacy-make-message-entity args))
 629
 630 (defsubst elmo-msgdb-insert-file-header (file)
 631   "Insert the header of the article."
 632   (let ((beg 0)
 633         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 634         insert-file-contents-post-hook
 635         format-alist)
 636     (when (file-exists-p file)
 637       ;; Read until header separator is found.
 638       (while (and (eq elmo-msgdb-file-header-chop-length
 639                       (nth 1
 640                            (insert-file-contents-as-binary
 641                             file nil beg
 642                             (incf beg elmo-msgdb-file-header-chop-length))))
 643                   (prog1 (not (search-forward "\n\n" nil t))
 644                     (goto-char (point-max))))))))
 645
 646 (luna-define-method elmo-msgdb-create-message-entity-from-file
 647   ((msgdb modb-legacy) number file)
 648   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 649         insert-file-contents-post-hook header-end
 650         (attrib (file-attributes file))
 651         ret-val size mtime)
 652     (with-temp-buffer
 653       (if (not (file-exists-p file))
 654           ()
 655         (setq size (nth 7 attrib))
 656         (setq mtime (timezone-make-date-arpa-standard
 657                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 658         ;; insert header from file.
 659         (catch 'done
 660           (condition-case nil
 661               (elmo-msgdb-insert-file-header file)
 662             (error (throw 'done nil)))
 663           (goto-char (point-min))
 664           (setq header-end
 665                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 666                     (point)
 667                   (point-max)))
 668           (narrow-to-region (point-min) header-end)
 669           (elmo-msgdb-create-message-entity-from-buffer
 670            msgdb number :size size :date mtime))))))
 671
 672 (luna-define-method elmo-msgdb-create-message-entity-from-buffer
 673   ((msgdb modb-legacy) number args)
 674   (let ((extras elmo-msgdb-extra-fields)
 675         (default-mime-charset default-mime-charset)
 676         entity message-id references from subject to cc date
 677         extra field-body charset size)
 678     (save-excursion
 679       (setq entity (modb-legacy-make-message-entity args))
 680       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 681       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
 682       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
 683            (setq charset (intern-soft charset))
 684            (setq default-mime-charset charset))
 685       (setq references
 686             (or (elmo-msgdb-get-last-message-id
 687                  (elmo-field-body "in-reply-to"))
 688                 (elmo-msgdb-get-last-message-id
 689                  (elmo-field-body "references")))
 690             from (elmo-replace-in-string
 691                   (elmo-mime-string (or (elmo-field-body "from")
 692                                         elmo-no-from))
 693                   "\t" " ")
 694             subject (elmo-replace-in-string
 695                      (elmo-mime-string (or (elmo-field-body "subject")
 696                                            elmo-no-subject))
 697                      "\t" " ")
 698             date (elmo-field-body "date")
 699             to   (mapconcat 'identity (elmo-multiple-field-body "to") ",")
 700             cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 701       (unless (elmo-msgdb-message-entity-field msgdb entity 'size)
 702         (if (setq size (elmo-field-body "content-length"))
 703             (setq size (string-to-int size))
 704           (setq size 0)))
 705       (while extras
 706         (if (setq field-body (elmo-field-body (car extras)))
 707             (elmo-msgdb-message-entity-set-field
 708              msgdb entity (intern (downcase (car extras))) field-body))
 709         (setq extras (cdr extras)))
 710       (dolist (field '(message-id number references from subject
 711                                   date to cc size))
 712         (when (symbol-value field)
 713           (elmo-msgdb-message-entity-set-field
 714            msgdb entity field (symbol-value field))))
 715       entity)))
 716
 717 ;;; Message entity interface
 718 ;;
 719 (luna-define-method elmo-msgdb-message-entity-number ((msgdb modb-legacy)
 720                                                       entity)
 721   (and entity (aref (cdr entity) 0)))
 722
 723 (luna-define-method elmo-msgdb-message-entity-set-number ((msgdb modb-legacy)
 724                                                           entity
 725                                                           number)
 726   (and entity (aset (cdr entity) 0 number))
 727   entity)
 728
 729 (luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-legacy)
 730                                                      entity field
 731                                                      &optional decode)
 732   (and entity
 733        (let ((field-value
 734               (case field
 735                 (to (aref (cdr entity) 5))
 736                 (cc (aref (cdr entity) 6))
 737                 (date (aref (cdr entity) 4))
 738                 (subject (aref (cdr entity) 3))
 739                 (from (aref (cdr entity) 2))
 740                 (message-id (car entity))
 741                 (references (aref (cdr entity) 1))
 742                 (size (aref (cdr entity) 7))
 743                 (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
 744          (if (and decode (memq field '(from subject)))
 745              (elmo-msgdb-get-decoded-cache field-value)
 746            field-value))))
 747
 748 (luna-define-method elmo-msgdb-message-entity-set-field ((msgdb modb-legacy)
 749                                                          entity field value)
 750   (and entity
 751        (case field
 752          (number (aset (cdr entity) 0 value))
 753          (to (aset (cdr entity) 5 value))
 754          (cc (aset (cdr entity) 6 value))
 755          (date (aset (cdr entity) 4 value))
 756          (subject (aset (cdr entity) 3 value))
 757          (from (aset (cdr entity) 2 value))
 758          (message-id (setcar entity value))
 759          (references (aset (cdr entity) 1 value))
 760          (size (aset (cdr entity) 7 value))
 761          (t
 762           (let ((extras (and entity (aref (cdr entity) 8)))
 763                 extra)
 764             (if (setq extra (assoc (symbol-name field) extras))
 765                 (setcdr extra value)
 766               (aset (cdr entity) 8 (cons (cons (symbol-name field)
 767                                                value) extras))))))))
 768
 769 (luna-define-method elmo-msgdb-copy-message-entity ((msgdb modb-legacy)
 770                                                     entity)
 771   (cons (car entity)
 772         (copy-sequence (cdr entity))))
 773
 774 (luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-legacy)
 775                                                          condition
 776                                                          entity flags numbers)
 777   (cond
 778    ((vectorp condition)
 779     (elmo-msgdb-match-condition-primitive condition entity flags numbers))
 780    ((eq (car condition) 'and)
 781     (let ((lhs (elmo-msgdb-match-condition-internal msgdb
 782                                                     (nth 1 condition)
 783                                                     entity flags numbers)))
 784       (cond
 785        ((elmo-filter-condition-p lhs)
 786         (let ((rhs (elmo-msgdb-match-condition-internal
 787                     msgdb (nth 2 condition) entity flags numbers)))
 788           (cond ((elmo-filter-condition-p rhs)
 789                  (list 'and lhs rhs))
 790                 (rhs
 791                  lhs))))
 792        (lhs
 793         (elmo-msgdb-match-condition-internal msgdb (nth 2 condition)
 794                                              entity flags numbers)))))
 795    ((eq (car condition) 'or)
 796     (let ((lhs (elmo-msgdb-match-condition-internal msgdb (nth 1 condition)
 797                                                     entity flags numbers)))
 798       (cond
 799        ((elmo-filter-condition-p lhs)
 800         (let ((rhs (elmo-msgdb-match-condition-internal msgdb
 801                                                         (nth 2 condition)
 802                                                         entity flags numbers)))
 803           (cond ((elmo-filter-condition-p rhs)
 804                  (list 'or lhs rhs))
 805                 (rhs
 806                  t)
 807                 (t
 808                  lhs))))
 809        (lhs
 810         t)
 811        (t
 812         (elmo-msgdb-match-condition-internal msgdb
 813                                              (nth 2 condition)
 814                                              entity flags numbers)))))))
 815
 816 ;;
 817 (defun elmo-msgdb-match-condition-primitive (condition entity flags numbers)
 818   (catch 'unresolved
 819     (let ((key (elmo-filter-key condition))
 820           (case-fold-search t)
 821           result)
 822       (cond
 823        ((string= key "last")
 824         (setq result (<= (length (memq
 825                                   (elmo-msgdb-overview-entity-get-number
 826                                    entity)
 827                                   numbers))
 828                          (string-to-int (elmo-filter-value condition)))))
 829        ((string= key "first")
 830         (setq result (< (-
 831                          (length numbers)
 832                          (length (memq
 833                                   (elmo-msgdb-overview-entity-get-number
 834                                    entity)
 835                                   numbers)))
 836                         (string-to-int (elmo-filter-value condition)))))
 837        ((string= key "flag")
 838         (setq result
 839               (cond
 840                ((string= (elmo-filter-value condition) "any")
 841                 (or (memq 'important flags)
 842                     (memq 'answered flags)
 843                     (memq 'unread flags)))
 844                ((string= (elmo-filter-value condition) "digest")
 845                 (or (memq 'important flags)
 846                     (memq 'unread flags)))
 847                ((string= (elmo-filter-value condition) "unread")
 848                 (memq 'unread flags))
 849                ((string= (elmo-filter-value condition) "important")
 850                 (memq 'important flags))
 851                ((string= (elmo-filter-value condition) "answered")
 852                 (memq 'answered flags)))))
 853        ((string= key "from")
 854         (setq result (string-match
 855                       (elmo-filter-value condition)
 856                       (elmo-msgdb-overview-entity-get-from entity))))
 857        ((string= key "subject")
 858         (setq result (string-match
 859                       (elmo-filter-value condition)
 860                       (elmo-msgdb-overview-entity-get-subject entity))))
 861        ((string= key "to")
 862         (setq result (string-match
 863                       (elmo-filter-value condition)
 864                       (elmo-msgdb-overview-entity-get-to entity))))
 865        ((string= key "cc")
 866         (setq result (string-match
 867                       (elmo-filter-value condition)
 868                       (elmo-msgdb-overview-entity-get-cc entity))))
 869        ((or (string= key "since")
 870             (string= key "before"))
 871         (let ((field-date (elmo-date-make-sortable-string
 872                            (timezone-fix-time
 873                             (elmo-msgdb-overview-entity-get-date entity)
 874                             (current-time-zone) nil)))
 875               (specified-date
 876                (elmo-date-make-sortable-string
 877                 (elmo-date-get-datevec
 878                  (elmo-filter-value condition)))))
 879           (setq result (if (string= key "since")
 880                            (or (string= specified-date field-date)
 881                                (string< specified-date field-date))
 882                          (string< field-date specified-date)))))
 883        ((member key elmo-msgdb-extra-fields)
 884         (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
 885           (when (stringp extval)
 886             (setq result (string-match
 887                           (elmo-filter-value condition)
 888                           extval)))))
 889        (t
 890         (throw 'unresolved condition)))
 891       (if (eq (elmo-filter-type condition) 'unmatch)
 892           (not result)
 893         result))))
 894
 895 (require 'product)
 896 (product-provide (provide 'modb-legacy) (require 'elmo-version))
 897
 898 ;;; modb-legacy.el ends here