elmo/modb-entity.el

   1 ;;; modb-entity.el --- Message Entity Interface.
   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-vars)
  36 (require 'elmo-util)
  37 (require 'mime)
  38
  39 ;;
  40 ;; mime decode cache
  41
  42 (defvar elmo-msgdb-decoded-cache-hashtb nil)
  43 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
  44
  45 (defsubst elmo-msgdb-get-decoded-cache (string)
  46   (if elmo-use-decoded-cache
  47       (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
  48                         (setq elmo-msgdb-decoded-cache-hashtb
  49                               (elmo-make-hash 2048))))
  50             decoded)
  51         (or (elmo-get-hash-val string hashtb)
  52             (progn
  53               (elmo-set-hash-val
  54                string
  55                (setq decoded
  56                      (decode-mime-charset-string string elmo-mime-charset))
  57                hashtb)
  58               decoded)))
  59     (decode-mime-charset-string string elmo-mime-charset)))
  60
  61
  62 ;;; Message entity interface
  63 ;;
  64 (defun elmo-msgdb-make-message-entity (&rest args)
  65   "Make an message entity."
  66   (cons (plist-get args :message-id)
  67         (vector (plist-get args :number)
  68                 (plist-get args :references)
  69                 (plist-get args :from)
  70                 (plist-get args :subject)
  71                 (plist-get args :date)
  72                 (plist-get args :to)
  73                 (plist-get args :cc)
  74                 (plist-get args :size)
  75                 (plist-get args :extra))))
  76
  77 (defsubst elmo-msgdb-message-entity-field (entity field &optional decode)
  78   (and entity
  79        (let ((field-value
  80               (case field
  81                 (to (aref (cdr entity) 5))
  82                 (cc (aref (cdr entity) 6))
  83                 (date (aref (cdr entity) 4))
  84                 (subject (aref (cdr entity) 3))
  85                 (from (aref (cdr entity) 2))
  86                 (message-id (car entity))
  87                 (references (aref (cdr entity) 1))
  88                 (size (aref (cdr entity) 7))
  89                 (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
  90          (if (and decode (memq field '(from subject)))
  91              (elmo-msgdb-get-decoded-cache field-value)
  92            field-value))))
  93
  94 (defsubst elmo-msgdb-message-entity-set-field (entity field value)
  95   (and entity
  96        (case field
  97          (to (aset (cdr entity) 5 value))
  98          (cc (aset (cdr entity) 6 value))
  99          (date (aset (cdr entity) 4 value))
 100          (subject (aset (cdr entity) 3 value))
 101          (from (aset (cdr entity) 2 value))
 102          (message-id (setcar entity value))
 103          (references (aset (cdr entity) 1 value))
 104          (size (aset (cdr entity) 7 value))
 105          (t
 106           (let ((extras (and entity (aref (cdr entity) 8)))
 107                 extra)
 108             (if (setq extra (assoc field extras))
 109                 (setcdr extra value)
 110               (aset (cdr entity) 8 (cons (cons (symbol-name field)
 111                                                value) extras))))))))
 112
 113 (defun elmo-msgdb-copy-overview-entity (entity)
 114   (cons (car entity)
 115         (copy-sequence (cdr entity))))
 116
 117 ;;; obsolete interface
 118 ;;
 119 (defsubst elmo-msgdb-overview-entity-get-id (entity)
 120   (and entity (car entity)))
 121
 122 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 123   (and entity (aref (cdr entity) 0)))
 124
 125 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 126   (and entity (aset (cdr entity) 0 number))
 127   entity)
 128
 129 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 130   (and entity (aref (cdr entity) 1)))
 131
 132 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 133   (and entity (aset (cdr entity) 1 references))
 134   entity)
 135
 136 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 137   (and entity (aref (cdr entity) 2)))
 138
 139 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 140   (and entity
 141        (aref (cdr entity) 2)
 142        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
 143
 144 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 145   (and entity (aset (cdr entity) 2 from))
 146   entity)
 147
 148 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 149   (and entity
 150        (aref (cdr entity) 3)
 151        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
 152
 153 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 154   (and entity (aref (cdr entity) 3)))
 155
 156 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 157   (and entity (aset (cdr entity) 3 subject))
 158   entity)
 159
 160 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 161   (and entity (aref (cdr entity) 4)))
 162
 163 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
 164   (and entity (aset (cdr entity) 4 date))
 165   entity)
 166
 167 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 168   (and entity (aref (cdr entity) 5)))
 169
 170 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 171   (and entity (aref (cdr entity) 6)))
 172
 173 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 174   (and entity (aref (cdr entity) 7)))
 175
 176 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 177   (and entity (aset (cdr entity) 7 size))
 178   entity)
 179
 180 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 181   (and entity (aref (cdr entity) 8)))
 182
 183 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 184   (and entity (aset (cdr entity) 8 extra))
 185   entity)
 186
 187 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
 188   (let ((field-name (downcase field-name))
 189         (extra (and entity (aref (cdr entity) 8))))
 190     (and extra
 191          (cdr (assoc field-name extra)))))
 192
 193 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
 194   (let ((field-name (downcase field-name))
 195         (extras (and entity (aref (cdr entity) 8)))
 196         extra)
 197     (if (setq extra (assoc field-name extras))
 198         (setcdr extra value)
 199       (elmo-msgdb-overview-entity-set-extra
 200        entity
 201        (cons (cons field-name value) extras)))))
 202
 203
 204 ;;;
 205 ;;
 206 (defun elmo-msgdb-match-condition-primitive (condition entity flags numbers)
 207   (catch 'unresolved
 208     (let ((key (elmo-filter-key condition))
 209           (case-fold-search t)
 210           result)
 211       (cond
 212        ((string= key "last")
 213         (setq result (<= (length (memq
 214                                   (elmo-msgdb-overview-entity-get-number
 215                                    entity)
 216                                   numbers))
 217                          (string-to-int (elmo-filter-value condition)))))
 218        ((string= key "first")
 219         (setq result (< (-
 220                          (length numbers)
 221                          (length (memq
 222                                   (elmo-msgdb-overview-entity-get-number
 223                                    entity)
 224                                   numbers)))
 225                         (string-to-int (elmo-filter-value condition)))))
 226        ((string= key "flag")
 227         (setq result
 228               (cond
 229                ((string= (elmo-filter-value condition) "any")
 230                 (or (memq 'important flags)
 231                     (memq 'answered flags)
 232                     (memq 'unread flags)))
 233                ((string= (elmo-filter-value condition) "digest")
 234                 (or (memq 'important flags)
 235                     (memq 'unread flags)))
 236                ((string= (elmo-filter-value condition) "unread")
 237                 (memq 'unread flags))
 238                ((string= (elmo-filter-value condition) "important")
 239                 (memq 'important flags))
 240                ((string= (elmo-filter-value condition) "answered")
 241                 (memq 'answered flags)))))
 242        ((string= key "from")
 243         (setq result (string-match
 244                       (elmo-filter-value condition)
 245                       (elmo-msgdb-overview-entity-get-from entity))))
 246        ((string= key "subject")
 247         (setq result (string-match
 248                       (elmo-filter-value condition)
 249                       (elmo-msgdb-overview-entity-get-subject entity))))
 250        ((string= key "to")
 251         (setq result (string-match
 252                       (elmo-filter-value condition)
 253                       (elmo-msgdb-overview-entity-get-to entity))))
 254        ((string= key "cc")
 255         (setq result (string-match
 256                       (elmo-filter-value condition)
 257                       (elmo-msgdb-overview-entity-get-cc entity))))
 258        ((or (string= key "since")
 259             (string= key "before"))
 260         (let ((field-date (elmo-date-make-sortable-string
 261                            (timezone-fix-time
 262                             (elmo-msgdb-overview-entity-get-date entity)
 263                             (current-time-zone) nil)))
 264               (specified-date
 265                (elmo-date-make-sortable-string
 266                 (elmo-date-get-datevec
 267                  (elmo-filter-value condition)))))
 268           (setq result (if (string= key "since")
 269                            (or (string= specified-date field-date)
 270                                (string< specified-date field-date))
 271                          (string< field-date specified-date)))))
 272        ((member key elmo-msgdb-extra-fields)
 273         (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
 274           (when (stringp extval)
 275             (setq result (string-match
 276                           (elmo-filter-value condition)
 277                           extval)))))
 278        (t
 279         (throw 'unresolved condition)))
 280       (if (eq (elmo-filter-type condition) 'unmatch)
 281           (not result)
 282         result))))
 283
 284 (defun elmo-msgdb-match-condition-internal (condition entity flags numbers)
 285   (cond
 286    ((vectorp condition)
 287     (elmo-msgdb-match-condition-primitive condition entity flags numbers))
 288    ((eq (car condition) 'and)
 289     (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
 290                                                     entity flags numbers)))
 291       (cond
 292        ((elmo-filter-condition-p lhs)
 293         (let ((rhs (elmo-msgdb-match-condition-internal
 294                     (nth 2 condition) entity flags numbers)))
 295           (cond ((elmo-filter-condition-p rhs)
 296                  (list 'and lhs rhs))
 297                 (rhs
 298                  lhs))))
 299        (lhs
 300         (elmo-msgdb-match-condition-internal (nth 2 condition)
 301                                              entity flags numbers)))))
 302    ((eq (car condition) 'or)
 303     (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
 304                                                     entity flags numbers)))
 305       (cond
 306        ((elmo-filter-condition-p lhs)
 307         (let ((rhs (elmo-msgdb-match-condition-internal (nth 2 condition)
 308                                                         entity flags numbers)))
 309           (cond ((elmo-filter-condition-p rhs)
 310                  (list 'or lhs rhs))
 311                 (rhs
 312                  t)
 313                 (t
 314                  lhs))))
 315        (lhs
 316         t)
 317        (t
 318         (elmo-msgdb-match-condition-internal (nth 2 condition)
 319                                              entity flags numbers)))))))
 320
 321
 322 (require 'product)
 323 (product-provide (provide 'modb-entity) (require 'elmo-version))
 324
 325 ;;; modb-entity.el ends here