;;;
;; Internal use only (obsolete interface)
;;
-;;
-;; mime decode cache
-;;
-(defvar elmo-msgdb-decoded-cache-hashtb nil)
-(make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
-
-(defsubst elmo-msgdb-get-decoded-cache (string)
- (if elmo-use-decoded-cache
- (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
- (setq elmo-msgdb-decoded-cache-hashtb
- (elmo-make-hash 2048))))
- decoded)
- (or (elmo-get-hash-val string hashtb)
- (progn
- (elmo-set-hash-val
- string
- (setq decoded
- (decode-mime-charset-string string elmo-mime-charset))
- hashtb)
- decoded)))
- (decode-mime-charset-string string elmo-mime-charset)))
-
-(defsubst elmo-msgdb-overview-entity-get-id (entity)
+(defsubst elmo-msgdb-overview-entity-get-id-internal (entity)
(and entity (car entity)))
-(defsubst elmo-msgdb-overview-entity-get-number (entity)
+(defsubst elmo-msgdb-overview-entity-get-number-internal (entity)
(and entity (aref (cdr entity) 0)))
-(defsubst elmo-msgdb-overview-entity-set-number (entity number)
- (and entity (aset (cdr entity) 0 number))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-references (entity)
- (and entity (aref (cdr entity) 1)))
-
-(defsubst elmo-msgdb-overview-entity-set-references (entity references)
- (and entity (aset (cdr entity) 1 references))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
- (and entity (aref (cdr entity) 2)))
-
-(defsubst elmo-msgdb-overview-entity-get-from (entity)
- (and entity
- (aref (cdr entity) 2)
- (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
-
-(defsubst elmo-msgdb-overview-entity-set-from (entity from)
- (and entity (aset (cdr entity) 2 from))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-subject (entity)
- (and entity
- (aref (cdr entity) 3)
- (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
-
-(defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
- (and entity (aref (cdr entity) 3)))
-
-(defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
- (and entity (aset (cdr entity) 3 subject))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-date (entity)
- (and entity (aref (cdr entity) 4)))
-
-(defsubst elmo-msgdb-overview-entity-set-date (entity date)
- (and entity (aset (cdr entity) 4 date))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-to (entity)
- (and entity (aref (cdr entity) 5)))
-
-(defsubst elmo-msgdb-overview-entity-get-cc (entity)
- (and entity (aref (cdr entity) 6)))
-
-(defsubst elmo-msgdb-overview-entity-get-size (entity)
- (and entity (aref (cdr entity) 7)))
-
-(defsubst elmo-msgdb-overview-entity-set-size (entity size)
- (and entity (aset (cdr entity) 7 size))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-extra (entity)
- (and entity (aref (cdr entity) 8)))
-
-(defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
- (and entity (aset (cdr entity) 8 extra))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
- (let ((field-name (downcase field-name))
- (extra (and entity (aref (cdr entity) 8))))
- (and extra
- (cdr (assoc field-name extra)))))
-
-(defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
- (let ((field-name (downcase field-name))
- (extras (and entity (aref (cdr entity) 8)))
- extra)
- (if (setq extra (assoc field-name extras))
- (setcdr extra value)
- (elmo-msgdb-overview-entity-set-extra
- entity
- (cons (cons field-name value) extras)))))
-
;;; load & save
(defun elmo-msgdb-number-load (dir)
(elmo-object-load
;; key is message-id
(if (elmo-get-hash-val (caar overview) ehash) ; duplicated.
(setq duplicates (cons
- (elmo-msgdb-overview-entity-get-number
+ (elmo-msgdb-overview-entity-get-number-internal
(car overview))
duplicates)))
(if (caar overview)
;; key is number
(elmo-set-hash-val
(format "#%d"
- (elmo-msgdb-overview-entity-get-number (car overview)))
+ (elmo-msgdb-overview-entity-get-number-internal
+ (car overview)))
(car overview) ehash)
(setq overview (cdr overview)))
(while mark-alist
(mhash (elmo-msgdb-get-mark-hashtb msgdb))
number)
(when (and entity ehash)
- (and (setq number (elmo-msgdb-overview-entity-get-number entity))
+ (and (setq number (elmo-msgdb-overview-entity-get-number-internal
+ entity))
(elmo-clear-hash-val (format "#%d" number) ehash))
(and (car entity) ;; message-id
(elmo-clear-hash-val (car entity) ehash)))
(when (and entity mhash)
- (and (setq number (elmo-msgdb-overview-entity-get-number entity))
+ (and (setq number (elmo-msgdb-overview-entity-get-number-internal
+ entity))
(elmo-clear-hash-val (format "#%d" number) mhash)))))
;;; Implement
(elmo-msgdb-set-flag msgdb number 'unread))
(uncached
(elmo-msgdb-set-flag msgdb number 'cached))
+ (all
+ (elmo-msgdb-set-mark msgdb number nil))
(t
(let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
(flags (modb-legacy-mark-to-flags cur-mark))
(unless (string= new-mark cur-mark)
(elmo-msgdb-set-mark msgdb number new-mark))))))
+(luna-define-method elmo-msgdb-flag-count ((msgdb modb-legacy))
+ (let ((new 0)
+ (unread 0)
+ (answered 0))
+ (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
+ (cond
+ ((string= (cadr elem) modb-legacy-new-mark)
+ (incf new)
+ (incf unread))
+ ((member (cadr elem) (modb-legacy-unread-marks))
+ (incf unread))
+ ((member (cadr elem) (modb-legacy-answered-marks))
+ (incf answered))))
+ (list (cons 'new new)
+ (cons 'unread unread)
+ (cons 'answered answered))))
+
(luna-define-method elmo-msgdb-list-messages ((msgdb modb-legacy))
- (mapcar 'elmo-msgdb-overview-entity-get-number
+ (mapcar 'elmo-msgdb-overview-entity-get-number-internal
(elmo-msgdb-get-overview msgdb)))
(luna-define-method elmo-msgdb-list-flagged ((msgdb modb-legacy) flag)
(setq matched (cons (car elem) matched))))))
matched))
+(luna-define-method elmo-msgdb-search ((msgdb modb-legacy)
+ condition &optional numbers)
+ (if (vectorp condition)
+ (let ((key (elmo-filter-key condition))
+ results)
+ (cond
+ ((and (string= key "flag")
+ (eq (elmo-filter-type condition) 'match))
+ (setq results (elmo-msgdb-list-flagged
+ msgdb
+ (intern (elmo-filter-value condition))))
+ (if numbers
+ (elmo-list-filter numbers results)
+ results))
+ ((member key '("first" "last"))
+ (let* ((numbers (or numbers (elmo-msgdb-list-messages msgdb)))
+ (len (length numbers))
+ (lastp (string= key "last"))
+ (value (string-to-number (elmo-filter-value condition))))
+ (when (eq (elmo-filter-type condition) 'unmatch)
+ (setq lastp (not lastp)
+ value (- len value)))
+ (if lastp
+ (nthcdr (max (- len value) 0) numbers)
+ (when (> value 0)
+ (let* ((numbers (copy-sequence numbers))
+ (last (nthcdr (1- value) numbers)))
+ (when last
+ (setcdr last nil))
+ numbers)))))
+ (t
+ t)))
+ t))
+
(luna-define-method elmo-msgdb-append-entity ((msgdb modb-legacy)
entity &optional flags)
(when entity
- (let ((number (elmo-msgdb-overview-entity-get-number entity))
- (message-id (elmo-msgdb-overview-entity-get-id entity))
- mark)
+ (let ((number (elmo-msgdb-overview-entity-get-number-internal entity))
+ (message-id (elmo-msgdb-overview-entity-get-id-internal entity))
+ mark cell)
(elmo-msgdb-set-overview
msgdb
(nconc (elmo-msgdb-get-overview msgdb)
(list (cons number message-id))))
(modb-generic-set-message-modified-internal msgdb t)
(when (setq mark (modb-legacy-flags-to-mark flags))
+ (setq cell (list number mark))
(elmo-msgdb-set-mark-alist
msgdb
- (nconc (elmo-msgdb-get-mark-alist msgdb)
- (list (list number mark))))
+ (nconc (elmo-msgdb-get-mark-alist msgdb) (list cell)))
(modb-generic-set-flag-modified-internal msgdb t))
(elmo-msgdb-make-index
msgdb
(list entity)
- (list (list number mark))))))
+ (and cell (list cell))))))
(luna-define-method elmo-msgdb-delete-messages ((msgdb modb-legacy)
numbers)
msgdb))
(luna-define-method elmo-msgdb-message-entity ((msgdb modb-legacy) key)
- (elmo-get-hash-val
- (cond ((stringp key) key)
- ((numberp key) (format "#%d" key)))
- (elmo-msgdb-get-entity-hashtb msgdb)))
-
-;;; Message entity handling.
-(defsubst modb-legacy-make-message-entity (args)
- "Make an message entity."
- (cons (plist-get args :message-id)
- (vector (plist-get args :number)
- (plist-get args :references)
- (plist-get args :from)
- (plist-get args :subject)
- (plist-get args :date)
- (plist-get args :to)
- (plist-get args :cc)
- (plist-get args :size)
- (plist-get args :extra))))
-
-(luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-legacy)
- args)
- (modb-legacy-make-message-entity args))
-
-(luna-define-method elmo-msgdb-create-message-entity-from-buffer
- ((msgdb modb-legacy) number args)
- (let ((extras elmo-msgdb-extra-fields)
- (default-mime-charset default-mime-charset)
- entity message-id references from subject to cc date
- extra field-body charset size)
- (save-excursion
- (setq entity (modb-legacy-make-message-entity args))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq message-id (elmo-msgdb-get-message-id-from-buffer))
- (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
- (setq charset (intern-soft charset))
- (setq default-mime-charset charset))
- (setq references
- (or (elmo-msgdb-get-last-message-id
- (elmo-field-body "in-reply-to"))
- (elmo-msgdb-get-last-message-id
- (elmo-field-body "references")))
- from (elmo-replace-in-string
- (elmo-mime-string (or (elmo-field-body "from")
- elmo-no-from))
- "\t" " ")
- subject (elmo-replace-in-string
- (elmo-mime-string (or (elmo-field-body "subject")
- elmo-no-subject))
- "\t" " ")
- date (elmo-field-body "date")
- to (mapconcat 'identity (elmo-multiple-field-body "to") ",")
- cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
- (unless (elmo-msgdb-message-entity-field msgdb entity 'size)
- (if (setq size (elmo-field-body "content-length"))
- (setq size (string-to-int size))
- (setq size 0)))
- (while extras
- (if (setq field-body (elmo-field-body (car extras)))
- (elmo-msgdb-message-entity-set-field
- msgdb entity (intern (downcase (car extras))) field-body))
- (setq extras (cdr extras)))
- (dolist (field '(message-id number references from subject
- date to cc size))
- (when (symbol-value field)
- (elmo-msgdb-message-entity-set-field
- msgdb entity field (symbol-value field))))
- entity)))
-
-;;; Message entity interface
-;;
-(luna-define-method elmo-msgdb-message-entity-number ((msgdb modb-legacy)
- entity)
- (and entity (aref (cdr entity) 0)))
-
-(luna-define-method elmo-msgdb-message-entity-set-number ((msgdb modb-legacy)
- entity
- number)
- (and entity (aset (cdr entity) 0 number))
- entity)
-
-(luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-legacy)
- entity field
- &optional decode)
- (and entity
- (let ((field-value
- (case field
- (to (aref (cdr entity) 5))
- (cc (aref (cdr entity) 6))
- (date (aref (cdr entity) 4))
- (subject (aref (cdr entity) 3))
- (from (aref (cdr entity) 2))
- (message-id (car entity))
- (references (aref (cdr entity) 1))
- (size (aref (cdr entity) 7))
- (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
- (if (and decode (memq field '(from subject)))
- (elmo-msgdb-get-decoded-cache field-value)
- field-value))))
-
-(luna-define-method elmo-msgdb-message-entity-set-field ((msgdb modb-legacy)
- entity field value)
- (and entity
- (case field
- (number (aset (cdr entity) 0 value))
- (to (aset (cdr entity) 5 value))
- (cc (aset (cdr entity) 6 value))
- (date (aset (cdr entity) 4 value))
- (subject (aset (cdr entity) 3 value))
- (from (aset (cdr entity) 2 value))
- (message-id (setcar entity value))
- (references (aset (cdr entity) 1 value))
- (size (aset (cdr entity) 7 value))
- (t
- (let ((extras (and entity (aref (cdr entity) 8)))
- extra)
- (if (setq extra (assoc (symbol-name field) extras))
- (setcdr extra value)
- (aset (cdr entity) 8 (cons (cons (symbol-name field)
- value) extras))))))))
-
-(luna-define-method elmo-msgdb-copy-message-entity ((msgdb modb-legacy)
- entity)
- (cons (car entity)
- (copy-sequence (cdr entity))))
-
-(luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-legacy)
- condition
- entity flags numbers)
- (cond
- ((vectorp condition)
- (elmo-msgdb-match-condition-primitive condition entity flags numbers))
- ((eq (car condition) 'and)
- (let ((lhs (elmo-msgdb-match-condition-internal msgdb
- (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal
- msgdb (nth 2 condition) entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'and lhs rhs))
- (rhs
- lhs))))
- (lhs
- (elmo-msgdb-match-condition-internal msgdb (nth 2 condition)
- entity flags numbers)))))
- ((eq (car condition) 'or)
- (let ((lhs (elmo-msgdb-match-condition-internal msgdb (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal msgdb
- (nth 2 condition)
- entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'or lhs rhs))
- (rhs
- t)
- (t
- lhs))))
- (lhs
- t)
- (t
- (elmo-msgdb-match-condition-internal msgdb
- (nth 2 condition)
- entity flags numbers)))))))
-
-;;
-(defun elmo-msgdb-match-condition-primitive (condition entity flags numbers)
- (catch 'unresolved
- (let ((key (elmo-filter-key condition))
- (case-fold-search t)
- result)
- (cond
- ((string= key "last")
- (setq result (<= (length (memq
- (elmo-msgdb-overview-entity-get-number
- entity)
- numbers))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "first")
- (setq result (< (-
- (length numbers)
- (length (memq
- (elmo-msgdb-overview-entity-get-number
- entity)
- numbers)))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "flag")
- (setq result
- (cond
- ((string= (elmo-filter-value condition) "any")
- (or (memq 'important flags)
- (memq 'answered flags)
- (memq 'unread flags)))
- ((string= (elmo-filter-value condition) "digest")
- (or (memq 'important flags)
- (memq 'unread flags)))
- ((string= (elmo-filter-value condition) "unread")
- (memq 'unread flags))
- ((string= (elmo-filter-value condition) "important")
- (memq 'important flags))
- ((string= (elmo-filter-value condition) "answered")
- (memq 'answered flags)))))
- ((string= key "from")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-from entity))))
- ((string= key "subject")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-subject entity))))
- ((string= key "to")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-to entity))))
- ((string= key "cc")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-cc entity))))
- ((or (string= key "since")
- (string= key "before"))
- (let ((field-date (elmo-date-make-sortable-string
- (timezone-fix-time
- (elmo-msgdb-overview-entity-get-date entity)
- (current-time-zone) nil)))
- (specified-date
- (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition)))))
- (setq result (if (string= key "since")
- (or (string= specified-date field-date)
- (string< specified-date field-date))
- (string< field-date specified-date)))))
- ((member key elmo-msgdb-extra-fields)
- (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
- (when (stringp extval)
- (setq result (string-match
- (elmo-filter-value condition)
- extval)))))
- (t
- (throw 'unresolved condition)))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (not result)
- result))))
+ (when key
+ (elmo-get-hash-val
+ (cond ((stringp key) key)
+ ((numberp key) (format "#%d" key)))
+ (elmo-msgdb-get-entity-hashtb msgdb))))
(require 'product)
(product-provide (provide 'modb-legacy) (require 'elmo-version))