* modb-standard.el (modb-standard): Added slot `overview-handler'.
(modb-standard-save-entity-1): Use `modb-entity-handler-equal-p'
and `modb-entity-handler-dump-parameters'.
(modb-standard-default-entity-handler): Abolish.
(elmo-msgdb-message-entity-handler): Save created handler by
instance slot.
* modb-entity.el (modb-entity-handler): Added slot `mime-charset'.
(modb-entity-handler-list-parameters): New method.
(modb-entity-handler-equal-p): New function.
(modb-entity-handler-dump-parameters): Ditto.
(modb-entity-parse-address-string): Encode return value.
(modb-entity-make-address-string): Decode argument value.
(modb-entity-decode-string-recursive): New function.
(modb-entity-encode-string-recursive): Ditto.
(modb-standard-entity-normalizer): Set to encode field value.
(modb-standard-entity-specializer): Follow the above change.
(modb-standard-entity-set-field): Bind `elmo-mime-charset' by
mime-charset of handler.
(elmo-msgdb-message-entity-field): Ditto.
(elmo-msgdb-copy-message-entity): Fixed reference to internal
structure.
(modb-entity-make-mailing-list-info-string): Decode `ml-name'.
* elmo.el (elmo-folder): Added slot `mime-charset'.
(elmo-make-folder): Added argument `mime-charset'.
(elmo-folder-msgdb-load): Call `elmo-load-msgdb' with
`mime-charest'.
* elmo-msgdb.el (elmo-load-msgdb): Added argument `mime-charset'.
(elmo-make-msgdb): Likewise.
* elmo-internal.el (elmo-internal-folder-initialize): Call
`luna-make-entity' with :mime-charset parameter.
* wl-summary.el (wl-summary-buffer-set-folder): Use
`wl-folder-mime-charset'.
* wl-folder.el (wl-draft-get-folder): Call `elmo-make-folder' with
`mime-charset'.
(wl-folder-get-elmo-folder): Ditto.
(wl-folder-mime-charset): New function.
+2005-03-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * modb.el (modb-generic): Added slot `mime-charset'.
+
+ * modb-standard.el (modb-standard): Added slot `overview-handler'.
+ (modb-standard-save-entity-1): Use `modb-entity-handler-equal-p'
+ and `modb-entity-handler-dump-parameters'.
+ (modb-standard-default-entity-handler): Abolish.
+ (elmo-msgdb-message-entity-handler): Save created handler by
+ instance slot.
+
+ * modb-entity.el (modb-entity-handler): Added slot `mime-charset'.
+ (modb-entity-handler-list-parameters): New method.
+ (modb-entity-handler-equal-p): New function.
+ (modb-entity-handler-dump-parameters): Ditto.
+ (modb-entity-parse-address-string): Encode return value.
+ (modb-entity-make-address-string): Decode argument value.
+ (modb-entity-decode-string-recursive): New function.
+ (modb-entity-encode-string-recursive): Ditto.
+ (modb-standard-entity-normalizer): Set to encode field value.
+ (modb-standard-entity-specializer): Follow the above change.
+ (modb-standard-entity-set-field): Bind `elmo-mime-charset' by
+ mime-charset of handler.
+ (elmo-msgdb-message-entity-field): Ditto.
+ (elmo-msgdb-copy-message-entity): Fixed reference to internal
+ structure.
+ (modb-entity-make-mailing-list-info-string): Decode `ml-name'.
+
+ * elmo.el (elmo-folder): Added slot `mime-charset'.
+ (elmo-make-folder): Added argument `mime-charset'.
+ (elmo-folder-msgdb-load): Call `elmo-load-msgdb' with
+ `mime-charest'.
+
+ * elmo-msgdb.el (elmo-load-msgdb): Added argument `mime-charset'.
+ (elmo-make-msgdb): Likewise.
+
+ * elmo-internal.el (elmo-internal-folder-initialize): Call
+ `luna-make-entity' with :mime-charset parameter.
+
2005-03-21 Yuuichi Teranishi <teranisi@gohome.org>
* elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string): Decode
:type sym
:prefix (elmo-folder-prefix-internal folder)
:name (elmo-folder-name-internal folder)
- :persistent (elmo-folder-persistent-internal folder))
+ :persistent (elmo-folder-persistent-internal folder)
+ :mime-charset (elmo-folder-mime-charset-internal folder))
name)
folder)))
;;; MSGDB interface.
;;
-;; MSGDB elmo-load-msgdb PATH
+;; MSGDB elmo-load-msgdb PATH MIME-CHARSET
;; MSGDB elmo-make-msgdb LOCATION TYPE
;; elmo-msgdb-sort-by-date MSGDB
;;; 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)))
+ :location location
+ :mime-charset mime-charset)))
(defun elmo-msgdb-sort-by-date (msgdb)
(elmo-msgdb-sort-entities
persistent ; non-nil if persistent.
process-duplicates ; read or hide
biff ; folder for biff
+ mime-charset ; charset for encode & decode
))
(luna-define-internal-accessors 'elmo-folder))
(` (luna-send (, folder) (, message) (, folder) (,@ args))))
;;;###autoload
-(defun elmo-make-folder (name &optional non-persistent)
+(defun elmo-make-folder (name &optional non-persistent mime-charset)
"Make an ELMO folder structure specified by NAME.
-If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved."
+If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved.
+If optional argument MIME-CHARSET is specified, it is used for
+encode and decode a multibyte string."
(let ((type (elmo-folder-type name))
prefix split class folder original)
(setq original (elmo-string name))
:type type
:prefix prefix
:name original
- :persistent (not non-persistent)))
+ :persistent (not non-persistent)
+ :mime-charset mime-charset))
(save-match-data
(elmo-folder-send folder 'elmo-folder-initialize name))))
(defun elmo-folder-msgdb-load (folder &optional silent)
(unless silent
(message "Loading msgdb for %s..." (elmo-folder-name-internal folder)))
- (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder))))
+ (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder)
+ (elmo-folder-mime-charset-internal folder))))
(elmo-folder-set-info-max-by-numdb
folder
(elmo-msgdb-list-messages msgdb))
(require 'elmo-vars)
(require 'elmo-util)
-(eval-and-compile (luna-define-class modb-entity-handler))
+(eval-and-compile
+ (luna-define-class modb-entity-handler () (mime-charset))
+ (luna-define-internal-accessors 'modb-entity-handler))
(defcustom modb-entity-default-handler 'modb-legacy-entity-handler
"Default entity handler."
(setq modb-entity-default-cache-internal
(luna-make-entity modb-entity-default-handler)))))
+(luna-define-generic modb-entity-handler-list-parameters (handler)
+ "Return a parameter list of HANDLER.")
+
(luna-define-generic elmo-msgdb-make-message-entity (handler &rest args)
"Make a message entity using HANDLER.")
"Return non-nil when the entity matches the condition.")
;; Generic implementation.
+(luna-define-method modb-entity-handler-list-parameters
+ ((handler modb-entity-handler))
+ (list 'mime-charset))
+
(luna-define-method elmo-msgdb-create-message-entity-from-file
((handler modb-entity-handler) number file)
(let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
(setq updated t)))
updated))
+(defun modb-entity-handler-equal-p (handler other)
+ "Return non-nil, if OTHER hanlder is equal this HANDLER."
+ (and (eq (luna-class-name handler)
+ (luna-class-name other))
+ (catch 'mismatch
+ (dolist (slot (modb-entity-handler-list-parameters handler))
+ (when (not (equal (luna-slot-value handler slot)
+ (luna-slot-value other slot)))
+ (throw 'mismatch nil)))
+ t)))
+
+(defun modb-entity-handler-dump-parameters (handler)
+ "Return parameters for reconstruct HANDLER as plist."
+ (apply #'nconc
+ (mapcar (lambda (slot)
+ (let ((value (luna-slot-value handler slot)))
+ (when value
+ (list (intern (concat ":" (symbol-name slot)))
+ value))))
+ (modb-entity-handler-list-parameters handler))))
;; field in/out converter
(defun modb-set-field-converter (converter type &rest specs)
(symbol-name field))))
(defun modb-entity-parse-address-string (field value)
- (if (stringp value)
- (elmo-parse-addresses value)
- value))
+ (modb-entity-encode-string-recursive
+ field
+ (if (stringp value)
+ (elmo-parse-addresses value)
+ value)))
(defun modb-entity-make-address-string (field value)
- (if (stringp value)
- value
- (mapconcat 'identity value ", ")))
+ (let ((value (modb-entity-decode-string-recursive field value)))
+ (if (stringp value)
+ value
+ (mapconcat 'identity value ", "))))
+
+(defun modb-entity-decode-string-recursive (field value)
+ (cond ((stringp value)
+ (elmo-msgdb-get-decoded-cache value))
+ ((consp value)
+ (setcar value (modb-entity-decode-string-recursive field (car value)))
+ (setcdr value (modb-entity-decode-string-recursive field (cdr value)))
+ value)
+ (t
+ value)))
+
+(defun modb-entity-encode-string-recursive (field value)
+ (cond ((stringp value)
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string value elmo-mime-charset)))
+ ((consp value)
+ (setcar value (modb-entity-encode-string-recursive field (car value)))
+ (setcdr value (modb-entity-encode-string-recursive field (cdr value)))
+ value)
+ (t
+ value)))
(defun modb-entity-create-field-indices (slots)
(defvar modb-standard-entity-normalizer nil)
(modb-set-field-converter 'modb-standard-entity-normalizer nil
- 'date #'modb-entity-parse-date-string
- 'to #'modb-entity-parse-address-string
- 'cc #'modb-entity-parse-address-string
- t nil)
+ 'messgae-id nil
+ 'number nil
+ 'date #'modb-entity-parse-date-string
+ 'to #'modb-entity-parse-address-string
+ 'cc #'modb-entity-parse-address-string
+ 'references nil
+ 'size nil
+ 'score nil
+ t #'modb-entity-encode-string-recursive)
(defvar modb-standard-entity-specializer nil)
-(modb-set-field-converter 'modb-standard-entity-specializer nil t nil)
+(modb-set-field-converter 'modb-standard-entity-specializer nil
+ 'messgae-id nil
+ 'number nil
+ 'date nil
+ 'references nil
+ 'size nil
+ 'score nil
+ t #'modb-entity-decode-string-recursive)
(modb-set-field-converter 'modb-standard-entity-specializer 'string
+ 'messgae-id nil
+ 'number nil
'date #'modb-entity-make-date-string
'to #'modb-entity-make-address-string
'cc #'modb-entity-make-address-string
+ 'references nil
+ 'size nil
+ 'score nil
'ml-info #'modb-entity-make-mailing-list-info-string
- t nil)
+ t #'modb-entity-decode-string-recursive)
(defmacro modb-standard-entity-field-index (field)
`(cdr (assq ,field modb-standard-entity-field-indices)))
(when entity
(let (index)
(unless as-is
- (setq value (modb-convert-field-value modb-standard-entity-normalizer
- field value)))
+ (let ((elmo-mime-charset
+ (or (modb-entity-handler-mime-charset-internal (car entity))
+ elmo-mime-charset)))
+ (setq value (modb-convert-field-value modb-standard-entity-normalizer
+ field value))))
(cond ((memq field '(message-id :message-id))
(setcar (cdr entity) value))
((setq index (modb-standard-entity-field-index field))
(luna-define-method elmo-msgdb-message-entity-field
((handler modb-standard-entity-handler) entity field &optional type)
(and entity
- (let (index)
+ (let ((elmo-mime-charset
+ (or (modb-entity-handler-mime-charset-internal handler)
+ elmo-mime-charset))
+ index)
(modb-convert-field-value
modb-standard-entity-specializer
field
(copy-sequence modb-standard-entity-field-slots))
(mapcar 'car
(aref
- (cdr entity)
+ (cdr (cdr entity))
(modb-standard-entity-field-index :extra)))
'(message-id)))
(elmo-msgdb-message-entity-set-field
(defun modb-entity-make-mailing-list-info-string (field value)
(when (car value)
(format (if (cdr value) "(%s %05.0f)" "(%s)")
- (car value) (cdr value))))
+ (elmo-msgdb-get-decoded-cache (car value))
+ (cdr value))))
(require 'product)
(product-provide (provide 'modb-entity) (require 'elmo-version))
entity-map ; number, msg-id -> entity mapping.
flag-map ; number -> flag-list mapping
flag-count ; list of (FLAG . COUNT)
+ overview-handler ; instance of modb-entity-handler.
))
(luna-define-internal-accessors 'modb-standard))
number msgid)
(cond ((eq (car objects) 'modb-standard-entity-handler)
;; (standard PARAMETERS ENTITY*)
- ;; PARAMETERS is nil (reserved for future extention).
(let ((handler (apply #'luna-make-entity
(car objects)
(car (cdr objects))))
(dolist (number (or (cdr section)
(modb-standard-number-list-internal modb)))
(when (setq entity (elmo-msgdb-message-entity modb number))
- (unless (eq (luna-class-name (elmo-message-entity-handler entity))
- (luna-class-name handler))
+ (unless (modb-entity-handler-equal-p
+ handler
+ (elmo-message-entity-handler entity))
(setq entity (elmo-msgdb-copy-message-entity
(elmo-message-entity-handler entity)
entity handler)))
(setq entities (cons (cdr (cdr entity)) entities))))
(if entities
(elmo-object-save filename
- (cons (luna-class-name handler) (cons nil entities))
- elmo-mime-charset)
+ (nconc
+ (list (luna-class-name handler)
+ (modb-entity-handler-dump-parameters handler))
+ entities))
(ignore-errors (delete-file filename)))))
(defun modb-standard-save-entity (modb path)
((numberp key) (modb-standard-key key)))
'autoload)))
-(defvar modb-standard-default-entity-handler nil)
-
(luna-define-method elmo-msgdb-message-entity-handler ((msgdb modb-standard))
- (or modb-standard-default-entity-handler
- (setq modb-standard-default-entity-handler
- (luna-make-entity 'modb-standard-entity-handler))))
+ (or (modb-standard-overview-handler-internal msgdb)
+ (modb-standard-set-overview-handler-internal
+ msgdb
+ (luna-make-entity 'modb-standard-entity-handler
+ :mime-charset
+ (modb-generic-mime-charset-internal msgdb)))))
(require 'product)
(product-provide (provide 'modb-standard) (require 'elmo-version))
(require 'modb-entity)
(eval-and-compile
- (luna-define-class modb-generic () (location ; location for save.
+ (luna-define-class modb-generic () (location ; location for save.
message-modified ; message is modified.
flag-modified ; flag is modified.
+ mime-charset ; for encode & decode.
))
(luna-define-internal-accessors 'modb-generic))
+2005-03-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-buffer-set-folder): Use
+ `wl-folder-mime-charset'.
+
+ * wl-folder.el (wl-draft-get-folder): Call `elmo-make-folder' with
+ `mime-charset'.
+ (wl-folder-get-elmo-folder): Ditto.
+ (wl-folder-mime-charset): New function.
+
2005-03-20 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
* wl-util.el (wl-parse-addresses): Define alias of
(string= (elmo-folder-name-internal wl-draft-folder-internal)
wl-draft-folder))
wl-draft-folder-internal
- (setq wl-draft-folder-internal (elmo-make-folder wl-draft-folder))
+ (setq wl-draft-folder-internal (elmo-make-folder
+ wl-draft-folder
+ nil
+ (wl-folder-mime-charset wl-draft-folder)))
(wl-folder-confirm-existence wl-draft-folder-internal)
(elmo-folder-open wl-draft-folder-internal 'load-msgdb)
wl-draft-folder-internal))
-(defmacro wl-folder-get-elmo-folder (entity &optional no-cache)
+(defun wl-folder-mime-charset (folder-name)
+ (or (wl-get-assoc-list-value wl-folder-mime-charset-alist folder-name)
+ wl-mime-charset))
+
+(defsubst wl-folder-get-elmo-folder (entity &optional no-cache)
"Get elmo folder structure from ENTITY."
- `(if ,no-cache
- (elmo-make-folder (elmo-string ,entity))
- (if (string= (elmo-string ,entity) wl-draft-folder)
- (wl-draft-get-folder)
- (or (wl-folder-elmo-folder-cache-get ,entity)
- (let* ((name (elmo-string ,entity))
- (folder (elmo-make-folder name)))
- (wl-folder-elmo-folder-cache-put name folder)
- folder)))))
+ (let ((name (elmo-string entity)))
+ (if no-cache
+ (elmo-make-folder name nil (wl-folder-mime-charset name))
+ (if (string= name wl-draft-folder)
+ (wl-draft-get-folder)
+ (or (wl-folder-elmo-folder-cache-get name)
+ (let ((folder (elmo-make-folder name
+ nil
+ (wl-folder-mime-charset name))))
+ (wl-folder-elmo-folder-cache-put name folder)
+ folder))))))
(defsubst wl-folder-put-folder-property (beg end id is-group &optional object)
(put-text-property beg end 'wl-folder-entity-id id object)
(setq folder (wl-folder-get-elmo-folder folder)))
(setq wl-summary-buffer-elmo-folder folder)
(make-local-variable 'wl-message-buffer)
- (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value
- wl-folder-mime-charset-alist
- (elmo-folder-name-internal folder))
- wl-mime-charset))
+ (setq wl-summary-buffer-mime-charset (wl-folder-mime-charset
+ (elmo-folder-name-internal folder)))
(setq wl-summary-buffer-weekday-name-lang
(or (wl-get-assoc-list-value
wl-folder-weekday-name-lang-alist
projects / elisp / wanderlust.git / commitdiff