elmo/elmo-msgdb.el

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