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 'mime)
  40 (require 'modb)
  41 (require 'modb-entity)
  42
  43 ;;; MSGDB interface.
  44 ;;
  45 ;; MSGDB elmo-load-msgdb PATH
  46
  47 ;; NUMBER elmo-msgdb-get-number MSGDB MESSAGE-ID
  48 ;; FIELD-VALUE elmo-msgdb-get-field MSGDB NUMBER FIELD
  49 ;; elmo-msgdb-sort-by-date MSGDB
  50
  51 ;; elmo-flag-table-load
  52 ;; elmo-flag-table-set
  53 ;; elmo-flag-table-get
  54 ;; elmo-flag-table-save
  55
  56 ;; elmo-msgdb-overview-save DIR OBJ
  57
  58 ;;; Abolish
  59 ;; elmo-msgdb-get-parent-entity ENTITY MSGDB
  60
  61 ;; elmo-msgdb-killed-list-load DIR
  62 ;; elmo-msgdb-killed-list-save DIR
  63 ;; elmo-msgdb-append-to-killed-list FOLDER MSG
  64 ;; elmo-msgdb-killed-list-length KILLED-LIST
  65 ;; elmo-msgdb-max-of-killed KILLED-LIST
  66 ;; elmo-msgdb-killed-message-p KILLED-LIST MSG
  67 ;; elmo-living-messages MESSAGES KILLED-LIST
  68
  69 ;; elmo-msgdb-finfo-load
  70 ;; elmo-msgdb-finfo-save
  71 ;; elmo-msgdb-flist-load
  72 ;; elmo-msgdb-flist-save
  73
  74 ;; elmo-crosspost-alist-load
  75 ;; elmo-crosspost-alist-save
  76
  77 ;; elmo-msgdb-create-overview-from-buffer NUMBER SIZE TIME
  78 ;; elmo-msgdb-create-overview-entity-from-file NUMBER FILE
  79
  80 ;; elmo-folder-get-info
  81 ;; elmo-folder-get-info-max
  82 ;; elmo-folder-get-info-length
  83 ;; elmo-folder-get-info-unread
  84
  85 ;;; Helper functions for MSGDB
  86 ;;
  87 (defun elmo-load-msgdb (location)
  88   "Load the MSGDB from PATH."
  89   (let ((msgdb (elmo-make-msgdb location)))
  90     (elmo-msgdb-load msgdb)
  91     msgdb))
  92
  93 (defun elmo-make-msgdb (&optional location type)
  94   "Make a MSGDB."
  95   (let* ((type (or type elmo-msgdb-default-type))
  96          (class (intern (format "modb-%s" type))))
  97     (require class)
  98     (luna-make-entity class
  99                       :location location)))
 100
 101 (defsubst elmo-msgdb-get-number (msgdb message-id)
 102   "Get number of the message which corrensponds to MESSAGE-ID from MSGDB."
 103   (elmo-msgdb-overview-entity-get-number
 104    (elmo-msgdb-message-entity msgdb message-id)))
 105
 106 (defsubst elmo-msgdb-get-field (msgdb number field)
 107   "Get FIELD value of the message with NUMBER from MSGDB."
 108   (case field
 109     (message-id (elmo-msgdb-overview-entity-get-id
 110                  (elmo-msgdb-message-entity
 111                   msgdb number)))
 112     (subject (elmo-msgdb-overview-entity-get-subject
 113               (elmo-msgdb-message-entity
 114                msgdb number)))
 115     (size (elmo-msgdb-overview-entity-get-size
 116            (elmo-msgdb-message-entity
 117             msgdb number)))
 118     (date (elmo-msgdb-overview-entity-get-date
 119            (elmo-msgdb-message-entity
 120             msgdb number)))
 121     (to (elmo-msgdb-overview-entity-get-to
 122          (elmo-msgdb-message-entity
 123           msgdb number)))
 124     (cc (elmo-msgdb-overview-entity-get-cc
 125          (elmo-msgdb-message-entity
 126           msgdb number)))))
 127
 128 (defun elmo-msgdb-sort-by-date (msgdb)
 129   (elmo-msgdb-sort-entities
 130    msgdb
 131    (lambda (x y app-data)
 132      (condition-case nil
 133          (string<
 134           (timezone-make-date-sortable
 135            (elmo-msgdb-overview-entity-get-date x))
 136           (timezone-make-date-sortable
 137            (elmo-msgdb-overview-entity-get-date y)))
 138        (error)))))
 139
 140 ;;;
 141 (defsubst elmo-msgdb-append-element (list element)
 142   (if list
 143 ;;;   (append list (list element))
 144       (nconc list (list element))
 145     ;; list is nil
 146     (list element)))
 147
 148 ;;
 149 ;; number <-> Message-ID handling
 150 ;;
 151 (defsubst elmo-msgdb-number-add (alist number id)
 152   (let ((ret-val alist))
 153     (setq ret-val
 154           (elmo-msgdb-append-element ret-val (cons number id)))
 155     ret-val))
 156
 157 ;;; flag table
 158 ;;
 159 (defvar elmo-flag-table-filename "flag-table")
 160 (defun elmo-flag-table-load (dir)
 161   "Load flag hashtable for MSGDB."
 162   (let ((table (elmo-make-hash))
 163         ;; For backward compatibility
 164         (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
 165         value)
 166     (when (file-exists-p seen-file)
 167       (dolist (msgid (elmo-object-load seen-file))
 168         (elmo-set-hash-val msgid '(read) table))
 169       (delete-file seen-file))
 170     (dolist (pair (elmo-object-load
 171                    (expand-file-name elmo-flag-table-filename dir)))
 172       (setq value (cdr pair))
 173       (elmo-set-hash-val (car pair)
 174                          (cond ((consp value)
 175                                 value)
 176                                ;; Following cases for backward compatibility.
 177                                (value
 178                                 (list value))
 179                                (t
 180                                 '(unread)))
 181                          table))
 182     table))
 183
 184 (defun elmo-flag-table-set (flag-table msg-id flags)
 185   (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
 186
 187 (defun elmo-flag-table-get (flag-table msg-id)
 188   (let ((flags (elmo-get-hash-val msg-id flag-table)))
 189     (if flags
 190         (append
 191          (and (elmo-file-cache-exists-p msg-id)
 192               '(cached))
 193          (elmo-list-delete '(cached read)
 194                            (copy-sequence flags)
 195                            #'delq))
 196       '(new unread))))
 197
 198 (defun elmo-flag-table-save (dir flag-table)
 199   (elmo-object-save
 200    (expand-file-name elmo-flag-table-filename dir)
 201    (if flag-table
 202        (let (list)
 203          (mapatoms (lambda (atom)
 204                      (setq list (cons (cons (symbol-name atom)
 205                                             (symbol-value atom))
 206                                       list)))
 207                    flag-table)
 208          list))))
 209 ;;;
 210 ;; persistent mark handling
 211 ;; (for each folder)
 212
 213 (defun elmo-msgdb-mark-append (alist id mark)
 214   "Append mark."
 215   (setq alist (elmo-msgdb-append-element alist
 216                                          (list id mark))))
 217
 218 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
 219   ;; Make a table of msgid flag (read, answered)
 220   (let ((flag-table (or flag-table
 221                         (elmo-make-hash (elmo-msgdb-length msgdb))))
 222         entity)
 223     (dolist (number (elmo-msgdb-list-messages msgdb))
 224       (setq entity (elmo-msgdb-message-entity msgdb number))
 225       (elmo-flag-table-set
 226        flag-table
 227        (elmo-msgdb-overview-entity-get-id entity)
 228        (elmo-msgdb-flags msgdb number)))
 229     flag-table))
 230
 231 ;;
 232 ;; overview handling
 233 ;;
 234 (defun elmo-multiple-field-body (name &optional boundary)
 235   (save-excursion
 236     (save-restriction
 237       (std11-narrow-to-header boundary)
 238       (goto-char (point-min))
 239       (let ((case-fold-search t)
 240             (field-body nil))
 241         (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
 242           (setq field-body
 243                 (nconc field-body
 244                        (list (buffer-substring-no-properties
 245                               (match-end 0) (std11-field-end))))))
 246         field-body))))
 247
 248 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 249   "Return list of each field-bodies of FIELD-NAMES of the message header
 250 in current buffer. If BOUNDARY is not nil, it is used as message
 251 header separator."
 252   (save-excursion
 253     (save-restriction
 254       (std11-narrow-to-header boundary)
 255       (let* ((case-fold-search t)
 256              (s-rest field-names)
 257              field-name field-body)
 258         (while (setq field-name (car s-rest))
 259           (goto-char (point-min))
 260           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 261             (setq field-body
 262                   (nconc field-body
 263                          (list (buffer-substring-no-properties
 264                                 (match-end 0) (std11-field-end))))))
 265           (setq s-rest (cdr s-rest)))
 266         field-body))))
 267
 268 (defsubst elmo-msgdb-remove-field-string (string)
 269   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 270       (substring string (match-end 0))
 271     string))
 272
 273 (defsubst elmo-msgdb-get-last-message-id (string)
 274   (if string
 275       (save-match-data
 276         (let (beg)
 277           (elmo-set-work-buf
 278            (insert string)
 279            (goto-char (point-max))
 280            (when (search-backward "<" nil t)
 281              (setq beg (point))
 282              (if (search-forward ">" nil t)
 283                  (elmo-replace-in-string
 284                   (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
 285
 286 (defun elmo-msgdb-number-load (dir)
 287   (elmo-object-load
 288    (expand-file-name elmo-msgdb-number-filename dir)))
 289
 290 (defun elmo-msgdb-overview-load (dir)
 291   (elmo-object-load
 292    (expand-file-name elmo-msgdb-overview-filename dir)))
 293
 294 (defun elmo-msgdb-mark-load (dir)
 295   (elmo-object-load
 296    (expand-file-name elmo-msgdb-mark-filename dir)))
 297
 298 (defsubst elmo-msgdb-seen-load (dir)
 299   (elmo-object-load (expand-file-name
 300                      elmo-msgdb-seen-filename
 301                      dir)))
 302
 303 (defun elmo-msgdb-number-save (dir obj)
 304   (elmo-object-save
 305    (expand-file-name elmo-msgdb-number-filename dir)
 306    obj))
 307
 308 (defun elmo-msgdb-mark-save (dir obj)
 309   (elmo-object-save
 310    (expand-file-name elmo-msgdb-mark-filename dir)
 311    obj))
 312
 313 (defsubst elmo-msgdb-out-of-date-messages (msgdb)
 314   (dolist (number (elmo-msgdb-list-flagged msgdb 'new))
 315     (elmo-msgdb-unset-flag msgdb number 'new)))
 316
 317 (defsubst elmo-msgdb-overview-save (dir overview)
 318   (elmo-object-save
 319    (expand-file-name elmo-msgdb-overview-filename dir)
 320    overview))
 321
 322 (defun elmo-msgdb-match-condition (msgdb condition number numbers)
 323   "Check whether the condition of the message is satisfied or not.
 324 MSGDB is the msgdb to search from.
 325 CONDITION is the search condition.
 326 NUMBER is the message number to check.
 327 NUMBERS is the target message number list.
 328 Return CONDITION itself if no entity exists in msgdb."
 329   (let ((entity (elmo-msgdb-message-entity msgdb number)))
 330     (if entity
 331         (elmo-msgdb-match-condition-internal condition
 332                                              entity
 333                                              (elmo-msgdb-flags msgdb number)
 334                                              numbers)
 335       condition)))
 336
 337 ;; entity -> parent-entity
 338 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
 339   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 340   ;; entity is parent-id.
 341   (and entity (assoc entity database)))
 342
 343 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
 344   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 345   ;; entity is parent-id.
 346   (and entity (elmo-msgdb-message-entity msgdb entity)))
 347
 348 ;;
 349 ;; deleted message handling
 350 ;;
 351 (defun elmo-msgdb-killed-list-load (dir)
 352   (elmo-object-load
 353    (expand-file-name elmo-msgdb-killed-filename dir)
 354    nil t))
 355
 356 (defun elmo-msgdb-killed-list-save (dir killed-list)
 357   (elmo-object-save
 358    (expand-file-name elmo-msgdb-killed-filename dir)
 359    killed-list))
 360
 361 (defun elmo-msgdb-killed-message-p (killed-list msg)
 362   (elmo-number-set-member msg killed-list))
 363
 364 (defun elmo-msgdb-set-as-killed (killed-list msg)
 365   (elmo-number-set-append killed-list msg))
 366
 367 (defun elmo-msgdb-killed-list-length (killed-list)
 368   (let ((killed killed-list)
 369         (ret-val 0))
 370     (while (car killed)
 371       (if (consp (car killed))
 372           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 373         (setq ret-val (+ ret-val 1)))
 374       (setq killed (cdr killed)))
 375     ret-val))
 376
 377 (defun elmo-msgdb-max-of-killed (killed-list)
 378   (let ((klist killed-list)
 379         (max 0)
 380         k)
 381     (while (car klist)
 382       (if (< max
 383              (setq k
 384                    (if (consp (car klist))
 385                        (cdar klist)
 386                      (car klist))))
 387           (setq max k))
 388       (setq klist (cdr klist)))
 389     max))
 390
 391 (defun elmo-living-messages (messages killed-list)
 392   (if killed-list
 393       (delq nil
 394             (mapcar (lambda (number)
 395                       (unless (elmo-number-set-member number killed-list)
 396                         number))
 397                     messages))
 398     messages))
 399
 400 (defun elmo-msgdb-finfo-load ()
 401   (elmo-object-load (expand-file-name
 402                      elmo-msgdb-finfo-filename
 403                      elmo-msgdb-directory)
 404                     elmo-mime-charset t))
 405
 406 (defun elmo-msgdb-finfo-save (finfo)
 407   (elmo-object-save (expand-file-name
 408                      elmo-msgdb-finfo-filename
 409                      elmo-msgdb-directory)
 410                     finfo elmo-mime-charset))
 411
 412 (defun elmo-msgdb-flist-load (fname)
 413   (let ((flist-file (expand-file-name
 414                      elmo-msgdb-flist-filename
 415                      (expand-file-name
 416                       (elmo-safe-filename fname)
 417                       (expand-file-name "folder" elmo-msgdb-directory)))))
 418     (elmo-object-load flist-file elmo-mime-charset t)))
 419
 420 (defun elmo-msgdb-flist-save (fname flist)
 421   (let ((flist-file (expand-file-name
 422                      elmo-msgdb-flist-filename
 423                      (expand-file-name
 424                       (elmo-safe-filename fname)
 425                       (expand-file-name "folder" elmo-msgdb-directory)))))
 426     (elmo-object-save flist-file flist elmo-mime-charset)))
 427
 428 (defun elmo-crosspost-alist-load ()
 429   (elmo-object-load (expand-file-name
 430                      elmo-crosspost-alist-filename
 431                      elmo-msgdb-directory)
 432                     nil t))
 433
 434 (defun elmo-crosspost-alist-save (alist)
 435   (elmo-object-save (expand-file-name
 436                      elmo-crosspost-alist-filename
 437                      elmo-msgdb-directory)
 438                     alist))
 439
 440 (defun elmo-msgdb-get-message-id-from-buffer ()
 441   (let ((msgid (elmo-field-body "message-id")))
 442     (if msgid
 443         (if (string-match "<\\(.+\\)>$" msgid)
 444             msgid
 445           (concat "<" msgid ">")) ; Invaild message-id.
 446       ;; no message-id, so put dummy msgid.
 447       (concat "<" (timezone-make-date-sortable
 448                    (elmo-field-body "date"))
 449               (nth 1 (eword-extract-address-components
 450                       (or (elmo-field-body "from") "nobody"))) ">"))))
 451
 452 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
 453   "Create overview entity from current buffer.
 454 Header region is supposed to be narrowed."
 455   (save-excursion
 456     (let ((extras elmo-msgdb-extra-fields)
 457           (default-mime-charset default-mime-charset)
 458           message-id references from subject to cc date
 459           extra field-body charset)
 460       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 461       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
 462       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
 463            (setq charset (intern-soft charset))
 464            (setq default-mime-charset charset))
 465       (setq references
 466             (or (elmo-msgdb-get-last-message-id
 467                  (elmo-field-body "in-reply-to"))
 468                 (elmo-msgdb-get-last-message-id
 469                  (elmo-field-body "references"))))
 470       (setq from (elmo-replace-in-string
 471                   (elmo-mime-string (or (elmo-field-body "from")
 472                                         elmo-no-from))
 473                   "\t" " ")
 474             subject (elmo-replace-in-string
 475                      (elmo-mime-string (or (elmo-field-body "subject")
 476                                            elmo-no-subject))
 477                      "\t" " "))
 478       (setq date (or (elmo-field-body "date") time))
 479       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
 480       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 481       (or size
 482           (if (setq size (elmo-field-body "content-length"))
 483               (setq size (string-to-int size))
 484             (setq size 0)));; No mean...
 485       (while extras
 486         (if (setq field-body (elmo-field-body (car extras)))
 487             (setq extra (cons (cons (downcase (car extras))
 488                                     field-body) extra)))
 489         (setq extras (cdr extras)))
 490       (cons message-id (vector number references
 491                                from subject date to cc
 492                                size extra))
 493       )))
 494
 495 (defsubst elmo-msgdb-insert-file-header (file)
 496   "Insert the header of the article."
 497   (let ((beg 0)
 498         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 499         insert-file-contents-post-hook
 500         format-alist)
 501     (when (file-exists-p file)
 502       ;; Read until header separator is found.
 503       (while (and (eq elmo-msgdb-file-header-chop-length
 504                       (nth 1
 505                            (insert-file-contents-as-binary
 506                             file nil beg
 507                             (incf beg elmo-msgdb-file-header-chop-length))))
 508                   (prog1 (not (search-forward "\n\n" nil t))
 509                     (goto-char (point-max))))))))
 510
 511 (defsubst elmo-msgdb-create-overview-entity-from-file (number file)
 512   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 513         insert-file-contents-post-hook header-end
 514         (attrib (file-attributes file))
 515         ret-val size mtime)
 516     (with-temp-buffer
 517       (if (not (file-exists-p file))
 518           ()
 519         (setq size (nth 7 attrib))
 520         (setq mtime (timezone-make-date-arpa-standard
 521                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 522         ;; insert header from file.
 523         (catch 'done
 524           (condition-case nil
 525               (elmo-msgdb-insert-file-header file)
 526             (error (throw 'done nil)))
 527           (goto-char (point-min))
 528           (setq header-end
 529                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 530                     (point)
 531                   (point-max)))
 532           (narrow-to-region (point-min) header-end)
 533           (elmo-msgdb-create-overview-from-buffer number size mtime))))))
 534
 535 (defsubst elmo-folder-get-info (folder &optional hashtb)
 536   (elmo-get-hash-val folder
 537                      (or hashtb elmo-folder-info-hashtb)))
 538
 539 (defun elmo-folder-get-info-max (folder)
 540   "Get folder info from cache."
 541   (nth 3 (elmo-folder-get-info folder)))
 542
 543 (defun elmo-folder-get-info-length (folder)
 544   (nth 2 (elmo-folder-get-info folder)))
 545
 546 (defun elmo-folder-get-info-unread (folder)
 547   (nth 1 (elmo-folder-get-info folder)))
 548
 549 (defsubst elmo-msgdb-location-load (dir)
 550   (elmo-object-load
 551    (expand-file-name
 552     elmo-msgdb-location-filename
 553     dir)))
 554
 555 (defsubst elmo-msgdb-location-add (alist number location)
 556   (let ((ret-val alist))
 557     (setq ret-val
 558           (elmo-msgdb-append-element ret-val (cons number location)))
 559     ret-val))
 560
 561 (defsubst elmo-msgdb-location-save (dir alist)
 562   (elmo-object-save
 563    (expand-file-name
 564     elmo-msgdb-location-filename
 565     dir) alist))
 566
 567 (require 'product)
 568 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 569
 570 ;;; elmo-msgdb.el ends here