2_14-4'.
Wanderlust NEWS -- User-visible changes in Wanderlust.
-* Changes in 2.14.0 from 2.12.x
+* Changes in 2.14.1 from 2.14.0
+ Version 2.14.1 is a bug fix version of 2.14.0.
+
+** Fixed message order of Maildir.
+
+** Icon for the access folder is displayed.
+
+* Changes in 2.14.0 from 2.12.2
** New folder type `access' is added.
+ In `access' folder, sub-folders of the specified folder can be treated
+ as one folder.
+
+** Synchronization speed of the folder is improved.
+ The function which calculates list diff is re-wrote and is faster
+ than previous implementation, especially in the folders with large
+ number of the messages.
+
+** New event handling mechanism is incorporated.
+
+** Improved the disconnected operations for IMAP draft saving.
+ There was a bug of message numbering in the disconnected imap draft.
+ It is fixed using new event handling mechanism.
+
+** `Shimbun' summary buffers are updated dynamically.
+ Some shimbun folder does not have correct information.
+ In this version, they are corrected using the message body after retrieval.
+ It is implemented with new event handling mechanism.
+
+** Many bug fixes.
* Changes in 2.12.1 from 2.12.0
Version 2.12.1 is a bug fix version of 2.12.0.
Wanderlust NEWS (\e$BF|K\8lHG\e(B) -- User-visible changes in Wanderlust.
-* 2.12.x \e$B$+$i\e(B 2.14.0 \e$B$X$NJQ99E@\e(B
+* 2.14.0 \e$B$+$i\e(B 2.14.1 \e$B$X$NJQ99E@\e(B
+ 2.14.1 \e$B$O!"\e(B2.14.0 \e$B$N%P%0=$@5HG$G$9!#\e(B
+
+** Maildir \e$B$GI=<(=g=x$,@5$7$/$J$$%P%0$,=$@5$5$l$^$7$?!#\e(B
+
+** \e$B%"%/%;%9%U%)%k%@$N%"%$%3%s$,I=<($5$l$^$9!#\e(B
+
+* 2.12.2 \e$B$+$i\e(B 2.14.0 \e$B$X$NJQ99E@\e(B
** \e$B?7$7$$%U%)%k%@7?\e(B access \e$B%U%)%k%@$,DI2C$5$l$^$7$?!#\e(B
+ \e$B;XDj$5$l$?%U%)%k%@$NG[2<$N%5%V%U%)%k%@$r2>A[E*$K0l$D$N%U%)%k%@$H$7$F07$(\e(B
+ \e$B$k$h$&$K$9$k%U%)%k%@$G$9!#\e(B
+
+** \e$B%U%)%k%@$N%"%C%W%G!<%H$,9bB.2=$5$l$^$7$?!#\e(B
+ \e$B%j%9%H$N:9J,$r7W;;$9$k4X?t$,=q$-D>$5$l!"FC$KB?$/$N%a%C%;!<%8$r4^$`%U%)\e(B
+ \e$B%k%@$G$NF0:n$,9bB.$K$J$j$^$7$?!#\e(B
+
+** \e$B?7$7$$%$%Y%s%H%O%s%I%j%s%05!G=$,DI2C$5$l$^$7$?!#\e(B
+
+** \e$B%I%i%U%H%U%)%k%@$K\e(B IMAP \e$B%U%)%k%@$r;XDj$7$F$$$k>l9g$NIT6q9g$,2~A1$5$l$^$7$?!#\e(B
+ \e$B%*%U%i%$%s>uBV$G%I%i%U%H$rJ]B8$9$k$H$-$N5sF0$K%P%0$,$"$j$^$7$?$,!"?7$7$$\e(B
+ \e$B%$%Y%s%H%O%s%I%j%s%05!G=$rMQ$$$F=$@5$5$l$^$7$?!#\e(B
+
+** `Shimbun' \e$B$N%5%^%j$,F0E*$K99?7$5$l$^$9!#\e(B
+ \e$B$$$/$D$+$N\e(B shimbun \e$B%U%)%k%@$O!"%5%^%j$N>pJs$,@5$7$/$"$j$^$;$s!#\e(B
+ \e$B$3$N%P!<%8%g%s$+$i!"%a%C%;!<%8$r<h$j$h$;$?$H$-$N>pJs$rMQ$$$F%5%^%j$,\e(B
+ \e$B<+F0E*$K=$@5$5$l$k$h$&$K$J$j$^$7$?!#$3$N<BAu$K$O!"?7$7$$%$%Y%s%H%O%s%I\e(B
+ \e$B%j%s%05!G=$,MQ$$$i$l$F$$$^$9!#\e(B
+
+** \e$B$=$NB>B?$/$N%P%0=$@5!#\e(B
* 2.12.0 \e$B$+$i\e(B 2.12.1 \e$B$X$NJQ99E@\e(B
2.12.1 \e$B$O!"\e(B2.12.0 \e$B$N%P%0=$@5HG$G$9!#\e(B
-\def\versionnumber{2.13.3}
+\def\versionnumber{2.15.1}
-@set VERSION 2.13.3
+@set VERSION 2.15.1
+2005-04-05 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-maildir.el (elmo-maildir-sequence-number): New function.
+ (elmo-maildir-make-unique-string): Throw Emacs 18 away.
+ (elmo-maildir-list-location): Use `elmo-maildir-sequence-number' to
+ compare sequence number when last modified time is nil.
+
+2005-04-03 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-maildir.el (elmo-folder-msgdb-create): Don't sort by date.
+
+ * elmo-shimbun.el (elmo-folder-msgdb-create): Ditto.
+
+2005-04-01 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-maildir.el (elmo-maildir-list-location): Sort by last
+ modification time of the file.
+
+2005-03-28 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-condition-optimize): Discriminated against
+ preserved fields, extra fields and the other weight.
+
+2005-03-27 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * modb-entity.el (initialize-instance): Define.
+ (modb-entity-handler-mime-charset): New internal function.
+ (modb-standard-entity-set-field): Use it.
+ (elmo-msgdb-message-entity-field): Ditto.
+ (elmo-msgdb-message-entity-field): Ditto.
+
+ * modb.el (elmo-msgdb-match-condition): Rewrite with
+ `elmo-condition-match'.
+ (elmo-msgdb-match-condition-primitive): New function.
+
+ * modb-entity.el (elmo-msgdb-message-match-condition): Removed
+ arguments `flags' and `numbers'.
+ (elmo-msgdb-match-condition-primitive): Abolished (merged to
+ `elmo-msgdb-message-match-condition').
+ (modb-buffer-entity-handler): New class.
+
+ * elmo.el (elmo-folder-search): Optimize condition to use
+ `elmo-condition-optimize'.
+ (elmo-message-buffer-match-condition): New function.
+ (elmo-message-match-condition): Use
+ `elmo-message-buffer-match-condition' instead of
+ `elmo-buffer-field-condition-match'.
+
+ * elmo-util.el (elmo-condition-match): New function.
+ (elmo-condition-optimize): Ditto.
+ (elmo-buffer-field-primitive-condition-match): Abolish.
+ (elmo-buffer-field-condition-match): Ditto.
+
+ * elmo-archive.el (elmo-archive-field-condition-match): Use
+ `elmo-message-buffer-match-condition' instead of
+ `elmo-buffer-field-condition-match'.
+
+2005-03-25 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-flag.el (elmo-global-flags-initialize): Check the
+ existence of the flag directory.
+
+2005-03-23 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-access.el (elmo-folder-initialize): Call
+ `elmo-multi-connect-signals'.
+
+ * elmo-pipe.el (elmo-folder-close): Define.
+
+ * elmo-multi.el (elmo-folder-close): Call `elmo-folder-close' with
+ children folders.
+
+ * elmo-filter.el (elmo-folder-close): Call `elmo-folder-close'
+ with target folder.
+
+ * modb-entity.el (elmo-msgdb-message-entity-set-number): Return
+ `number'.
+
+ * elmo-multi.el (elmo-message-entity): Don't use return value of
+ `elmo-message-entity-set-number'.
+
+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
+ encoded words in `from' and `subject' field.
+
+2005-03-20 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * modb.el (elmo-msgdb-message-field): Add argument `type'.
+ (elmo-msgdb-match-condition): Get handler from entity instead of
+ msgdb.
+
+ * modb-standard.el (modb-standard-economize-entity-size): Abolish.
+ (modb-standard-load-entity): Treat new file format.
+ (modb-standard-save-entity-1): Save as new file format.
+ (modb-standard-save-entity): Split messages into section here.
+ (elmo-msgdb-message-field): Follow the API change.
+ (modb-standard-default-entity-handler): New internal variable.
+ (elmo-msgdb-message-entity-handler): Define.
+
+ * modb-entity.el (elmo-msgdb-prefer-in-reply-to-for-parent): Moved
+ to `elmo-vars.el'.
+ (modb-entity-field-extractor-alist): New user option.
+ (elmo-msgdb-message-entity-field): Removed argument `decode' and
+ added argument `type'.
+ (elmo-msgdb-copy-message-entity): Add optional argument
+ `make-handler'.
+ (modb-set-field-converter): New function.
+ (modb-convert-field-value): Ditto.
+ (modb-entity-string-decoder): Ditto.
+ (modb-entity-string-encoder): Ditto.
+ (modb-entity-parse-date-string): Ditto.
+ (modb-entity-make-date-string): Ditto.
+ (modb-entity-mime-decoder): Ditto.
+ (modb-entity-mime-encoder): Ditto.
+ (modb-entity-address-list-decoder): Ditto.
+ (modb-entity-address-list-encoder): Ditto.
+ (modb-entity-parse-address-string): Ditto.
+ (modb-entity-make-address-string): Ditto.
+ (modb-entity-create-field-indices): Ditto.
+ (modb-legacy-entity-field-slots): New constant.
+ (modb-legacy-entity-field-indices): Ditto.
+ (modb-legacy-entity-normalizer): New variable.
+ (modb-legacy-entity-specializer): Ditto.
+ (modb-legacy-entity-field-index): New macro.
+ (modb-legacy-entity-set-field): New function.
+ (modb-legacy-make-message-entity): Rewrite.
+ (elmo-msgdb-create-message-entity-from-buffer): Use
+ `elmo-msgdb-get-references-from-buffer'. Use
+ `elmo-decoded-field-body' instead of `elmo-unfold-field-body'.
+ Use `modb-legacy-entity-set-field' instead of
+ `elmo-msgdb-message-entity-set-field'.
+ (elmo-msgdb-message-entity-field): Rewrite.
+ (elmo-msgdb-message-entity-set-field): Ditto.
+ (elmo-msgdb-copy-message-entity): Make new entity by
+ `make-handler' if it specified.
+ (elmo-msgdb-message-match-condition): Define a method of
+ `modb-entity-handler' and follow the API change.
+ (modb-standard-entity-handler): New class.
+ (modb-entity-extract-ml-info-from-x-sequence): New function.
+ (modb-entity-extract-ml-info-from-subject): Ditto.
+ (modb-entity-extract-ml-info-from-return-path): Ditto.
+ (modb-entity-extract-ml-info-from-delivered-to): Ditto.
+ (modb-entity-extract-ml-info-from-mailing-list): Ditto.
+ (modb-entity-extract-mailing-list-info): Ditto.
+ (modb-entity-extract-mailing-list-info-functions): New variable.
+
+ * elmo.el (elmo-message-field): Add optional argument `type'.
+
+ * elmo-vars.el (elmo-msgdb-prefer-in-reply-to-for-parent): Moved
+ from `modb-entity.el'.
+
+ * elmo-util.el (elmo-object-load): Decode by coding-system from
+ `set-auto-coding-function'.
+ (elmo-object-save): Use `detect-mime-charset-region' and add
+ coding cookie if encode.
+ (elmo-msgdb-get-references-from-buffer): New function.
+ (elmo-parse-addresses): Ditto (renamed from `wl-parse-addresses').
+
+ * elmo-spam.el (elmo-spam-message-spam-p): Follow the API change.
+
+ * elmo-shimbun.el (elmo-shimbun-parse-time-string): Removed.
+ (elmo-shimbun-entity-to-header): Use `shimbun-create-header'
+ instead of `shimbun-make-header' and follow the API change.
+ (elmo-shimbun-update-overview): Follow the API change.
+ (elmo-map-folder-list-message-locations): Ditto.
+
+ * elmo-pipe.el (elmo-message-field): Ditto.
+
+ * elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string):
+ Ditto.
+
+ * elmo-nmz.el (elmo-nmz-msgdb-create-entity): Ditto.
+
+ * elmo-multi.el (elmo-message-field): Ditto.
+
+ * elmo-msgdb.el (elmo-message-entity-field): Ditto.
+ (elmo-msgdb-sort-by-date): Ditto.
+ (elmo-msgdb-flag-table): Use `elmo-msgdb-message-field' instead of
+ `elmo-message-entity-field'.
+ (elmo-msgdb-overview-entity-get-from-no-decode): Follow the API
+ change.
+ (elmo-msgdb-overview-entity-get-from): Ditto.
+ (elmo-msgdb-overview-entity-get-subject): Ditto.
+ (elmo-msgdb-overview-entity-get-subject-no-decode): Ditto.
+ (elmo-msgdb-overview-entity-get-date): Ditto.
+ (elmo-msgdb-overview-entity-get-to): Ditto.
+ (elmo-msgdb-overview-entity-get-cc): Ditto.
+
+ * elmo-mime.el (elmo-message-mime-entity): Ditto.
+ (elmo-mime-collect-message/partial-pieces): Ditto.
+
+ * elmo-filter.el (elmo-message-field): Ditto.
+
+ * elmo-date.el (elmo-datevec-to-time): New function.
+ (elmo-time-parse-date-string): Ditto.
+ (elmo-time-make-date-string): Ditto.
+ (elmo-time<): Ditto.
+
+ * elmo-version.el (elmo-version): Up to 2.15.1.
+
+2005-03-14 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * elmo-flag.el (elmo-global-flags-initialize): Don't include
+ member of elmo-local-flags.
+
+2005-03-13 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-version.el (elmo-version): Up to 2.15.0.
+
2005-03-13 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
* elmo.el (elmo-folder-synchronize): Ignore `mask' when
folder
elmo-multi-divide-number)
(elmo-access-folder-update-children folder)
+ (elmo-multi-connect-signals folder)
folder)
(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-access-folder))
(elmo-archive-call-method method args t))
(set-buffer-multibyte default-enable-multibyte-characters)
(decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
- (elmo-buffer-field-condition-match condition number number-list))))))
+ (elmo-message-buffer-match-condition condition number))))))
(luna-define-method elmo-folder-search ((folder elmo-archive-folder)
condition &optional from-msgs)
(aref (, datevec) 4)
(aref (, datevec) 5)))))
+(defsubst elmo-datevec-to-time (datevec)
+ (encode-time (aref datevec 5) (aref datevec 4) (aref datevec 3)
+ (aref datevec 2) (aref datevec 1) (aref datevec 0)
+ (aref datevec 6)))
+
+(defun elmo-time-parse-date-string (date)
+ (ignore-errors
+ (elmo-datevec-to-time (timezone-fix-time date nil nil))))
+
+(defun elmo-time-make-date-string (time)
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %d %b %Y %T %z" time)))
+
+(defun elmo-time< (lhs rhs)
+ (while (and (car lhs) (car rhs))
+ (cond ((< (car lhs) (car rhs))
+ (setq lhs nil))
+ ((= (car lhs) (car rhs))
+ (setq lhs (cdr lhs)
+ rhs (cdr rhs)))
+ (t
+ (setq rhs nil))))
+ (not (null rhs)))
+
(require 'product)
(product-provide (provide 'elmo-date) (require 'elmo-version))
(luna-define-method elmo-folder-close-internal ((folder elmo-filter-folder))
(elmo-folder-close-internal (elmo-filter-folder-target-internal folder)))
-(luna-define-method elmo-folder-close :after ((folder elmo-filter-folder))
+(luna-define-method elmo-folder-close ((folder elmo-filter-folder))
+ (elmo-generic-folder-close folder)
(elmo-filter-folder-set-number-list-internal folder nil)
(elmo-filter-folder-set-flag-count-internal folder nil)
- (elmo-folder-set-msgdb-internal
- (elmo-filter-folder-target-internal folder) nil))
+ (elmo-folder-close (elmo-filter-folder-target-internal folder)))
(luna-define-method elmo-folder-commit ((folder elmo-filter-folder))
(elmo-folder-commit (elmo-filter-folder-target-internal folder))
(elmo-message-folder (elmo-filter-folder-target-internal folder) number))
(luna-define-method elmo-message-field ((folder elmo-filter-folder)
- number field)
+ number field &optional type)
(elmo-message-field
- (elmo-filter-folder-target-internal folder) number field))
+ (elmo-filter-folder-target-internal folder) number field type))
(luna-define-method elmo-message-set-field ((folder elmo-filter-folder)
number field value)
(defun elmo-global-flags-initialize (&optional additional-flags)
(let ((dir (expand-file-name "flag" elmo-msgdb-directory)))
(setq elmo-global-flags
- (elmo-uniq-list
- (append
- elmo-global-flags
- additional-flags
- (mapcar 'intern
- (delete ".." (delete "." (directory-files dir)))))))))
+ (elmo-list-delete
+ elmo-local-flags
+ (elmo-uniq-list
+ (append
+ elmo-global-flags
+ additional-flags
+ (and (file-directory-p dir)
+ (mapcar 'intern
+ (elmo-list-delete
+ '(".." ".")
+ (directory-files dir))))))
+ #'delq))))
;;; To migrate from global mark folder
(defvar elmo-global-mark-filename "global-mark"
: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)))
(cur (directory-files cur-dir
nil "^[^.].*$" t))
unread-locations flagged-locations answered-locations
- sym locations flag-list)
+ sym locations flag-list x-time y-time)
+ (setq cur (sort cur
+ (lambda (x y)
+ (setq x-time (elmo-get-last-modification-time
+ (expand-file-name x cur-dir))
+ y-time (elmo-get-last-modification-time
+ (expand-file-name y cur-dir)))
+ (cond
+ ((< x-time y-time)
+ t)
+ ((eq x-time y-time)
+ (< (elmo-maildir-sequence-number x)
+ (elmo-maildir-sequence-number y)))))))
(setq locations
(mapcar
(lambda (x)
'elmo-maildir-msgdb-create "Creating msgdb..."
(/ (* i 100) len)))))
(message "Creating msgdb...done")
- (elmo-msgdb-sort-by-date new-msgdb)))
+ new-msgdb))
(defun elmo-maildir-cleanup-temporal (dir)
;; Delete files in the tmp dir which are not accessed
(defvar elmo-maildir-sequence-number-internal 0)
-(static-cond
- ((>= emacs-major-version 19)
- (defun elmo-maildir-make-unique-string ()
- "This function generates a string that can be used as a unique
-file name for maildir directories."
- (let ((cur-time (current-time)))
- (format "%.0f.%d_%d.%s"
- (+ (* (car cur-time)
- (float 65536)) (cadr cur-time))
- (emacs-pid)
- (incf elmo-maildir-sequence-number-internal)
- (system-name)))))
- ((eq emacs-major-version 18)
- ;; A fake function for v18
- (defun elmo-maildir-make-unique-string ()
- "This function generates a string that can be used as a unique
+(defun elmo-maildir-sequence-number (file)
+ "Get `elmo-maildir' specific sequence number from FILE.
+Not that FILE is the name without directory."
+ ;; elmo-maildir specific.
+ (if (string-match "^.*_\\([0-9]+\\)\\..*" file)
+ (string-to-number (match-string 1 file))
+ -1))
+
+(defun elmo-maildir-make-unique-string ()
+ "This function generates a string that can be used as a unique
file name for maildir directories."
- (unless (fboundp 'float-to-string)
- (load-library "float"))
- (let ((time (current-time)))
- (format "%s%d.%d.%s"
- (substring
- (float-to-string
- (f+ (f* (f (car time))
- (f 65536))
- (f (cadr time))))
- 0 5)
- (cadr time)
- (% (abs (random t)) 10000); dummy pid
- (system-name))))))
+ (let ((cur-time (current-time)))
+ (format "%.0f.%d_%d.%s"
+ (+ (* (car cur-time)
+ (float 65536)) (cadr cur-time))
+ (emacs-pid)
+ (incf elmo-maildir-sequence-number-internal)
+ (system-name))))
(defun elmo-maildir-temporal-filename (basedir)
(let ((filename (expand-file-name
(mime-entity-content-type message) "id"))))
(elmo-message-reassembled-mime-entity
folder id rawbuf
- (elmo-message-entity-field entity 'subject 'decode)
+ (elmo-message-entity-field entity 'subject)
ignore-cache
unread))
message
(elmo-folder-do-each-message-entity (entity folder)
(when (string-match
subject-regexp
- (elmo-message-entity-field entity 'subject 'decode))
+ (elmo-message-entity-field entity 'subject))
(erase-buffer)
(let* ((message (elmo-message-mime-entity-internal
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
entity
number))
-(defsubst elmo-message-entity-field (entity field &optional decode)
+(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 DECODE is non-nil, returned value is decoded."
+If optional argument TYPE is specified, return converted value."
(elmo-msgdb-message-entity-field (elmo-message-entity-handler entity)
- entity field decode))
+ 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 (raw)."
+VALUE is the field value."
(elmo-msgdb-message-entity-set-field (elmo-message-entity-handler entity)
entity field value))
;;; 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
msgdb
(lambda (x y app-data)
(condition-case nil
- (string<
- (timezone-make-date-sortable
- (elmo-message-entity-field x 'date))
- (timezone-make-date-sortable
- (elmo-message-entity-field y 'date)))
+ (elmo-time<
+ (elmo-message-entity-field x 'date)
+ (elmo-message-entity-field y 'date))
(error)))))
(defsubst elmo-msgdb-get-parent-entity (entity msgdb)
(elmo-make-hash (elmo-msgdb-length msgdb))))
msg-id)
(dolist (number (elmo-msgdb-list-messages msgdb))
- (when (setq msg-id (elmo-message-entity-field
- (elmo-msgdb-message-entity msgdb number)
- 'message-id))
+ (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))))
(elmo-message-entity-set-field entity 'references references))
(defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
- (elmo-message-entity-field entity 'from))
+ (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 t))
+ (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 t))
+ (elmo-message-entity-field entity 'subject))
(defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
- (elmo-message-entity-field entity 'subject))
+ (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))
+ (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))
+ (elmo-message-entity-field entity 'to 'string))
(defsubst elmo-msgdb-overview-entity-get-cc (entity)
- (elmo-message-entity-field entity 'cc))
+ (elmo-message-entity-field entity 'cc 'string))
(defsubst elmo-msgdb-overview-entity-get-size (entity)
(elmo-message-entity-field entity 'size))
(dolist (fld (elmo-multi-folder-children-internal folder))
(elmo-folder-close-internal fld)))
-(luna-define-method elmo-folder-close :after ((folder elmo-multi-folder))
+(luna-define-method elmo-folder-close ((folder elmo-multi-folder))
+ (elmo-generic-folder-close folder)
(dolist (fld (elmo-multi-folder-children-internal folder))
- (elmo-folder-set-msgdb-internal fld nil)))
+ (elmo-folder-close fld)))
(luna-define-method elmo-folder-synchronize ((folder elmo-multi-folder)
&optional
(let* ((pair (elmo-multi-real-folder-number folder key))
(entity (elmo-message-entity (car pair) (cdr pair))))
(when entity
- (elmo-message-entity-set-number (elmo-message-copy-entity entity)
- key))))
+ (setq entity (elmo-message-copy-entity entity))
+ (elmo-message-entity-set-number entity key)
+ entity)))
((stringp key)
(let ((children (elmo-multi-folder-children-internal folder))
(cur-number 0)
(elmo-message-entity-field entity 'references)))
(luna-define-method elmo-message-field ((folder elmo-multi-folder)
- number field)
+ number field &optional type)
(let ((pair (elmo-multi-real-folder-number folder number)))
- (elmo-message-field (car pair) (cdr pair) field)))
+ (elmo-message-field (car pair) (cdr pair) field type)))
(luna-define-method elmo-message-flag-available-p ((folder
elmo-multi-folder) number
entity uid)
(setq entity (elmo-msgdb-create-message-entity-from-file
(elmo-msgdb-message-entity-handler msgdb) number location))
- (unless (or (> (length (elmo-message-entity-field entity 'to)) 0)
- (> (length (elmo-message-entity-field entity 'cc)) 0)
+ (unless (or (elmo-message-entity-field entity 'to)
+ (elmo-message-entity-field entity 'cc)
(not (string= (elmo-message-entity-field entity 'subject)
elmo-no-subject)))
(elmo-message-entity-set-field entity 'subject location)
(let ((new-msgdb (elmo-make-msgdb))
ov-list message-id entity
ov-entity num
- extras extra ext field field-index flags)
+ field field-index flags)
(setq ov-list (elmo-nntp-parse-overview-string str))
(while ov-list
(setq ov-entity (car ov-list))
(setq num (string-to-int (aref ov-entity 0)))
(when (or (null numlist)
(memq num numlist))
- (setq extras elmo-msgdb-extra-fields
- extra nil)
- (while extras
- (setq ext (downcase (car extras)))
- (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index)))
- (when (> (length ov-entity) field-index)
- (setq field (aref ov-entity field-index))
- (when (eq field-index 8) ;; xref
- (setq field (elmo-msgdb-remove-field-string field)))
- (setq extra (cons (cons ext field) extra))))
- (setq extras (cdr extras)))
(setq entity (elmo-msgdb-make-message-entity
(elmo-msgdb-message-entity-handler new-msgdb)
:message-id (aref ov-entity 4)
:number num
:references (elmo-msgdb-get-last-message-id
(aref ov-entity 5))
- :from (elmo-mime-string (elmo-delete-char
- ?\"
- (or
- (aref ov-entity 2)
- elmo-no-from) 'uni))
- :subject (elmo-mime-string (or (aref ov-entity 1)
- elmo-no-subject))
+ :from (elmo-with-enable-multibyte
+ (eword-decode-string
+ (elmo-delete-char ?\"
+ (or (aref ov-entity 2)
+ elmo-no-from))))
+ :subject (or (elmo-with-enable-multibyte
+ (eword-decode-string
+ (aref ov-entity 1)))
+ elmo-no-subject)
:date (aref ov-entity 3)
- :size (string-to-int (aref ov-entity 6))
- :extra extra))
+ :size (string-to-int (aref ov-entity 6))))
+ (dolist (extra elmo-msgdb-extra-fields)
+ (setq extra (downcase extra))
+ (when (and (setq field-index
+ (cdr (assoc extra elmo-nntp-overview-index)))
+ (> (length ov-entity) field-index))
+ (setq field (aref ov-entity field-index))
+ (when (eq field-index 8) ;; xref
+ (setq field (elmo-msgdb-remove-field-string field)))
+ (elmo-message-entity-set-field entity (intern extra) field)))
(setq message-id (elmo-message-entity-field entity 'message-id)
flags (elmo-flag-table-get flag-table message-id))
(elmo-global-flags-set flags folder num message-id)
(elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder)))
(luna-define-method elmo-folder-close-internal ((folder elmo-pipe-folder))
- (elmo-folder-close-internal(elmo-pipe-folder-dst-internal folder)))
+ (elmo-folder-close-internal (elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-close ((folder elmo-pipe-folder))
+ (elmo-generic-folder-close folder)
+ (elmo-folder-close (elmo-pipe-folder-dst-internal folder)))
(luna-define-method elmo-folder-list-messages ((folder elmo-pipe-folder)
&optional visible-only in-msgdb)
(elmo-message-flags (elmo-pipe-folder-dst-internal folder) number))
(luna-define-method elmo-message-field ((folder elmo-pipe-folder)
- number field)
+ number field &optional type)
(elmo-message-field (elmo-pipe-folder-dst-internal folder)
number
- field))
+ field
+ type))
(luna-define-method elmo-message-set-cached ((folder elmo-pipe-folder)
number cached)
(elmo-shimbun-folder-set-header-hash-internal
folder
(setq hash (elmo-make-hash))))
- (elmo-set-hash-val (elmo-message-entity-field entity
- 'message-id)
+ (elmo-set-hash-val (elmo-message-entity-field entity 'message-id)
header
hash)
header)))))
(+ (* (- (car now) (car time)) 65536)
(- (nth 1 now) (nth 1 time)))))
-(defun elmo-shimbun-parse-time-string (string)
- "Parse the time-string STRING and return its time as Emacs style."
- (ignore-errors
- (let ((x (timezone-fix-time string nil nil)))
- (encode-time (aref x 5) (aref x 4) (aref x 3)
- (aref x 2) (aref x 1) (aref x 0)
- (aref x 6)))))
-
(defsubst elmo-shimbun-headers-check-p (folder)
(or (null (elmo-shimbun-folder-last-check-internal folder))
(and (elmo-shimbun-folder-last-check-internal folder)
(defun elmo-shimbun-entity-to-header (entity)
(let (message-id shimbun-id)
- (if (setq message-id (elmo-message-entity-field
- entity 'x-original-id))
+ (if (setq message-id (elmo-message-entity-field entity 'x-original-id))
(setq shimbun-id (elmo-message-entity-field entity 'message-id))
(setq message-id (elmo-message-entity-field entity 'message-id)
shimbun-id nil))
(elmo-with-enable-multibyte
- (shimbun-make-header
+ (shimbun-create-header
(elmo-message-entity-number entity)
- (shimbun-mime-encode-string
- (elmo-message-entity-field entity 'subject 'decode))
- (shimbun-mime-encode-string
- (elmo-message-entity-field entity 'from 'decode))
- (elmo-message-entity-field entity 'date)
+ (elmo-message-entity-field entity 'subject)
+ (elmo-message-entity-field entity 'from)
+ (elmo-time-make-date-string
+ (elmo-message-entity-field entity 'date))
message-id
(elmo-message-entity-field entity 'references)
- 0
+ (elmo-message-entity-field entity 'size)
0
(elmo-message-entity-field entity 'xref)
(and shimbun-id
percent))
(setq numlist (cdr numlist)))
(message "Creating msgdb...done")
- (elmo-msgdb-sort-by-date new-msgdb)))
+ new-msgdb))
(luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
nil)
(elmo-shimbun-folder-entity-hash folder))
(list (cons 'x-original-id message-id)))
(list
- (cons 'from
- (elmo-mime-string (shimbun-header-from header)))
- (cons 'subject
- (elmo-mime-string (shimbun-header-subject header)))
- (cons 'date
- (shimbun-header-date header))
+ (cons 'from (shimbun-header-from header 'no-encode))
+ (cons 'subject (shimbun-header-subject header 'no-encode))
+ (cons 'date (shimbun-header-date header))
(cons 'references
- (or (elmo-msgdb-get-last-message-id
- (elmo-field-body "in-reply-to"))
- (elmo-msgdb-get-last-message-id
- (elmo-field-body "references")))))))
+ (elmo-msgdb-get-references-from-buffer)))))
(elmo-emit-signal 'update-overview folder
(elmo-message-entity-number entity)))))
(when (and (elmo-message-entity-field ov 'xref)
(if expire-days
(< (elmo-shimbun-lapse-seconds
- (elmo-shimbun-parse-time-string
- (elmo-message-entity-field ov 'date)))
+ (elmo-message-entity-field ov 'date))
(* expire-days 86400 ; seconds per day
))
t))
(lambda (field-name)
(or (elmo-message-entity-field entity
(intern (downcase field-name))
- 'decode)
+ 'string)
(progn
(unless buffer
(setq buffer (get-buffer-create
(if (not (file-readable-p filename))
nil
(with-temp-buffer
- (as-binary-input-file
- (insert-file-contents filename))
- (when mime-charset
- (set-buffer-multibyte default-enable-multibyte-characters)
- (decode-mime-charset-region (point-min) (point-max) mime-charset))
+ (insert-file-contents-as-binary filename)
+ (let ((coding-system (or (funcall set-auto-coding-function
+ filename
+ (- (point-max) (point-min)))
+ (mime-charset-to-coding-system
+ mime-charset))))
+ (when coding-system
+ (decode-coding-region (point-min) (point-max) coding-system)))
+ (goto-char (point-min))
(condition-case nil
(read (current-buffer))
(error (unless no-err
(message "Warning: Loading object from %s failed."
filename)
- (elmo-object-save filename nil))
+ (elmo-object-save filename nil mime-charset))
nil)))))
(defsubst elmo-save-buffer (filename &optional mime-charset)
(with-temp-buffer
(let (print-length print-level)
(prin1 object (current-buffer)))
-;;; (princ "\n" (current-buffer))
- (elmo-save-buffer filename mime-charset)))
+ (when mime-charset
+ (let ((coding (mime-charset-to-coding-system
+ (or (detect-mime-charset-region (point-min) (point-max))
+ mime-charset))))
+ (goto-char (point-min))
+ (insert ";;; -*- mode: emacs-lisp; coding: "
+ (symbol-name coding) " -*-\n")
+ (encode-coding-region (point-min) (point-max) coding)))
+ (elmo-save-buffer filename)))
;;; Search Condition
(goto-char (match-end 0))))
(t (error "Syntax error '%s'" (buffer-string)))))
+(defmacro elmo-filter-condition-p (filter)
+ `(or (vectorp ,filter) (consp ,filter)))
+
+(defmacro elmo-filter-type (filter)
+ `(aref ,filter 0))
+
+(defmacro elmo-filter-key (filter)
+ `(aref ,filter 1))
+
+(defmacro elmo-filter-value (filter)
+ `(aref ,filter 2))
+
+(defun elmo-condition-match (condition match-primitive args)
+ (cond
+ ((vectorp condition)
+ (if (eq (elmo-filter-type condition) 'unmatch)
+ (not (apply match-primitive condition args))
+ (apply match-primitive condition args)))
+ ((eq (car condition) 'and)
+ (let ((lhs (elmo-condition-match (nth 1 condition) match-primitive args)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-condition-match (nth 2 condition)
+ match-primitive args)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'and lhs rhs))
+ (rhs
+ lhs))))
+ (lhs
+ (elmo-condition-match (nth 2 condition) match-primitive args)))))
+ ((eq (car condition) 'or)
+ (let ((lhs (elmo-condition-match (nth 1 condition) match-primitive args)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-condition-match (nth 2 condition)
+ match-primitive args)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'or lhs rhs))
+ (rhs
+ t)
+ (t
+ lhs))))
+ (lhs
+ t)
+ (t
+ (elmo-condition-match (nth 2 condition) match-primitive args)))))))
+
+(defun elmo-condition-optimize (condition)
+ (cond
+ ((vectorp condition)
+ (let ((key (elmo-filter-key condition)))
+ (cond ((cdr (assoc key '(("first" . 0)
+ ("last" . 0)
+ ("flag" . 1)
+ ("body" . 5)))))
+ ((member key '("since" "before" "from" "subject" "to" "cc"))
+ 2)
+ ((member key elmo-msgdb-extra-fields)
+ 3)
+ (t
+ 4))))
+ (t
+ (let ((weight-l (elmo-condition-optimize (nth 1 condition)))
+ (weight-r (elmo-condition-optimize (nth 2 condition))))
+ (if (> weight-l weight-r)
+ (let ((lhs (nth 1 condition)))
+ (setcar (nthcdr 1 condition) (nth 2 condition))
+ (setcar (nthcdr 2 condition) lhs)
+ weight-l)
+ weight-r)))))
+
;;;
(defsubst elmo-buffer-replace (regexp &optional newtext)
(goto-char (point-min))
(setq l1 (cdr l1)))
(cons diff1 (list l2)))))
-(defmacro elmo-filter-condition-p (filter)
- `(or (vectorp ,filter) (consp ,filter)))
-
-(defmacro elmo-filter-type (filter)
- `(aref ,filter 0))
-
-(defmacro elmo-filter-key (filter)
- `(aref ,filter 1))
-
-(defmacro elmo-filter-value (filter)
- `(aref ,filter 2))
-
-(defsubst elmo-buffer-field-primitive-condition-match (condition
- number
- number-list)
- (let (result)
- (goto-char (point-min))
- (cond
- ((string= (elmo-filter-key condition) "last")
- (setq result (<= (length (memq number number-list))
- (string-to-int (elmo-filter-value condition)))))
- ((string= (elmo-filter-key condition) "first")
- (setq result (< (- (length number-list)
- (length (memq number number-list)))
- (string-to-int (elmo-filter-value condition)))))
- ((string= (elmo-filter-key condition) "since")
- (let ((field-date (elmo-date-make-sortable-string
- (timezone-fix-time
- (std11-field-body "date")
- (current-time-zone) nil)))
- (specified-date (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition)))))
- (setq result
- (or (string= field-date specified-date)
- (string< specified-date field-date)))))
- ((string= (elmo-filter-key condition) "before")
- (setq result
- (string<
- (elmo-date-make-sortable-string
- (timezone-fix-time
- (std11-field-body "date")
- (current-time-zone) nil))
- (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition))))))
- ((string= (elmo-filter-key condition) "body")
- (and (re-search-forward "^$" nil t) ; goto body
- (setq result (search-forward (elmo-filter-value condition)
- nil t))))
- (t
- (dolist (fval (elmo-multiple-field-body (elmo-filter-key condition)))
- (if (eq (length fval) 0) (setq fval nil))
- (if fval (setq fval (eword-decode-string fval)))
- (setq result (or result
- (and fval (string-match
- (elmo-filter-value condition) fval)))))))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (setq result (not result)))
- result))
-
-(defun elmo-buffer-field-condition-match (condition number number-list)
- (cond
- ((vectorp condition)
- (elmo-buffer-field-primitive-condition-match
- condition number number-list))
- ((eq (car condition) 'and)
- (and (elmo-buffer-field-condition-match
- (nth 1 condition) number number-list)
- (elmo-buffer-field-condition-match
- (nth 2 condition) number number-list)))
- ((eq (car condition) 'or)
- (or (elmo-buffer-field-condition-match
- (nth 1 condition) number number-list)
- (elmo-buffer-field-condition-match
- (nth 2 condition) number number-list)))))
-
(defmacro elmo-get-hash-val (string hashtable)
(static-if (fboundp 'unintern)
`(symbol-value (intern-soft ,string ,hashtable))
(nth 1 (eword-extract-address-components
(or (elmo-field-body "from") "nobody"))) ">"))))
+(defun elmo-msgdb-get-references-from-buffer ()
+ (if elmo-msgdb-prefer-in-reply-to-for-parent
+ (or (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to"))
+ (elmo-msgdb-get-last-message-id (elmo-field-body "references")))
+ (or (elmo-msgdb-get-last-message-id (elmo-field-body "references"))
+ (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to")))))
+
(defsubst elmo-msgdb-insert-file-header (file)
"Insert the header of the article."
(let ((beg 0)
(match-end 0) (std11-field-end))))))
field-body))))
+(defun elmo-parse-addresses (string)
+ (if (null string)
+ ()
+ (elmo-set-work-buf
+ (let (list start s char)
+ (insert string)
+ (goto-char (point-min))
+ (skip-chars-forward "\t\f\n\r ")
+ (setq start (point))
+ (while (not (eobp))
+ (skip-chars-forward "^\"\\,(")
+ (setq char (following-char))
+ (cond ((= char ?\\)
+ (forward-char 1)
+ (if (not (eobp))
+ (forward-char 1)))
+ ((= char ?,)
+ (setq s (buffer-substring start (point)))
+ (if (or (null (string-match "^[\t\f\n\r ]+$" s))
+ (not (string= s "")))
+ (setq list (cons s list)))
+ (skip-chars-forward ",\t\f\n\r ")
+ (setq start (point)))
+ ((= char ?\")
+ (re-search-forward "[^\\]\"" nil 0))
+ ((= char ?\()
+ (let ((parens 1))
+ (forward-char 1)
+ (while (and (not (eobp)) (not (zerop parens)))
+ (re-search-forward "[()]" nil 0)
+ (cond ((or (eobp)
+ (= (char-after (- (point) 2)) ?\\)))
+ ((= (preceding-char) ?\()
+ (setq parens (1+ parens)))
+ (t
+ (setq parens (1- parens)))))))))
+ (setq s (buffer-substring start (point)))
+ (if (and (null (string-match "^[\t\f\n\r ]+$" s))
+ (not (string= s "")))
+ (setq list (cons s list)))
+ (nreverse list)))))
+
;;; Queue.
(defvar elmo-dop-queue-filename "queue"
"*Disconnected operation queue is saved in this file.")
(defvar elmo-strict-diff-folder-list nil
"List of regexps of folder name which should be checked its diff strictly.")
+(defcustom elmo-msgdb-prefer-in-reply-to-for-parent nil
+ "*Non-nil to prefer In-Reply-To header for finding parent message on thread,
+rather than References header."
+ :type 'boolean
+ :group 'elmo
+ :group 'elmo-setting)
+
(defcustom elmo-msgdb-extra-fields nil
"Extra fields for msgdb."
:type '(repeat string)
;; product-define in the first place
(product-provide 'elmo-version
;; Don't forget to check `wl-version.el' and Info.
- (product-define "ELMO" nil '(2 13 3)))
+ (product-define "ELMO" nil '(2 15 1)))
;; set version-string
(product-version-as-string 'elmo-version)
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))))
(setq results (elmo-msgdb-search msgdb condition numbers))
(if (listp results)
results
+ (elmo-condition-optimize condition)
+ (when (and (consp condition)
+ (eq (car condition) 'and)
+ (listp (setq results (elmo-msgdb-search msgdb
+ (nth 1 condition)
+ numbers))))
+ (setq numbers results
+ condition (nth 2 condition)))
(let ((len (length numbers))
matched)
(elmo-with-progress-display (> len elmo-display-progress-threshold)
(message "Searching...done")
(nreverse matched)))))
+(defun elmo-message-buffer-match-condition (condition number)
+ (let* ((handler (luna-make-entity 'modb-buffer-entity-handler))
+ (result (elmo-condition-match
+ condition
+ (lambda (condition handler entity)
+ (elmo-msgdb-message-match-condition handler
+ condition
+ entity))
+ (list
+ handler
+ (elmo-msgdb-make-message-entity
+ handler
+ :number number
+ :buffer (current-buffer))))))
+ (and result (not (elmo-filter-condition-p result)))))
+
(luna-define-method elmo-message-match-condition ((folder elmo-folder)
number condition
numbers)
(set-buffer-multibyte default-enable-multibyte-characters)
(decode-coding-region (point-min) (point-max)
elmo-mime-display-as-is-coding-system)
- (elmo-buffer-field-condition-match condition number numbers)))))
+ (elmo-message-buffer-match-condition condition number)))))
(luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
nil) ; default is noop.
;; XXX Transitional implementation.
(elmo-folder-unset-flag folder (list number) flag is-local))
-(luna-define-generic elmo-message-field (folder number field)
+(luna-define-generic elmo-message-field (folder number field &optional type)
"Get message field value in the msgdb.
FOLDER is the ELMO folder structure.
NUMBER is a number of the message.
-FIELD is a symbol of the field.")
+FIELD is a symbol of the field.
+If optional argument TYPE is specified, return converted value.")
-(luna-define-method elmo-message-field ((folder elmo-folder) number field)
- (elmo-msgdb-message-field (elmo-folder-msgdb folder) number field))
+(luna-define-method elmo-message-field ((folder elmo-folder)
+ number field &optional type)
+ (elmo-msgdb-message-field (elmo-folder-msgdb folder) number field type))
(luna-define-generic elmo-message-set-field (folder number field value)
"Set message field value in the msgdb.
(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."
:type 'symbol
:group 'elmo)
-(defcustom elmo-msgdb-prefer-in-reply-to-for-parent nil
- "*Non-nil to prefer In-Reply-To header for finding parent message on thread,
-rather than References header."
- :type 'boolean
+(defcustom modb-entity-field-extractor-alist
+ '((ml-info . modb-entity-extract-mailing-list-info))
+ "*An alist of field name and function to extract field body from buffer."
+ :type '(repeat (cons (symbol :tag "Field Name")
+ (function :tag "Function")))
:group 'elmo)
(defvar modb-entity-default-cache-internal nil)
(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.")
entity number)
"Set number of the ENTITY.")
-(luna-define-generic elmo-msgdb-message-entity-field (handler
- entity field
- &optional decode)
+(luna-define-generic elmo-msgdb-message-entity-field (handler entity field
+ &optional type)
"Retrieve field value of the message entity.
HANDLER is the message entity handler.
ENTITY is the message entity structure.
FIELD is a symbol of the field.
-If optional DECODE is no-nil, the field value is decoded.")
+If optional argument TYPE is specified, return converted value.")
(luna-define-generic elmo-msgdb-message-entity-set-field (handler
entity field value)
ENTITY is the message entity structure.
VALUES is an alist of field-name and field-value.")
-(luna-define-generic elmo-msgdb-copy-message-entity (handler entity)
+(luna-define-generic elmo-msgdb-copy-message-entity (handler entity
+ &optional
+ make-handler)
"Copy message entity.
HANDLER is the message entity handler.
-ENTITY is the message entity structure.")
+ENTITY is the message entity structure.
+If optional argument MAKE-HANDLER is specified, use it to make new entity.")
(luna-define-generic elmo-msgdb-create-message-entity-from-file (handler
number
;; Transitional interface.
(luna-define-generic elmo-msgdb-message-match-condition (handler
condition
- entity
- flags
- numbers)
+ entity)
"Return non-nil when the entity matches the condition.")
;; Generic implementation.
+(luna-define-method initialize-instance :after ((handler modb-entity-handler)
+ &rest init-args)
+ (unless (modb-entity-handler-mime-charset-internal handler)
+ (modb-entity-handler-set-mime-charset-internal handler elmo-mime-charset))
+ handler)
+
+(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...
(luna-define-method elmo-msgdb-message-entity-field ((handler
modb-entity-handler)
entity field
- &optional decode)
+ &optional type)
(plist-get (cdr entity) (intern (concat ":" (symbol-name field)))))
(luna-define-method elmo-msgdb-message-entity-number ((handler
(setq updated t)))
updated))
-;; Legacy implementation.
-(eval-and-compile (luna-define-class modb-legacy-entity-handler
- (modb-entity-handler)))
+;; helper functions
+(defsubst modb-entity-handler-mime-charset (handler)
+ (or (modb-entity-handler-mime-charset-internal handler)
+ elmo-mime-charset))
+
+(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)
+ "Set convert function of TYPE into CONVERTER.
+SPECS must be like `FIELD1 FUNCTION1 FIELD2 FUNCTION2 ...'.
+If each field is t, function is set as default converter."
+ (when specs
+ (let ((alist (symbol-value converter))
+ (type (or type t)))
+ (while specs
+ (let ((field (pop specs))
+ (function (pop specs))
+ cell)
+ (if (setq cell (assq type alist))
+ (setcdr cell (put-alist field function (cdr cell)))
+ (setq cell (cons type (list (cons field function)))
+ alist (cons cell alist)))
+ ;; support colon keyword (syntax sugar).
+ (unless (or (eq field t)
+ (string-match "^:" (symbol-name field)))
+ (setcdr cell (put-alist (intern (concat ":" (symbol-name field)))
+ function
+ (cdr cell))))))
+ (set converter alist))))
+(put 'modb-set-field-converter 'lisp-indent-function 2)
+
+(defsubst modb-convert-field-value (converter field value &optional type)
+ (and value
+ (let* ((alist (cdr (assq (or type t) converter)))
+ (function (cdr (or (assq field alist)
+ (assq t alist)))))
+ (if function
+ (funcall function field value)
+ value))))
-;;
;; mime decode cache
-;;
(defvar elmo-msgdb-decoded-cache-hashtb nil)
(make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
(elmo-with-enable-multibyte
(decode-mime-charset-string string elmo-mime-charset))))
+(defun modb-entity-string-decoder (field value)
+ (elmo-msgdb-get-decoded-cache value))
+
+(defun modb-entity-string-encoder (field value)
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string value elmo-mime-charset)))
+
+(defun modb-entity-parse-date-string (field value)
+ (if (stringp value)
+ (elmo-time-parse-date-string value)
+ value))
+
+(defun modb-entity-make-date-string (field value)
+ (if (stringp value)
+ value
+ (elmo-time-make-date-string value)))
+
+(defun modb-entity-mime-decoder (field value)
+ (mime-decode-field-body value (symbol-name field) 'summary))
+
+(defun modb-entity-mime-encoder (field value)
+ (mime-encode-field-body value (symbol-name field)))
+
+(defun modb-entity-address-list-decoder (field value)
+ (if (stringp value)
+ (mapcar (lambda (address)
+ (mime-decode-field-body address (symbol-name field)))
+ (elmo-parse-addresses value))
+ value))
+
+(defun modb-entity-address-list-encoder (field value)
+ (if (stringp value)
+ value
+ (mime-encode-field-body (mapconcat 'identity value ", ")
+ (symbol-name field))))
+
+(defun modb-entity-parse-address-string (field value)
+ (modb-entity-encode-string-recursive
+ field
+ (if (stringp value)
+ (elmo-parse-addresses value)
+ value)))
+
+(defun modb-entity-make-address-string (field 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)
+ (let ((index 0)
+ indices)
+ (while slots
+ (setq indices (cons (cons (car slots) index) indices)
+ index (1+ index)
+ slots (cdr slots)))
+ (append
+ indices
+ (mapcar (lambda (cell)
+ (cons (intern (concat ":" (symbol-name (car cell))))
+ (cdr cell)))
+ indices))))
+
+
+;; Legacy implementation.
+(eval-and-compile
+ (luna-define-class modb-legacy-entity-handler (modb-entity-handler)))
+
+(defconst modb-legacy-entity-field-slots
+ '(number
+ references
+ from
+ subject
+ date
+ to
+ cc
+ size
+ extra))
+
+(defconst modb-legacy-entity-field-indices
+ (modb-entity-create-field-indices modb-legacy-entity-field-slots))
+
+(defvar modb-legacy-entity-normalizer nil)
+(modb-set-field-converter 'modb-legacy-entity-normalizer nil
+ 'message-id nil
+ 'number nil
+ 'references nil
+ 'from #'modb-entity-string-encoder
+ 'subject #'modb-entity-string-encoder
+ 'date #'modb-entity-make-date-string
+ 'to #'modb-entity-address-list-encoder
+ 'cc #'modb-entity-address-list-encoder
+ 'size nil
+ t #'modb-entity-mime-encoder)
+
+(defvar modb-legacy-entity-specializer nil)
+;; default type
+(modb-set-field-converter 'modb-legacy-entity-specializer nil
+ 'message-id nil
+ 'number nil
+ 'references nil
+ 'from #'modb-entity-string-decoder
+ 'subject #'modb-entity-string-decoder
+ 'date #'modb-entity-parse-date-string
+ 'to #'modb-entity-address-list-decoder
+ 'cc #'modb-entity-address-list-decoder
+ 'size nil
+ t #'modb-entity-mime-decoder)
+;; string type
+(modb-set-field-converter 'modb-legacy-entity-specializer 'string
+ 'message-id nil
+ 'number nil ; not supported
+ 'references nil
+ 'from #'modb-entity-string-decoder
+ 'subject #'modb-entity-string-decoder
+ 'date nil
+ 'size nil ; not supported
+ t #'modb-entity-mime-decoder)
+
+
+(defmacro modb-legacy-entity-field-index (field)
+ `(cdr (assq ,field modb-legacy-entity-field-indices)))
+
+(defsubst modb-legacy-entity-set-field (entity field value &optional as-is)
+ (when entity
+ (let (index)
+ (unless as-is
+ (setq value (modb-convert-field-value
+ modb-legacy-entity-normalizer
+ field value)))
+ (cond ((memq field '(message-id :message-id))
+ (setcar entity value))
+ ((setq index (modb-legacy-entity-field-index field))
+ (aset (cdr entity) index value))
+ (t
+ (setq index (modb-legacy-entity-field-index :extra))
+ (let ((extras (and entity (aref (cdr entity) index)))
+ extra)
+ (if (setq extra (assoc (symbol-name field) extras))
+ (setcdr extra value)
+ (aset (cdr entity) index (cons (cons (symbol-name field)
+ value) extras)))))))))
+
(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))))
+ (let ((entity (cons nil (make-vector 9 nil)))
+ field value)
+ (while args
+ (setq field (pop args)
+ value (pop args))
+ (when value
+ (modb-legacy-entity-set-field entity field value)))
+ entity))
(luna-define-method elmo-msgdb-make-message-entity
((handler modb-legacy-entity-handler) args)
(setq charset (intern-soft charset))
(setq default-mime-charset charset))
(setq references
- (if elmo-msgdb-prefer-in-reply-to-for-parent
- (or (elmo-msgdb-get-last-message-id
- (elmo-field-body "in-reply-to"))
- (elmo-msgdb-get-last-message-id
- (elmo-field-body "references")))
- (or (elmo-msgdb-get-last-message-id
- (elmo-field-body "references"))
- (elmo-msgdb-get-last-message-id
- (elmo-field-body "in-reply-to"))))
+ (elmo-msgdb-get-references-from-buffer)
from (elmo-replace-in-string
(elmo-mime-string (or (elmo-field-body "from")
elmo-no-from))
(elmo-mime-string (or (elmo-field-body "subject")
elmo-no-subject))
"\t" " ")
- date (elmo-unfold-field-body "date")
+ date (elmo-decoded-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 handler entity 'size)
(setq size 0)))
(while extras
(if (setq field-body (elmo-field-body (car extras)))
- (elmo-msgdb-message-entity-set-field
- handler entity (intern (downcase (car extras))) field-body))
+ (modb-legacy-entity-set-field
+ entity (intern (downcase (car extras))) field-body 'as-is))
(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
- handler entity field (symbol-value field))))
+ (modb-legacy-entity-set-field
+ entity field (symbol-value field) 'as-is)))
entity)))
(luna-define-method elmo-msgdb-message-entity-number
(luna-define-method elmo-msgdb-message-entity-set-number
((handler modb-legacy-entity-handler) entity number)
- (and entity (aset (cdr entity) 0 number))
- entity)
+ (and entity (aset (cdr entity) 0 number)))
(luna-define-method elmo-msgdb-message-entity-field
- ((handler modb-legacy-entity-handler) entity field &optional decode)
+ ((handler modb-legacy-entity-handler) entity field &optional type)
(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))))
+ (let (index)
+ (modb-convert-field-value
+ modb-legacy-entity-specializer
+ field
+ (cond ((memq field '(message-id :message-id))
+ (car entity))
+ ((setq index (modb-legacy-entity-field-index field))
+ (aref (cdr entity) index))
+ (t
+ (setq index (modb-legacy-entity-field-index :extra))
+ (cdr (assoc (symbol-name field)
+ (aref (cdr entity) index)))))
+ type))))
(luna-define-method elmo-msgdb-message-entity-set-field
((handler modb-legacy-entity-handler) 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))))))))
+ (modb-legacy-entity-set-field entity field value))
(luna-define-method elmo-msgdb-copy-message-entity
- ((handler modb-legacy-entity-handler) entity)
- (cons (car entity)
- (copy-sequence (cdr entity))))
+ ((handler modb-legacy-entity-handler) entity &optional make-handler)
+ (if make-handler
+ (let ((copy (elmo-msgdb-make-message-entity make-handler)))
+ (dolist (field (append '(message-id number references from subject
+ date to cc size)
+ (mapcar (lambda (extra) (intern (car extra)))
+ (aref (cdr entity) 8))))
+ (elmo-msgdb-message-entity-set-field
+ make-handler copy field
+ (elmo-msgdb-message-entity-field handler entity field)))
+ copy)
+ (cons (car entity)
+ (copy-sequence (cdr entity)))))
(luna-define-method elmo-msgdb-message-match-condition
- ((handler modb-legacy-entity-handler) condition entity flags numbers)
- (cond
- ((vectorp condition)
- (elmo-msgdb-match-condition-primitive handler condition
- entity flags numbers))
- ((eq (car condition) 'and)
- (let ((lhs (elmo-msgdb-message-match-condition handler
- (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-message-match-condition
- handler (nth 2 condition) entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'and lhs rhs))
- (rhs
- lhs))))
- (lhs
- (elmo-msgdb-message-match-condition handler (nth 2 condition)
- entity flags numbers)))))
- ((eq (car condition) 'or)
- (let ((lhs (elmo-msgdb-message-match-condition handler (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-message-match-condition handler
- (nth 2 condition)
- entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'or lhs rhs))
- (rhs
- t)
+ ((handler modb-entity-handler) condition entity)
+ (let ((key (elmo-filter-key condition))
+ (case-fold-search t)
+ field-value)
+ (cond
+ ((or (string= key "since")
+ (string= key "before"))
+ (let ((field-date (elmo-msgdb-message-entity-field
+ handler entity 'date))
+ (specified-date
+ (elmo-datevec-to-time
+ (elmo-date-get-datevec
+ (elmo-filter-value condition)))))
+ (if (string= key "since")
+ (not (elmo-time< field-date specified-date))
+ (elmo-time< field-date specified-date))))
+ ((setq field-value (elmo-msgdb-message-entity-field handler
+ entity
+ (intern key)
+ 'string))
+ (and (stringp field-value)
+ (string-match (elmo-filter-value condition) field-value)))
+ (t
+ condition))))
+
+
+;; Standard implementation.
+(eval-and-compile
+ (luna-define-class modb-standard-entity-handler (modb-entity-handler)))
+
+(defconst modb-standard-entity-field-slots
+ '(number
+ from
+ subject
+ date
+ to
+ cc
+ content-type
+ references
+ size
+ score
+ extra))
+
+(defconst modb-standard-entity-field-indices
+ (modb-entity-create-field-indices modb-standard-entity-field-slots))
+
+(defvar modb-standard-entity-normalizer nil)
+(modb-set-field-converter 'modb-standard-entity-normalizer 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
+ '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 #'modb-entity-decode-string-recursive)
+
+(defmacro modb-standard-entity-field-index (field)
+ `(cdr (assq ,field modb-standard-entity-field-indices)))
+
+(defsubst modb-standard-entity-set-field (entity field value &optional as-is)
+ (when entity
+ (let (index)
+ (unless as-is
+ (let ((elmo-mime-charset
+ (modb-entity-handler-mime-charset (car entity))))
+ (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))
+ (aset (cdr (cdr entity)) index value))
+ (t
+ (setq index (modb-standard-entity-field-index :extra))
+ (let ((extras (aref (cdr (cdr entity)) index))
+ cell)
+ (if (setq cell (assq field extras))
+ (setcdr cell value)
+ (aset (cdr (cdr entity))
+ index
+ (cons (cons field value) extras)))))))))
+
+(defsubst modb-standard-make-message-entity (handler args)
+ (let ((entity (cons handler
+ (cons nil
+ (make-vector
+ (length modb-standard-entity-field-slots)
+ nil))))
+ field value)
+ (while args
+ (setq field (pop args)
+ value (pop args))
+ (when value
+ (modb-standard-entity-set-field entity field value)))
+ entity))
+
+(luna-define-method elmo-msgdb-make-message-entity
+ ((handler modb-standard-entity-handler) args)
+ (modb-standard-make-message-entity handler args))
+
+(luna-define-method elmo-msgdb-message-entity-number
+ ((handler modb-standard-entity-handler) entity)
+ (and entity (aref (cdr (cdr entity)) 0)))
+
+(luna-define-method elmo-msgdb-message-entity-set-number
+ ((handler modb-standard-entity-handler) entity number)
+ (and entity (aset (cdr (cdr entity)) 0 number)))
+
+(luna-define-method elmo-msgdb-message-entity-field
+ ((handler modb-standard-entity-handler) entity field &optional type)
+ (and entity
+ (let ((elmo-mime-charset
+ (modb-entity-handler-mime-charset handler))
+ index)
+ (modb-convert-field-value
+ modb-standard-entity-specializer
+ field
+ (cond ((memq field '(message-id :message-id))
+ (car (cdr entity)))
+ ((setq index (modb-standard-entity-field-index field))
+ (aref (cdr (cdr entity)) index))
(t
- lhs))))
- (lhs
- t)
- (t
- (elmo-msgdb-message-match-condition handler
- (nth 2 condition)
- entity flags numbers)))))))
+ (setq index (modb-standard-entity-field-index :extra))
+ (cdr (assq field (aref (cdr (cdr entity)) index)))))
+ type))))
-;;
-(defun elmo-msgdb-match-condition-primitive (handler
- 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-message-entity-number
- handler entity)
- numbers))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "first")
- (setq result (< (-
- (length numbers)
- (length (memq
- (elmo-msgdb-message-entity-number
- handler 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-message-entity-field
- handler entity 'from t))))
- ((string= key "subject")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-message-entity-field
- handler entity 'subject t))))
- ((string= key "to")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-message-entity-field
- handler entity 'to))))
- ((string= key "cc")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-message-entity-field
- handler entity 'cc))))
- ((or (string= key "since")
- (string= key "before"))
- (let ((field-date (elmo-date-make-sortable-string
- (timezone-fix-time
- (elmo-msgdb-message-entity-field
- handler entity 'date)
- (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-message-entity-field handler
- entity
- (intern 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))))
+(luna-define-method elmo-msgdb-message-entity-set-field
+ ((handler modb-standard-entity-handler) entity field value)
+ (modb-standard-entity-set-field entity field value))
+
+(luna-define-method elmo-msgdb-copy-message-entity
+ ((handler modb-standard-entity-handler) entity &optional make-handler)
+ (if make-handler
+ (let ((copy (elmo-msgdb-make-message-entity make-handler)))
+ (dolist (field (nconc
+ (delq 'extra
+ (copy-sequence modb-standard-entity-field-slots))
+ (mapcar 'car
+ (aref
+ (cdr (cdr entity))
+ (modb-standard-entity-field-index :extra)))
+ '(message-id)))
+ (elmo-msgdb-message-entity-set-field
+ make-handler copy field
+ (elmo-msgdb-message-entity-field handler entity field)))
+ copy)
+ (cons handler
+ (cons (car (cdr entity))
+ (copy-sequence (cdr (cdr entity)))))))
+
+(luna-define-method elmo-msgdb-create-message-entity-from-buffer
+ ((handler modb-standard-entity-handler) number args)
+ (let ((default-mime-charset default-mime-charset)
+ entity content-type charset)
+ (save-excursion
+ (set-buffer-multibyte default-enable-multibyte-characters)
+ (and (setq content-type (elmo-decoded-field-body
+ "content-type" 'summary))
+ (setq charset (mime-content-type-parameter
+ (mime-parse-Content-Type content-type) "charset"))
+ (setq charset (intern-soft charset))
+ (mime-charset-p charset)
+ (setq default-mime-charset charset))
+ (setq entity
+ (modb-standard-make-message-entity
+ handler
+ (append
+ args
+ (list
+ :number
+ number
+ :message-id
+ (elmo-msgdb-get-message-id-from-buffer)
+ :references
+ (elmo-msgdb-get-references-from-buffer)
+ :from
+ (elmo-replace-in-string
+ (or (elmo-decoded-field-body "from" 'summary)
+ elmo-no-from)
+ "\t" " ")
+ :subject
+ (elmo-replace-in-string
+ (or (elmo-decoded-field-body "subject" 'summary)
+ elmo-no-subject)
+ "\t" " ")
+ :date
+ (elmo-decoded-field-body "date" 'summary)
+ :to
+ (mapconcat
+ (lambda (field-body)
+ (mime-decode-field-body field-body "to" 'summary))
+ (elmo-multiple-field-body "to") ",")
+ :cc
+ (mapconcat
+ (lambda (field-body)
+ (mime-decode-field-body field-body "cc" 'summary))
+ (elmo-multiple-field-body "cc") ",")
+ :content-type
+ content-type
+ :size
+ (let ((size (elmo-field-body "content-length")))
+ (if size
+ (string-to-int size)
+ (or (plist-get args :size) 0)))))))
+ (let (field-name field-body extractor)
+ (dolist (extra (cons "newsgroups" elmo-msgdb-extra-fields))
+ (setq field-name (intern (downcase extra))
+ extractor (cdr (assq field-name
+ modb-entity-field-extractor-alist))
+ field-body (if extractor
+ (funcall extractor field-name)
+ (elmo-decoded-field-body extra 'summary)))
+ (when field-body
+ (modb-standard-entity-set-field entity field-name field-body))))
+ entity)))
+
+
+;; mailing list info handling
+(defun modb-entity-extract-ml-info-from-x-sequence ()
+ (let ((sequence (elmo-decoded-field-body "x-sequence" 'summary))
+ name count)
+ (when sequence
+ (elmo-set-list '(name count) (split-string sequence " "))
+ (cons name count))))
+
+(defun modb-entity-extract-ml-info-from-subject ()
+ (let ((subject (elmo-decoded-field-body "subject" 'summary)))
+ (when (and subject
+ (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*"
+ subject))
+ (cons (match-string 1 subject) (match-string 2 subject)))))
+
+(defun modb-entity-extract-ml-info-from-return-path ()
+ (let ((return-path (elmo-decoded-field-body "return-path" 'summary)))
+ (when (and return-path
+ (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-"
+ return-path))
+ (cons (match-string 1 return-path)
+ (match-string 2 return-path)))))
+
+(defun modb-entity-extract-ml-info-from-delivered-to ()
+ (let ((delivered-to (elmo-decoded-field-body "delivered-to" 'summary)))
+ (when (and delivered-to
+ (string-match "^mailing list \\([^@]+\\)@" delivered-to))
+ (cons (match-string 1 delivered-to) nil))))
+
+(defun modb-entity-extract-ml-info-from-mailing-list ()
+ (let ((mailing-list (elmo-decoded-field-body "mailing-list" 'summary)))
+ ;; *-help@, *-owner@, etc.
+ (when (and mailing-list
+ (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@"
+ mailing-list))
+ (cons (match-string 2 mailing-list) nil))))
+
+(defvar modb-entity-extract-mailing-list-info-functions
+ '(modb-entity-extract-ml-info-from-x-sequence
+ modb-entity-extract-ml-info-from-subject
+ modb-entity-extract-ml-info-from-return-path
+ modb-entity-extract-ml-info-from-delivered-to
+ modb-entity-extract-ml-info-from-mailing-list))
+
+(defun modb-entity-extract-mailing-list-info (field)
+ (let ((ml-name (elmo-decoded-field-body "x-ml-name" 'summary))
+ (ml-count (or (elmo-decoded-field-body "x-mail-count" 'summary)
+ (elmo-decoded-field-body "x-ml-count" 'summary)))
+ (functions modb-entity-extract-mailing-list-info-functions)
+ result)
+ (while (and functions
+ (or (null ml-name) (null ml-count)))
+ (when (setq result (funcall (car functions)))
+ (unless ml-name
+ (setq ml-name (car result)))
+ (unless ml-count
+ (setq ml-count (cdr result))))
+ (setq functions (cdr functions)))
+ (when (or ml-name ml-count)
+ (cons (and ml-name (car (split-string ml-name " ")))
+ (and ml-count (string-to-int ml-count))))))
+
+(defun modb-entity-make-mailing-list-info-string (field value)
+ (when (car value)
+ (format (if (cdr value) "(%s %05.0f)" "(%s)")
+ (elmo-msgdb-get-decoded-cache (car value))
+ (cdr value))))
+
+;; message buffer handler
+(eval-and-compile
+ (luna-define-class modb-buffer-entity-handler (modb-entity-handler)))
+
+(defvar modb-buffer-entity-specializer nil)
+(modb-set-field-converter 'modb-buffer-entity-specializer nil
+ 'date #'elmo-time-parse-date-string)
+
+(luna-define-method elmo-msgdb-make-message-entity
+ ((handler modb-buffer-entity-handler) args)
+ (cons handler (cons (or (plist-get args :number)
+ (plist-get args 'number))
+ (or (plist-get args :buffer)
+ (plist-get args 'buffer)
+ (current-buffer)))))
+
+(luna-define-method elmo-msgdb-message-entity-number
+ ((handler modb-buffer-entity-handler) entity)
+ (car (cdr entity)))
+
+(luna-define-method elmo-msgdb-message-entity-set-number
+ ((handler modb-buffer-entity-handler) entity number)
+ (and entity (setcar (cdr entity) number)))
+
+(luna-define-method elmo-msgdb-message-entity-field
+ ((handler modb-buffer-entity-handler) entity field &optional type)
+ (and entity
+ (let ((elmo-mime-charset
+ (modb-entity-handler-mime-charset handler)))
+ (modb-convert-field-value
+ modb-buffer-entity-specializer
+ field
+ (if (memq field '(number :number))
+ (car (cdr entity))
+ (with-current-buffer (cdr (cdr entity))
+ (let ((extractor (cdr (assq field
+ modb-entity-field-extractor-alist))))
+ (if extractor
+ (funcall extractor field)
+ (mapconcat
+ (lambda (field-body)
+ (mime-decode-field-body field-body (symbol-name field)
+ 'summary))
+ (elmo-multiple-field-body (symbol-name field))
+ "\n")))))
+ type))))
+
+(luna-define-method elmo-msgdb-message-match-condition :around
+ ((handler modb-buffer-entity-handler) condition entity)
+ (let ((key (elmo-filter-key condition))
+ (case-fold-search t))
+ (cond
+ ((string= (elmo-filter-key condition) "body")
+ (with-current-buffer (cdr (cdr entity))
+ (goto-char (point-min))
+ (and (re-search-forward "^$" nil t) ; goto body
+ (search-forward (elmo-filter-value condition) nil t))))
+ (t
+ (luna-call-next-method)))))
(require 'product)
(product-provide (provide 'modb-entity) (require 'elmo-version))
number)
:group 'elmo)
-(defcustom modb-standard-economize-entity-size t
- "*Economize message entity size.
-When non-nil, redundunt message-id string are not saved."
- :type 'boolean
- :group 'elmo)
-
(defvar modb-standard-entity-filename "entity"
"Message entity database.")
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))
(defun modb-standard-load-entity (modb path &optional section)
(let ((table (or (modb-standard-entity-map-internal modb)
(elmo-make-hash (elmo-msgdb-length modb))))
+ (objects (elmo-object-load
+ (expand-file-name
+ (modb-standard-entity-filename section)
+ path)))
number msgid)
- (dolist (entity (elmo-object-load
- (expand-file-name
- (modb-standard-entity-filename section)
- path)))
- (setq number (elmo-msgdb-message-entity-number
- (elmo-message-entity-handler entity)
- entity)
- msgid (modb-standard-loaded-message-id modb number))
- (when msgid
- (setcar entity msgid)
- (elmo-set-hash-val msgid entity table)
- (elmo-set-hash-val (modb-standard-key number) entity table)))
+ (cond ((eq (car objects) 'modb-standard-entity-handler)
+ ;; (standard PARAMETERS ENTITY*)
+ (let ((handler (apply #'luna-make-entity
+ (car objects)
+ (car (cdr objects))))
+ entity)
+ (dolist (element (cdr (cdr objects)))
+ (setq entity (cons handler (cons nil element))
+ number (elmo-msgdb-message-entity-number handler entity)
+ msgid (modb-standard-loaded-message-id modb number))
+ (when msgid
+ (elmo-msgdb-message-entity-set-field
+ handler entity 'message-id msgid)
+ (elmo-set-hash-val (modb-standard-key number) entity table)
+ (elmo-set-hash-val msgid entity table)))))
+ (t
+ ;; legacy format
+ (dolist (entity objects)
+ (setq number (elmo-msgdb-message-entity-number
+ (elmo-message-entity-handler entity)
+ entity)
+ msgid (modb-standard-loaded-message-id modb number))
+ (when msgid
+ (setcar entity msgid)
+ (elmo-set-hash-val (modb-standard-key number) entity table)
+ (elmo-set-hash-val msgid entity table)))))
(modb-standard-set-entity-map-internal modb table)))
(defsubst modb-standard-save-entity-1 (modb path &optional section)
(let ((table (modb-standard-entity-map-internal modb))
(filename (expand-file-name
- (modb-standard-entity-filename section) path))
+ (modb-standard-entity-filename (car section)) path))
+ (handler (elmo-msgdb-message-entity-handler modb))
entity entities)
- (dolist (number (modb-standard-number-list-internal modb))
- (when (and (or (null section)
- (= section (/ number modb-standard-divide-number)))
- (setq entity (elmo-msgdb-message-entity modb number)))
- (when modb-standard-economize-entity-size
- (when (stringp (car entity))
- (setq entity (cons t (cdr entity)))))
- (setq entities (cons entity entities))))
+ (dolist (number (or (cdr section)
+ (modb-standard-number-list-internal modb)))
+ (when (setq entity (elmo-msgdb-message-entity modb number))
+ (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 entities)
+ (elmo-object-save filename
+ (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)
- (let ((sections (modb-generic-message-modified-internal modb)))
- (cond ((listp sections)
- (dolist (section sections)
- (modb-standard-save-entity-1 modb path section)))
- (sections
+ (let ((modified (modb-generic-message-modified-internal modb)))
+ (cond ((listp modified)
+ (let ((sections (mapcar 'list modified))
+ section)
+ (dolist (number (modb-standard-number-list-internal modb))
+ (when (setq section (assq (/ number modb-standard-divide-number)
+ sections))
+ (nconc section (list number))))
+ (dolist (section sections)
+ (modb-standard-save-entity-1 modb path section))))
+ (modified
(modb-standard-save-entity-1 modb path)))))
;;; Implement
(elmo-message-entity-number ret))))
(luna-define-method elmo-msgdb-message-field ((msgdb modb-standard)
- number field)
+ number field &optional type)
(let ((ret (elmo-get-hash-val
(modb-standard-key number)
(modb-standard-entity-map-internal msgdb))))
(cdr (cdr ret))
(elmo-message-entity-field (elmo-msgdb-message-entity
msgdb (modb-standard-key number))
- field))))
+ field type))))
(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
(when key
((numberp key) (modb-standard-key key)))
'autoload)))
+(luna-define-method elmo-msgdb-message-entity-handler ((msgdb modb-standard))
+ (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))
A number is for message number in the MSGDB.
A string is for message-id of the message.")
-(luna-define-generic elmo-msgdb-message-field (msgdb number field)
+(luna-define-generic elmo-msgdb-message-field (msgdb number field
+ &optional type)
"Get message field value in the MSGDB.
NUMBER is a number of the message.
-FIELD is a symbol of the field.")
+FIELD is a symbol of the field.
+If optional argument TYPE is specified, return converted value.")
(luna-define-method elmo-msgdb-message-field ((msgdb modb-generic)
- number field)
+ number field &optional type)
(elmo-message-entity-field (elmo-msgdb-message-entity msgdb number)
- field))
+ field type))
(luna-define-generic elmo-msgdb-message-entity-handler (msgdb)
"Get modb entity handler instance which corresponds to the MSGDB.")
&optional numbers)
(let ((entity (elmo-msgdb-message-entity msgdb number)))
(if entity
- (elmo-msgdb-message-match-condition
- (elmo-msgdb-message-entity-handler msgdb)
+ (elmo-condition-match
condition
- entity
- (elmo-msgdb-flags msgdb number)
- (or numbers (elmo-msgdb-list-messages msgdb)))
+ #'elmo-msgdb-match-condition-primitive
+ (list msgdb number entity
+ (or numbers (elmo-msgdb-list-messages msgdb))))
condition)))
+(defun elmo-msgdb-match-condition-primitive (condition msgdb number entity
+ population)
+ (let ((key (elmo-filter-key condition))
+ (case-fold-search t))
+ (cond
+ ((string= key "last")
+ (<= (length (memq number population))
+ (string-to-int (elmo-filter-value condition))))
+ ((string= key "first")
+ (< (- (length population)
+ (length (memq number population)))
+ (string-to-int (elmo-filter-value condition))))
+ ((string= key "flag")
+ (let ((flags (elmo-msgdb-flags msgdb number)))
+ (cond ((string= (elmo-filter-value condition) "any")
+ (and flags (not (equal flags '(cached)))))
+ ((string= (elmo-filter-value condition) "digest")
+ (catch 'found
+ (dolist (flag flags)
+ (when (or (memq flag elmo-digest-flags)
+ (elmo-global-flag-p flag))
+ (throw 'found t)))))
+ ((string= (elmo-filter-value condition) "read")
+ (not (memq 'read flags)))
+ (t
+ (memq (intern (elmo-filter-value condition)) flags)))))
+ (t
+ (elmo-msgdb-message-match-condition (elmo-message-entity-handler entity)
+ condition entity)))))
+
(luna-define-method elmo-msgdb-update-entity ((msgdb modb-generic)
entity values)
(when (elmo-msgdb-message-entity-update-fields
2.12.1 99 Luftballons
2.13.x You Oughta Know
+
+2.14.0 Africa
+
+2.15.x Almost Unreal
\ No newline at end of file
+2005-04-04 Tetsurou Okazaki <okazaki@be.to>
+
+ * wl-action.el (wl-summary-exec): Reduce loop strength in a dolist loop.
+
+2005-04-03 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-thread.el (wl-thread-delete-message): Delete descendant
+ numbers from `wl-summary-buffer-number-list' if `deep' is non-nil.
+
+2005-04-03 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-xmas.el (wl-folder-internal-icon-list): Fix last change.
+
+2005-03-27 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * wl-xmas.el (wl-folder-internal-icon-list): Added entry for
+ `Access folder'.
+
+2005-03-27 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-vars.el (wl-access-folder-icon): New user option.
+
+ * wl-e21.el (wl-folder-internal-icon-list): Added entry for
+ `Access folder'.
+
+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
+ `elmo-parse-addresses' (move to `elmo-util.el').
+
+ * wl-summary.el (wl-summary-default-from): Follow the API change.
+ (wl-summary-overview-entity-compare-by-date): Ditto.
+ (wl-summary-overview-entity-compare-by-from): Ditto.
+ (wl-summary-get-list-info): Get value of `ml-info' field from
+ entity at first.
+ (wl-summary-rescan-message): Treat prefix argument.
+ (wl-summary-prefetch-msg): Follow the API change.
+ (wl-summary-search-by-subject): Ditto.
+ (wl-summary-insert-thread): Ditto.
+ (wl-summary-line-subject): Ditto.
+ (wl-summary-line-from): Ditto.
+ (wl-summary-create-line): Ditto.
+ (wl-summary-print-message-with-ps-print): Ditto.
+
+ * wl-score.el (wl-score-ov-entity-get): Ditto.
+ (wl-score-followup): Ditto.
+ (wl-score-add-followups): Use `elmo-message-entity-field' instead
+ of `car'.
+ (wl-score-get-latest-msgs): Follow the API change.
+ (wl-score-get-header): Ditto.
+
+ * wl-refile.el (wl-refile-learn): Ditto.
+ (wl-refile-subject-learn): Ditto.
+ (wl-refile-get-field-value): Ditto.
+ (wl-refile-guess-by-history): Ditto.
+ (wl-refile-guess-by-subject): Ditto.
+
+ * wl-mime.el (wl-mime-combine-message/partial-pieces): Ditto.
+
+ * wl-expire.el (wl-expire-date-p): Removed.
+ (wl-expire-archive-date): Follow the API change.
+ (wl-expire-localdir-date): Ditto.
+ (wl-summary-expire): Ditto.
+
+ * Version number is increased to 2.15.1.
+
+2005-03-20 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * wl-fldmgr.el (wl-fldmgr-add): Create folder after testing parent
+ group is access or not (it is not strict, like wl-fldmgr-rename).
+
+2005-03-17 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * wl-thread.el (wl-thread-update-line-on-buffer-sub): Avoid
+ duplicate call of `wl-summary-print-argument' on the wrong line.
+
+2005-03-17 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-jump-to-msg): Don't interactive input
+ even if argument `number' is nil.
+ (wl-summary-insert-line): Print action argument if current message
+ has it.
+
+2005-03-16 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-draft.el (wl-draft-forward): Call `wl-draft' with number.
+ (wl-draft-reply): Ditto.
+ (wl-draft): Add optional argument `parent-number' and call
+ `wl-draft-create-buffer' with it.
+ (wl-draft-create-buffer): Add optional argument
+ `parent-number'. Set wl-draft-parent-number as it.
+
+2005-03-13 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * wl-folder.el (wl-folder-set-persistent-mark): If summary
+ buffer is not for given folder, don't use it.
+
+2005-03-13 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * Version number is increased to 2.15.0.
+
2005-03-11 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
* wl.el (wl-init): Call `elmo-global-flags-initialize'.
;; collected is a pair of
;; mark-string and a list of mark-info
(dolist (pair collected)
- (setq action (assoc (car pair) wl-summary-mark-action-list))
- (when (and (cdr pair) (wl-summary-action-exec-function action))
- (setq modified t)
- (setq failures (+ failures (funcall
- (wl-summary-action-exec-function action)
- (cdr pair))))))
+ (when (cdr pair)
+ (setq action (assoc (car pair) wl-summary-mark-action-list))
+ (when (wl-summary-action-exec-function action)
+ (setq modified t)
+ (setq failures (+ failures (funcall
+ (wl-summary-action-exec-function action)
+ (cdr pair)))))))
(when modified
(wl-summary-set-message-modified))
(run-hooks 'wl-summary-exec-hook)
(wl-draft (list (cons 'To "")
(cons 'Subject subject)
(cons 'References references))
- nil nil nil nil parent-folder))
- (setq wl-draft-parent-number number)
+ nil nil nil nil parent-folder number))
(goto-char (point-max))
(wl-draft-insert-message)
(mail-position-on-field "To")
(cons 'In-Reply-To in-reply-to)
(cons 'References references)
(cons 'Mail-Followup-To mail-followup-to))
- nil nil nil nil parent-folder)
- (setq wl-draft-parent-number number)
+ nil nil nil nil parent-folder number)
(setq wl-draft-reply-buffer buf)
(setq wl-draft-config-variables
(append wl-draft-parent-variables
(defun wl-draft (&optional header-alist
content-type content-transfer-encoding
body edit-again
- parent-folder)
+ parent-folder
+ parent-number)
"Write and send mail/news message with Wanderlust."
(interactive)
(require 'wl)
(wl-set-save-drafts)
(let (buffer header-alist-internal)
- (setq buffer (wl-draft-create-buffer parent-folder))
+ (setq buffer (wl-draft-create-buffer parent-folder parent-number))
(unless (cdr (assq 'From header-alist))
(setq header-alist
(append (list (cons 'From wl-from)) header-alist)))
(goto-char (point-max))))
buffer))
-(defun wl-draft-create-buffer (&optional parent-folder)
+(defun wl-draft-create-buffer (&optional parent-folder parent-number)
(let* ((draft-folder (wl-draft-get-folder))
(parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
(summary-buf (wl-summary-get-buffer parent-folder))
(setq wl-sent-message-queued nil)
(setq wl-draft-config-exec-flag t)
(setq wl-draft-parent-folder (or parent-folder ""))
+ (setq wl-draft-parent-number parent-number)
(or (eq this-command 'wl-folder-write-current-folder)
(setq wl-draft-buffer-cur-summary-buffer summary-buf))
buffer))
(wl-folder-nmz-image . wl-nmz-folder-icon)
(wl-folder-shimbun-image . wl-shimbun-folder-icon)
(wl-folder-file-image . wl-file-folder-icon)
+ (wl-folder-access-image . wl-access-folder-icon)
(wl-folder-trash-empty-image . wl-empty-trash-folder-icon)
(wl-folder-draft-image . wl-draft-folder-icon)
(wl-folder-queue-image . wl-queue-folder-icon)
(timezone-make-time-string
(aref (, date) 3) (aref (, date) 4) (aref (, date) 5)))))
-(defsubst wl-expire-date-p (key-datevec date)
- (let ((datevec (condition-case nil
- (timezone-fix-time date nil nil)
- (error nil))))
- (and
- datevec (> (aref datevec 1) 0)
- (string<
- (wl-expire-make-sortable-date datevec)
- (wl-expire-make-sortable-date key-datevec)))))
-
;; New functions to avoid accessing to the msgdb directly.
(defsubst wl-expire-message-p (folder number)
"Return non-nil when a message in the FOLDER with NUMBER can be expired."
(wl-append deleted-list (car (wl-expire-delete folder dels))))
(setq delete-list (car tmp))
(while (setq msg (wl-pop delete-list))
- (setq date (elmo-message-field folder msg 'date))
+ (setq date (elmo-time-make-date-string
+ (elmo-message-field folder msg 'date)))
(setq time
(condition-case nil
(timezone-fix-time date nil nil)
msg arcmsg-alist arcmsg-list
deleted-list ret-val)
(while (setq msg (wl-pop delete-list))
- (setq date (elmo-message-field folder msg 'date))
+ (setq date (elmo-time-make-date-string
+ (elmo-message-field folder msg 'date)))
(setq time
(condition-case nil
(timezone-fix-time date nil nil)
(setq count (1- count))))
(setq msgs (cdr msgs))))))
((eq val-type 'date)
- (let* ((key-date (elmo-date-get-offset-datevec
- (timezone-fix-time (current-time-string)
- (current-time-zone) nil)
- value t)))
+ (let* ((key-date (elmo-datevec-to-time
+ (elmo-date-get-offset-datevec
+ (timezone-fix-time (current-time-string)
+ (current-time-zone) nil)
+ value t))))
(elmo-folder-do-each-message-entity (entity folder)
- (when (wl-expire-date-p
- key-date
- (elmo-message-entity-field entity 'date))
+ (when (elmo-time<
+ (elmo-message-entity-field entity 'date)
+ key-date)
(wl-append delete-list
(list (elmo-message-entity-number entity)))))))
(t
(setq indent (wl-fldmgr-make-indent (nth 1 tmp)))
(or name
(setq name (wl-fldmgr-read-string
- (wl-summary-read-folder wl-default-folder "to add"))))
- ;; maybe add elmo-plugged-alist.
- (elmo-folder-set-plugged (wl-folder-get-elmo-folder
- (if (listp name) (car name) name))
- wl-plugged t)
- (when (setq diffs
- (wl-add-entity
- path (list name) wl-folder-entity (nth 3 tmp) t))
- (wl-folder-insert-entity indent name)
- (wl-fldmgr-update-group path diffs)
- (setq wl-fldmgr-modified t)
- (set-buffer-modified-p nil)
- (setq ret-val t)))
- ret-val)))
+ (wl-summary-read-folder wl-default-folder
+ "to add" nil t))))
+ (let ((parent (nth 2 (wl-fldmgr-get-path-from-buffer))))
+ (if (eq (cdr parent) 'access)
+ (if (string-match
+ (format "^%s" (regexp-quote (car parent))) name)
+ ;; force update access group
+ (progn
+ (wl-folder-confirm-existence
+ (wl-folder-get-elmo-folder name))
+ (wl-folder-open-close)
+ (wl-folder-jump-to-current-entity t)
+ (setq ret-val t))
+ (error "Can't insert folder under access group"))
+ (wl-folder-confirm-existence (wl-folder-get-elmo-folder name))
+ ;; maybe add elmo-plugged-alist.
+ (elmo-folder-set-plugged (wl-folder-get-elmo-folder
+ (if (listp name) (car name) name))
+ wl-plugged t)
+ (when (setq diffs
+ (wl-add-entity
+ path (list name) wl-folder-entity (nth 3 tmp) t))
+ (wl-folder-insert-entity indent name)
+ (wl-fldmgr-update-group path diffs)
+ (setq wl-fldmgr-modified t)
+ (set-buffer-modified-p nil)
+ (setq ret-val t)))
+ ret-val)))))
(defun wl-fldmgr-delete ()
(interactive)
(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)
(defun wl-folder-set-persistent-mark (folder number flag)
"Set a persistent mark which corresponds to the specified flag on message."
- (let ((buffer (wl-summary-get-buffer folder))
- elmo-folder)
- (if buffer
+ (let ((buffer (wl-summary-get-buffer folder)))
+ (if (and buffer
+ (with-current-buffer buffer
+ (string= wl-summary-buffer-folder-name folder)))
(with-current-buffer buffer
(wl-summary-set-persistent-mark flag number))
;; Parent buffer does not exist.
- (when (setq elmo-folder (and folder
- (wl-folder-get-elmo-folder folder)))
+ (let ((elmo-folder (wl-folder-get-elmo-folder folder)))
(elmo-folder-open elmo-folder 'load-msgdb)
(elmo-folder-set-flag elmo-folder (list wl-draft-parent-number) flag)
(elmo-folder-close elmo-folder)))))
(elmo-folder-do-each-message-entity (entity folder)
(when (string-match
(regexp-quote subject-id)
- (elmo-message-entity-field entity 'subject 'decode))
+ (elmo-message-entity-field entity 'subject))
(let* ((message
;; request message at the cursor in Subject buffer.
(wl-message-request-partial
(let (tocc-list from key hit ml)
(setq dst (elmo-string dst))
(setq tocc-list
- (mapcar (function
- (lambda (entity)
- (downcase (wl-address-header-extract-address entity))))
- (wl-parse-addresses
- (concat
- (elmo-message-entity-field entity 'to) ","
- (elmo-message-entity-field entity 'cc)))))
+ (mapcar (lambda (entity)
+ (downcase (wl-address-header-extract-address entity)))
+ (append
+ (elmo-message-entity-field entity 'to)
+ (elmo-message-entity-field entity 'cc))))
(while tocc-list
(if (wl-string-member
(car tocc-list)
(defun wl-refile-subject-learn (entity dst)
(let ((subject (funcall wl-summary-subject-filter-function
- (elmo-message-entity-field entity 'subject 'decode)))
+ (elmo-message-entity-field entity 'subject)))
hit)
(setq dst (elmo-string dst))
(if (and subject (not (string= subject "")))
(defun wl-refile-get-field-value (entity field)
"Get FIELD value from ENTITY."
- (elmo-message-entity-field entity (intern (downcase field)) 'decode))
+ (elmo-message-entity-field entity (intern (downcase field)) 'string))
(defun wl-refile-guess-by-rule (entity)
(let ((rules wl-refile-rule-alist)
(defun wl-refile-guess-by-history (entity)
(let ((tocc-list
- (mapcar (function
- (lambda (entity)
- (downcase (wl-address-header-extract-address entity))))
- (wl-parse-addresses
- (concat
- (elmo-message-entity-field entity 'to) ","
- (elmo-message-entity-field entity 'cc)))))
+ (mapcar (lambda (entity)
+ (downcase (wl-address-header-extract-address entity)))
+ (append
+ (elmo-message-entity-field entity 'to)
+ (elmo-message-entity-field entity 'cc))))
ret-val)
(setq tocc-list (wl-address-delete-user-mail-addresses tocc-list))
(while tocc-list
(defun wl-refile-guess-by-subject (entity)
(cdr (assoc (funcall wl-summary-subject-filter-function
- (elmo-message-entity-field entity 'subject 'decode))
+ (elmo-message-entity-field entity 'subject))
wl-refile-subject-alist)))
(require 'product)
(not (or (string< s1 s2)
(string= s1 s2))))
-(defsubst wl-score-ov-entity-get (entity index &optional extra decode)
- (elmo-message-entity-field entity (if extra (intern extra) index) decode))
+(defsubst wl-score-ov-entity-get (entity index &optional extra)
+ (elmo-message-entity-field entity (if extra (intern extra) index)))
(defun wl-score-string< (a1 a2)
(string-lessp (wl-score-ov-entity-get (car a1) wl-score-index)
(< expire
(setq day
(wl-day-number
- (elmo-message-entity-field
- (car art) 'date))))))
+ (elmo-time-make-date-string
+ (elmo-message-entity-field
+ (car art) 'date)))))))
(when (setq new (wl-score-add-followups
(car art) score all-scores alist thread
day))
(list (cons "references" news)))))
(defun wl-score-add-followups (header score scores alist &optional thread day)
- (let* ((id (car header))
+ (let* ((id (elmo-message-entity-field header 'message-id))
(scores (car scores))
entry dont)
(when id
(catch 'break
(while rnumbers
(if (< (wl-day-number
- (elmo-message-entity-field
- (elmo-message-entity wl-summary-buffer-elmo-folder
- (car rnumbers))
- 'date))
+ (elmo-time-make-date-string
+ (elmo-message-entity-field
+ (elmo-message-entity wl-summary-buffer-elmo-folder
+ (car rnumbers))
+ 'date)))
expire)
(throw 'break t))
(wl-push (car rnumbers) msgs)
(wl-score-ov-entity-get
(elmo-message-entity wl-summary-buffer-elmo-folder
(wl-summary-message-number))
- index extra decode))))
+ index extra))))
(defun wl-score-kill-help-buffer ()
(when (get-buffer "*Score Help*")
(wl-summary-buffer-folder-name))
(wl-address-user-mail-address-p from)
(cond
- ((and (setq tos (elmo-message-entity-field
- wl-message-entity 'to t))
- (not (string= "" tos)))
+ ((setq tos (elmo-message-entity-field wl-message-entity 'to))
(setq retval
(concat "To:"
(mapconcat
- (function
- (lambda (to)
- (eword-decode-string
- (if wl-use-petname
- (or
- (funcall
- wl-summary-get-petname-function to)
- (car
- (std11-extract-address-components to))
- to)
- to))))
- (wl-parse-addresses tos)
+ (lambda (to)
+ (if wl-use-petname
+ (or
+ (funcall
+ wl-summary-get-petname-function to)
+ (car
+ (std11-extract-address-components to))
+ to)
+ to))
+ tos
","))))
((setq ng (elmo-message-entity-field
wl-message-entity 'newsgroups))
(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
(defun wl-summary-overview-entity-compare-by-date (x y)
"Compare entity X and Y by date."
(condition-case nil
- (string<
- (timezone-make-date-sortable
- (elmo-message-entity-field x 'date))
- (timezone-make-date-sortable
- (elmo-message-entity-field y 'date)))
+ (elmo-time<
+ (elmo-message-entity-field x 'date)
+ (elmo-message-entity-field y 'date))
(error))) ;; ignore error.
(defun wl-summary-overview-entity-compare-by-number (x y)
(defun wl-summary-overview-entity-compare-by-from (x y)
"Compare entity X and Y by from."
(string<
- (or (elmo-message-entity-field x 'from t)
+ (or (elmo-message-entity-field x 'from)
wl-summary-no-from-message)
- (or (elmo-message-entity-field y 'from t)
+ (or (elmo-message-entity-field y 'from)
wl-summary-no-from-message)))
(defun wl-summary-overview-entity-compare-by-subject (x y)
(defun wl-summary-get-list-info (entity)
"Returns (\"ML-name\" . ML-count) of ENTITY."
- (let (sequence ml-name ml-count subject return-path delivered-to mailing-list)
- (setq sequence (elmo-message-entity-field entity 'x-sequence)
- ml-name (or (elmo-message-entity-field entity 'x-ml-name)
- (and sequence
- (car (split-string sequence " "))))
- ml-count (or (elmo-message-entity-field entity 'x-mail-count)
- (elmo-message-entity-field entity 'x-ml-count)
- (and sequence
- (cadr (split-string sequence " ")))))
- (and (setq subject (elmo-message-entity-field entity 'subject t))
- (setq subject (elmo-delete-char ?\n subject))
- (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" subject)
- (progn
- (or ml-name (setq ml-name (match-string 1 subject)))
- (or ml-count (setq ml-count (match-string 2 subject)))))
- (and (setq return-path
- (elmo-message-entity-field entity 'return-path))
- (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-" return-path)
- (progn
- (or ml-name (setq ml-name (match-string 1 return-path)))
- (or ml-count (setq ml-count (match-string 2 return-path)))))
- (and (setq delivered-to
- (elmo-message-entity-field entity 'delivered-to))
- (string-match "^mailing list \\([^@]+\\)@" delivered-to)
- (or ml-name (setq ml-name (match-string 1 delivered-to))))
- (and (setq mailing-list
- (elmo-message-entity-field entity 'mailing-list))
- ;; *-help@, *-owner@, etc.
- (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" mailing-list)
- (or ml-name (setq ml-name (match-string 2 mailing-list))))
- (cons (and ml-name (car (split-string ml-name " ")))
- (and ml-count (string-to-int ml-count)))))
+ (or (elmo-message-entity-field entity 'ml-info)
+ (let (sequence ml-name ml-count subject
+ return-path delivered-to mailing-list)
+ (setq sequence (elmo-message-entity-field entity 'x-sequence)
+ ml-name (or (elmo-message-entity-field entity 'x-ml-name)
+ (and sequence
+ (car (split-string sequence " "))))
+ ml-count (or (elmo-message-entity-field entity 'x-mail-count)
+ (elmo-message-entity-field entity 'x-ml-count)
+ (and sequence
+ (cadr (split-string sequence " ")))))
+ (and (setq subject (elmo-message-entity-field entity 'subject))
+ (setq subject (elmo-delete-char ?\n subject))
+ (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*"
+ subject)
+ (progn
+ (or ml-name (setq ml-name (match-string 1 subject)))
+ (or ml-count (setq ml-count (match-string 2 subject)))))
+ (and (setq return-path
+ (elmo-message-entity-field entity 'return-path))
+ (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-" return-path)
+ (progn
+ (or ml-name (setq ml-name (match-string 1 return-path)))
+ (or ml-count (setq ml-count (match-string 2 return-path)))))
+ (and (setq delivered-to
+ (elmo-message-entity-field entity 'delivered-to))
+ (string-match "^mailing list \\([^@]+\\)@" delivered-to)
+ (or ml-name (setq ml-name (match-string 1 delivered-to))))
+ (and (setq mailing-list
+ (elmo-message-entity-field entity 'mailing-list))
+ ;; *-help@, *-owner@, etc.
+ (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@"
+ mailing-list)
+ (or ml-name (setq ml-name (match-string 2 mailing-list))))
+ (cons (and ml-name (car (split-string ml-name " ")))
+ (and ml-count (string-to-int ml-count))))))
(defun wl-summary-overview-entity-compare-by-list-info (x y)
"Compare entity X and Y by mailing-list info."
(defun wl-summary-rescan-message (number &optional reparent)
"Rescan current message without updating."
- (interactive (list (wl-summary-message-number)))
+ (interactive (list (wl-summary-message-number) current-prefix-arg))
(let ((start-number (wl-summary-message-number))
(start-column (current-column)))
(when (wl-summary-jump-to-msg number)
(or
(elmo-message-entity-field
wl-message-entity
- 'from t)
+ 'from)
"??")))))
" ]")
size))))
(funcall wl-summary-buffer-mode-line-formatter)))
(defun wl-summary-jump-to-msg (&optional number beg end)
- (interactive "NJump to Number:")
- (let ((num (or number
- (string-to-int
- (read-from-minibuffer "Jump to Message(No.): "))))
- (pos (point))
- regexp)
- (setq regexp (concat "\r" (int-to-string num) "[^0-9]"))
- (if (and beg end (or (< pos beg) (< end pos)))
- (progn
- (goto-char beg)
- (if (re-search-forward regexp end t)
- (progn (backward-char 1) (beginning-of-line) t)
- (goto-char pos)
- nil))
- (beginning-of-line)
- (if (or (and (re-search-forward regexp end t)
- (progn (backward-char 1) t))
- (re-search-backward regexp beg t))
- (progn (beginning-of-line) t)
- nil))))
+ (interactive "NJump to Message (No.): ")
+ (when number
+ (let ((pos (point))
+ regexp)
+ (setq regexp (concat "\r" (int-to-string number) "[^0-9]"))
+ (if (and beg end (or (< pos beg) (< end pos)))
+ (progn
+ (goto-char beg)
+ (if (re-search-forward regexp end t)
+ (progn (backward-char 1) (beginning-of-line) t)
+ (goto-char pos)
+ nil))
+ (beginning-of-line)
+ (if (or (and (re-search-forward regexp end t)
+ (progn (backward-char 1) t))
+ (re-search-backward regexp beg t))
+ (progn (beginning-of-line) t)
+ nil)))))
(defun wl-summary-highlight-msgs (msgs)
(save-excursion
(save-excursion (end-of-line)(point))
'mouse-face nil))
(insert line "\n")
+ (save-excursion
+ (forward-line -1)
+ (let* ((number (wl-summary-message-number))
+ (mark-info (wl-summary-registered-temp-mark number)))
+ (when (and mark-info (nth 2 mark-info))
+ (wl-summary-print-argument number (nth 2 mark-info)))))
(if wl-use-highlight-mouse-line
;; remove 'mouse-face of current line.
(put-text-property
(` (elmo-get-hash-val (format "#%d" (wl-count-lines))
wl-summary-alike-hashtb)))
-(defun wl-summary-insert-headers (folder func mime-decode)
+(defun wl-summary-insert-headers (folder func &optional mime-decode)
(let ((numbers (elmo-folder-list-messages folder 'visible t))
ov this last alike)
(buffer-disable-undo (current-buffer))
(function
(lambda (x)
(funcall wl-summary-subject-filter-function
- (elmo-message-entity-field x 'subject))))
- t)
+ (elmo-message-entity-field x 'subject)))))
(message "Creating subject cache...done"))
(setq match (funcall wl-summary-subject-filter-function
- (elmo-message-entity-field entity 'subject
- 'decode)))
+ (elmo-message-entity-field entity 'subject)))
(if (string= match "")
(setq match "\n"))
(goto-char (point-max))
(if (and parent-number
wl-summary-divide-thread-when-subject-changed
(not (wl-summary-subject-equal
- (or (elmo-message-entity-field entity
- 'subject t) "")
+ (or (elmo-message-entity-field entity 'subject) "")
(or (elmo-message-entity-field parent-entity
- 'subject t) ""))))
+ 'subject) ""))))
(setq parent-number nil))
(setq retval
(wl-thread-insert-message entity
(elmo-delete-char ?\n
(or (elmo-message-entity-field
wl-message-entity
- 'subject t)
+ 'subject)
wl-summary-no-subject-message)))
(setq parent-raw-subject
- (elmo-message-entity-field wl-parent-message-entity
- 'subject t))
+ (elmo-message-entity-field wl-parent-message-entity 'subject))
(setq parent-subject
(if parent-raw-subject
(elmo-delete-char ?\n parent-raw-subject)))
(if (or no-parent
(null parent-subject)
- (not (wl-summary-subject-equal
- subject parent-subject)))
+ (not (wl-summary-subject-equal subject parent-subject)))
(funcall wl-summary-subject-function subject)
"")))
(funcall wl-summary-from-function
(elmo-message-entity-field
wl-message-entity
- 'from t))))
+ 'from))))
(defun wl-summary-line-list-info ()
(let ((list-info (wl-summary-get-list-info wl-message-entity)))
wl-cached))
(elmo-mime-charset wl-summary-buffer-mime-charset)
(elmo-lang wl-summary-buffer-weekday-name-lang)
- (wl-datevec (or (ignore-errors (timezone-fix-time
- (elmo-message-entity-field
- wl-message-entity
- 'date)
- nil
- wl-summary-fix-timezone))
+ (wl-datevec (or (ignore-errors
+ (timezone-fix-time
+ (elmo-time-make-date-string
+ (elmo-message-entity-field wl-message-entity 'date))
+ nil
+ wl-summary-fix-timezone))
(make-vector 5 0)))
(entity wl-message-entity) ; backward compatibility.
line mark)
(wl-summary-message-number))))
(wl-ps-subject
(and entity
- (or (elmo-message-entity-field entity 'subject t)
+ (or (elmo-message-entity-field entity 'subject)
"")))
(wl-ps-from
(and entity
- (or (elmo-message-entity-field entity 'from t) "")))
+ (or (elmo-message-entity-field entity 'from) "")))
(wl-ps-date
(and entity
- (or (elmo-message-entity-field entity 'date) ""))))
+ (or (elmo-time-make-date-string
+ (elmo-message-entity-field entity 'date)) ""))))
(run-hooks 'wl-ps-preprint-hook)
(set-buffer wl-message-buffer)
(copy-to-buffer buffer (point-min) (point-max))
(parent-msg (or parent-msg (wl-thread-entity-get-parent entity)))
(buffer-read-only nil)
(inhibit-read-only t)
- message-entity temp-mark summary-line invisible-top dest-pair)
+ message-entity temp-mark summary-line invisible-top)
(if (wl-thread-delete-line-from-buffer msg)
(progn
(cond
((memq msg wl-summary-buffer-target-mark-list)
(setq temp-mark "*"))
((setq temp-mark (wl-summary-registered-temp-mark msg))
- (setq dest-pair (cons (nth 0 temp-mark)(nth 2 temp-mark))
- temp-mark (nth 1 temp-mark)))
+ (setq temp-mark (nth 1 temp-mark)))
(t (setq temp-mark (wl-summary-get-score-mark msg))))
(when (setq message-entity
(elmo-message-entity wl-summary-buffer-elmo-folder
nil
(wl-thread-maybe-get-children-num msg))
(wl-thread-make-indent-string entity)
- (wl-thread-entity-get-linked entity)))
- (if dest-pair
- (wl-summary-print-argument (car dest-pair)
- (cdr dest-pair)))))
+ (wl-thread-entity-get-linked entity)))))
;; insert thread (moving thread)
(if (not (setq invisible-top
(wl-thread-entity-parent-invisible-p entity)))
(setq wl-summary-buffer-number-list
(delq msg wl-summary-buffer-number-list))
(when entity
+ (when deep
+ (setq wl-summary-buffer-number-list
+ (elmo-list-delete
+ (wl-thread-entity-get-descendant entity)
+ wl-summary-buffer-number-list
+ #'delq)))
(let ((parent (wl-thread-entity-get-parent-entity entity)))
(if parent
;; has parent.
(defalias 'wl-string-assoc 'elmo-string-assoc)
(defalias 'wl-string-rassoc 'elmo-string-rassoc)
-(defun wl-parse-addresses (string)
- (if (null string)
- ()
- (elmo-set-work-buf
- ;;(unwind-protect
- (let (list start s char)
- (insert string)
- (goto-char (point-min))
- (skip-chars-forward "\t\f\n\r ")
- (setq start (point))
- (while (not (eobp))
- (skip-chars-forward "^\"\\,(")
- (setq char (following-char))
- (cond ((= char ?\\)
- (forward-char 1)
- (if (not (eobp))
- (forward-char 1)))
- ((= char ?,)
- (setq s (buffer-substring start (point)))
- (if (or (null (string-match "^[\t\f\n\r ]+$" s))
- (not (string= s "")))
- (setq list (cons s list)))
- (skip-chars-forward ",\t\f\n\r ")
- (setq start (point)))
- ((= char ?\")
- (re-search-forward "[^\\]\"" nil 0))
- ((= char ?\()
- (let ((parens 1))
- (forward-char 1)
- (while (and (not (eobp)) (not (zerop parens)))
- (re-search-forward "[()]" nil 0)
- (cond ((or (eobp)
- (= (char-after (- (point) 2)) ?\\)))
- ((= (preceding-char) ?\()
- (setq parens (1+ parens)))
- (t
- (setq parens (1- parens)))))))))
- (setq s (buffer-substring start (point)))
- (if (and (null (string-match "^[\t\f\n\r ]+$" s))
- (not (string= s "")))
- (setq list (cons s list)))
- (nreverse list)) ; jwz: fixed order
- )))
+(defalias 'wl-parse-addresses 'elmo-parse-addresses)
(defun wl-append-element (list element)
(if element
"*Icon file for file folder.")
(defvar wl-maildir-folder-icon "maildir.xpm"
"*Icon file for maildir folder.")
+(defvar wl-access-folder-icon "access.xpm"
+ "*Icon file for access folder.")
(defvar wl-empty-trash-folder-icon "trash-e.xpm"
"*Icon file for emptied trash folder.")
(defvar wl-trash-folder-icon "trash.xpm"
"Wanderlust" nil
(eval-when-compile
(product-version (product-find 'elmo-version))) ; equals to ELMO version.
- "You Oughta Know"))
+ "Almost Unreal"))
(defconst wl-version-status nil
"Wanderlust verstion status. For override default rule.
(wl-folder-nmz-glyph . wl-nmz-folder-icon)
(wl-folder-shimbun-glyph . wl-shimbun-folder-icon)
(wl-folder-file-glyph . wl-file-folder-icon)
+ (wl-folder-access-glyph . wl-access-folder-icon)
(wl-folder-trash-empty-glyph . wl-empty-trash-folder-icon)
(wl-folder-draft-glyph . wl-draft-folder-icon)
(wl-folder-queue-glyph . wl-queue-folder-icon)
projects / elisp / wanderlust.git / commitdiff