(require 'std11)
(require 'mime)
(require 'modb)
-(require 'modb-entity)
;;; MSGDB interface.
;;
-;; MSGDB elmo-load-msgdb PATH
-
-;; NUMBER elmo-msgdb-get-number MSGDB MESSAGE-ID
-;; FIELD-VALUE elmo-msgdb-get-field MSGDB NUMBER FIELD
+;; MSGDB elmo-load-msgdb PATH MIME-CHARSET
+;; MSGDB elmo-make-msgdb LOCATION TYPE
;; elmo-msgdb-sort-by-date MSGDB
;; elmo-flag-table-load
;; elmo-crosspost-alist-load
;; elmo-crosspost-alist-save
-;; elmo-msgdb-create-overview-from-buffer NUMBER SIZE TIME
-;; elmo-msgdb-create-overview-entity-from-file NUMBER FILE
-
;; elmo-folder-get-info
;; elmo-folder-get-info-max
;; elmo-folder-get-info-length
;; elmo-folder-get-info-unread
+;;; message entity wrappers
+;;
+(defsubst elmo-message-entity-number (entity)
+ (elmo-msgdb-message-entity-number (elmo-message-entity-handler entity)
+ entity))
+
+(defsubst elmo-message-entity-set-number (entity number)
+ (elmo-msgdb-message-entity-set-number (elmo-message-entity-handler entity)
+ entity
+ number))
+
+(defsubst elmo-message-entity-field (entity field &optional type)
+ "Get message entity field value.
+ENTITY is the message entity structure obtained by `elmo-message-entity'.
+FIELD is the symbol of the field name.
+If optional argument TYPE is specified, return converted value."
+ (elmo-msgdb-message-entity-field (elmo-message-entity-handler entity)
+ entity field type))
+
+(defsubst elmo-message-entity-set-field (entity field value)
+ "Set message entity field value.
+ENTITY is the message entity structure.
+FIELD is the symbol of the field name.
+VALUE is the field value."
+ (elmo-msgdb-message-entity-set-field (elmo-message-entity-handler entity)
+ entity field value))
+
(defconst elmo-msgdb-load-priorities '(legacy standard)
"Priority list of modb type for load.")
;;; Helper functions for MSGDB
;;
-(defun elmo-load-msgdb (location)
+(defun elmo-load-msgdb (location mime-charset)
"Load the MSGDB from PATH."
- (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type))
+ (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type mime-charset))
priorities loaded temp-modb)
(unless (elmo-msgdb-load msgdb)
(setq priorities
(copy-sequence elmo-msgdb-load-priorities)))
(while (and priorities
(not loaded))
- (setq temp-modb (elmo-make-msgdb location (car priorities))
+ (setq temp-modb (elmo-make-msgdb location
+ (car priorities)
+ mime-charset)
loaded (elmo-msgdb-load temp-modb)
priorities (cdr priorities)))
(when loaded
(setq msgdb temp-modb))))
msgdb))
-(defun elmo-make-msgdb (&optional location type)
+(defun elmo-make-msgdb (&optional location type mime-charset)
"Make a MSGDB."
(let* ((type (or type elmo-msgdb-default-type))
(class (intern (format "modb-%s" type))))
(require class)
(luna-make-entity class
- :location location)))
-
-(defsubst elmo-msgdb-get-number (msgdb message-id)
- "Get number of the message which corrensponds to MESSAGE-ID from MSGDB."
- (elmo-msgdb-overview-entity-get-number
- (elmo-msgdb-message-entity msgdb message-id)))
-
-(defsubst elmo-msgdb-get-field (msgdb number field)
- "Get FIELD value of the message with NUMBER from MSGDB."
- (case field
- (message-id (elmo-msgdb-overview-entity-get-id
- (elmo-msgdb-message-entity
- msgdb number)))
- (subject (elmo-msgdb-overview-entity-get-subject
- (elmo-msgdb-message-entity
- msgdb number)))
- (size (elmo-msgdb-overview-entity-get-size
- (elmo-msgdb-message-entity
- msgdb number)))
- (date (elmo-msgdb-overview-entity-get-date
- (elmo-msgdb-message-entity
- msgdb number)))
- (to (elmo-msgdb-overview-entity-get-to
- (elmo-msgdb-message-entity
- msgdb number)))
- (cc (elmo-msgdb-overview-entity-get-cc
- (elmo-msgdb-message-entity
- msgdb number)))))
+ :location location
+ :mime-charset mime-charset)))
+
+(defun elmo-msgdb-extra-fields (&optional non-virtual)
+ (if non-virtual
+ (apply
+ #'nconc
+ (mapcar
+ (lambda (extra)
+ (let ((spec (assq (intern extra) modb-entity-field-extractor-alist)))
+ (if spec
+ (let ((real-fields (nth 2 spec)))
+ (cond ((functionp real-fields)
+ (funcall real-fields extra))
+ ((listp real-fields)
+ real-fields)))
+ (list extra))))
+ elmo-msgdb-extra-fields))
+ elmo-msgdb-extra-fields))
(defun elmo-msgdb-sort-by-date (msgdb)
(elmo-msgdb-sort-entities
msgdb
(lambda (x y app-data)
(condition-case nil
- (string<
- (timezone-make-date-sortable
- (elmo-msgdb-overview-entity-get-date x))
- (timezone-make-date-sortable
- (elmo-msgdb-overview-entity-get-date y)))
+ (elmo-time<
+ (elmo-message-entity-field x 'date)
+ (elmo-message-entity-field y 'date))
(error)))))
+(defsubst elmo-msgdb-get-parent-entity (entity msgdb)
+ (setq entity (elmo-message-entity-field entity 'references))
+ ;; entity is parent-id.
+ (and entity (elmo-msgdb-message-entity msgdb entity)))
+
;;;
(defsubst elmo-msgdb-append-element (list element)
(if list
(defun elmo-flag-table-get (flag-table msg-id)
(let ((flags (elmo-get-hash-val msg-id flag-table)))
- (if flags
- (append
- (and (elmo-file-cache-exists-p msg-id)
- '(cached))
+ (append
+ (and (elmo-file-cache-exists-p msg-id)
+ '(cached))
+ (if flags
(elmo-list-delete '(cached read)
(copy-sequence flags)
- #'delq))
- '(new unread))))
+ #'delq)
+ '(new unread)))))
(defun elmo-flag-table-save (dir flag-table)
(elmo-object-save
;; Make a table of msgid flag (read, answered)
(let ((flag-table (or flag-table
(elmo-make-hash (elmo-msgdb-length msgdb))))
- entity)
+ msg-id)
(dolist (number (elmo-msgdb-list-messages msgdb))
- (setq entity (elmo-msgdb-message-entity msgdb number))
- (elmo-flag-table-set
- flag-table
- (elmo-msgdb-overview-entity-get-id entity)
- (elmo-msgdb-flags msgdb number)))
+ (when (setq msg-id (elmo-msgdb-message-field msgdb number 'message-id))
+ (elmo-flag-table-set flag-table
+ msg-id
+ (elmo-msgdb-flags msgdb number))))
flag-table))
-;;
-;; overview handling
-;;
-(defun elmo-multiple-field-body (name &optional boundary)
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (goto-char (point-min))
- (let ((case-fold-search t)
- (field-body nil))
- (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
- (setq field-body
- (nconc field-body
- (list (buffer-substring-no-properties
- (match-end 0) (std11-field-end))))))
- field-body))))
-
(defun elmo-multiple-fields-body-list (field-names &optional boundary)
"Return list of each field-bodies of FIELD-NAMES of the message header
in current buffer. If BOUNDARY is not nil, it is used as message
(substring string (match-end 0))
string))
-(defsubst elmo-msgdb-get-last-message-id (string)
- (if string
- (save-match-data
- (let (beg)
- (elmo-set-work-buf
- (insert string)
- (goto-char (point-max))
- (when (search-backward "<" nil t)
- (setq beg (point))
- (if (search-forward ">" nil t)
- (elmo-replace-in-string
- (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
-
-(defun elmo-msgdb-number-load (dir)
- (elmo-object-load
- (expand-file-name elmo-msgdb-number-filename dir)))
-
-(defun elmo-msgdb-overview-load (dir)
- (elmo-object-load
- (expand-file-name elmo-msgdb-overview-filename dir)))
-
-(defun elmo-msgdb-mark-load (dir)
- (elmo-object-load
- (expand-file-name elmo-msgdb-mark-filename dir)))
-
(defsubst elmo-msgdb-seen-load (dir)
(elmo-object-load (expand-file-name
elmo-msgdb-seen-filename
dir)))
-(defun elmo-msgdb-number-save (dir obj)
- (elmo-object-save
- (expand-file-name elmo-msgdb-number-filename dir)
- obj))
-
-(defun elmo-msgdb-mark-save (dir obj)
- (elmo-object-save
- (expand-file-name elmo-msgdb-mark-filename dir)
- obj))
-
(defsubst elmo-msgdb-out-of-date-messages (msgdb)
(dolist (number (elmo-msgdb-list-flagged msgdb 'new))
(elmo-msgdb-unset-flag msgdb number 'new)))
-(defsubst elmo-msgdb-overview-save (dir overview)
- (elmo-object-save
- (expand-file-name elmo-msgdb-overview-filename dir)
- overview))
-
-(defun elmo-msgdb-match-condition (msgdb condition number numbers)
- "Check whether the condition of the message is satisfied or not.
-MSGDB is the msgdb to search from.
-CONDITION is the search condition.
-NUMBER is the message number to check.
-NUMBERS is the target message number list.
-Return CONDITION itself if no entity exists in msgdb."
- (let ((entity (elmo-msgdb-message-entity msgdb number)))
- (if entity
- (elmo-msgdb-match-condition-internal condition
- entity
- (elmo-msgdb-flags msgdb number)
- numbers)
- condition)))
-
-;; entity -> parent-entity
-(defsubst elmo-msgdb-overview-get-parent-entity (entity database)
- (setq entity (elmo-msgdb-overview-entity-get-references entity))
- ;; entity is parent-id.
- (and entity (assoc entity database)))
-
-(defsubst elmo-msgdb-get-parent-entity (entity msgdb)
- (setq entity (elmo-msgdb-overview-entity-get-references entity))
- ;; entity is parent-id.
- (and entity (elmo-msgdb-message-entity msgdb entity)))
-
;;
;; deleted message handling
;;
elmo-msgdb-directory)
alist))
-(defun elmo-msgdb-get-message-id-from-buffer ()
- (let ((msgid (elmo-field-body "message-id")))
- (if msgid
- (if (string-match "<\\(.+\\)>$" msgid)
- msgid
- (concat "<" msgid ">")) ; Invaild message-id.
- ;; no message-id, so put dummy msgid.
- (concat "<" (timezone-make-date-sortable
- (elmo-field-body "date"))
- (nth 1 (eword-extract-address-components
- (or (elmo-field-body "from") "nobody"))) ">"))))
-
-(defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
- "Create overview entity from current buffer.
-Header region is supposed to be narrowed."
- (save-excursion
- (let ((extras elmo-msgdb-extra-fields)
- (default-mime-charset default-mime-charset)
- message-id references from subject to cc date
- extra field-body charset)
- (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"))))
- (setq 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" " "))
- (setq date (or (elmo-field-body "date") time))
- (setq to (mapconcat 'identity (elmo-multiple-field-body "to") ","))
- (setq cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
- (or size
- (if (setq size (elmo-field-body "content-length"))
- (setq size (string-to-int size))
- (setq size 0)));; No mean...
- (while extras
- (if (setq field-body (elmo-field-body (car extras)))
- (setq extra (cons (cons (downcase (car extras))
- field-body) extra)))
- (setq extras (cdr extras)))
- (cons message-id (vector number references
- from subject date to cc
- size extra))
- )))
-
-(defsubst elmo-msgdb-insert-file-header (file)
- "Insert the header of the article."
- (let ((beg 0)
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- format-alist)
- (when (file-exists-p file)
- ;; Read until header separator is found.
- (while (and (eq elmo-msgdb-file-header-chop-length
- (nth 1
- (insert-file-contents-as-binary
- file nil beg
- (incf beg elmo-msgdb-file-header-chop-length))))
- (prog1 (not (search-forward "\n\n" nil t))
- (goto-char (point-max))))))))
-
-(defsubst elmo-msgdb-create-overview-entity-from-file (number file)
- (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook header-end
- (attrib (file-attributes file))
- ret-val size mtime)
- (with-temp-buffer
- (if (not (file-exists-p file))
- ()
- (setq size (nth 7 attrib))
- (setq mtime (timezone-make-date-arpa-standard
- (current-time-string (nth 5 attrib)) (current-time-zone)))
- ;; insert header from file.
- (catch 'done
- (condition-case nil
- (elmo-msgdb-insert-file-header file)
- (error (throw 'done nil)))
- (goto-char (point-min))
- (setq header-end
- (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
- (point)
- (point-max)))
- (narrow-to-region (point-min) header-end)
- (elmo-msgdb-create-overview-from-buffer number size mtime))))))
-
(defsubst elmo-folder-get-info (folder &optional hashtb)
(elmo-get-hash-val folder
(or hashtb elmo-folder-info-hashtb)))
elmo-msgdb-location-filename
dir) alist))
+;;; For backward compatibility.
+(defsubst elmo-msgdb-overview-entity-get-number (entity)
+ (elmo-message-entity-number entity))
+
+(defsubst elmo-msgdb-overview-entity-set-number (entity number)
+ (elmo-message-entity-set-number entity number))
+
+(defsubst elmo-msgdb-overview-entity-get-references (entity)
+ (elmo-message-entity-field entity 'references))
+
+(defsubst elmo-msgdb-overview-entity-set-references (entity references)
+ (elmo-message-entity-set-field entity 'references references))
+
+(defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string
+ (elmo-message-entity-field entity 'from) elmo-mime-charset)))
+
+(defsubst elmo-msgdb-overview-entity-get-from (entity)
+ (elmo-message-entity-field entity 'from))
+
+(defsubst elmo-msgdb-overview-entity-set-from (entity from)
+ (elmo-message-entity-set-field entity 'from from))
+
+(defsubst elmo-msgdb-overview-entity-get-subject (entity)
+ (elmo-message-entity-field entity 'subject))
+
+(defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string
+ (elmo-message-entity-field entity 'subject) elmo-mime-charset)))
+
+(defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
+ (elmo-message-entity-set-field entity 'subject subject))
+
+(defsubst elmo-msgdb-overview-entity-get-date (entity)
+ (elmo-message-entity-field entity 'date 'string))
+
+(defsubst elmo-msgdb-overview-entity-set-date (entity date)
+ (elmo-message-entity-set-field entity 'date date))
+
+(defsubst elmo-msgdb-overview-entity-get-to (entity)
+ (elmo-message-entity-field entity 'to 'string))
+
+(defsubst elmo-msgdb-overview-entity-get-cc (entity)
+ (elmo-message-entity-field entity 'cc 'string))
+
+(defsubst elmo-msgdb-overview-entity-get-size (entity)
+ (elmo-message-entity-field entity 'size))
+
+(defsubst elmo-msgdb-overview-entity-set-size (entity size)
+ (elmo-message-entity-set-field entity 'size size))
+
+(defsubst elmo-msgdb-overview-entity-get-extra (entity)
+ ;; Truely obsolete.
+ )
+
+(defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
+ ;; Truely obsolete.
+ )
+
+(defsubst elmo-msgdb-overview-entity-get-extra-field (entity
+ field-name)
+ (elmo-message-entity-field entity (intern field-name)))
+
+(defsubst elmo-msgdb-overview-entity-set-extra-field (entity
+ field-name
+ value)
+ (elmo-message-entity-set-field entity (intern field-name) value))
+
(require 'product)
(product-provide (provide 'elmo-msgdb) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff