+2005-09-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * WL-ELS (ELMO-MODULES): Added elmo-search.
+
2005-02-19 Yoichi NAKAYAMA <yoichi@geiin.org>
* WL-MK (wl-news-search-regexp): Allow ".x" at the
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
elmo-multi elmo-access elmo-filter
elmo-archive elmo-pipe elmo-cache
elmo-internal elmo-flag elmo-sendlog elmo-null
- elmo-dop elmo-nmz elmo-file elmo-split
+ elmo-dop elmo-nmz elmo-search elmo-file elmo-split
elmo-spam elsp-bogofilter elsp-sa elsp-bsfilter elsp-spamoracle
modb modb-entity modb-legacy modb-standard
))
-\def\versionnumber{2.13.3}
+\def\versionnumber{2.15.2}
-@set VERSION 2.13.3
+@set VERSION 2.15.2
@example
@group
-@samp{-} @var{\e$B%K%e!<%9%0%k!<%WL>\e(B} [[@samp{:} @var{\e$B%f!<%6L>\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}]][@samp{!}]
+@samp{-} @var{\e$B%K%e!<%9%0%k!<%WL>\e(B} [@samp{:} @var{\e$B%f!<%6L>\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}][@samp{!}]
@end group
@end example
@example
@group
-@samp{&} [@var{\e$B%f!<%6L>\e(B}][[@samp{/} @var{\e$BG'>ZK!\e(B}][@samp{:} @var{\e$BHV9f$N?6$jJ}\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}]][@samp{!}]
+@samp{&} [@var{\e$B%f!<%6L>\e(B}][@samp{/} @var{\e$BG'>ZK!\e(B}][@samp{:} @var{\e$BHV9f$N?6$jJ}\e(B}][@samp{@@} @var{\e$B%[%9%HL>\e(B}][@samp{:} @var{\e$B%]!<%HHV9f\e(B}][@samp{!}]
@end group
@end example
\e$B4pK\$O\e(B Emacs \e$BI8=`$N%a!<%k%b!<%I$G$9!#\e(B
@menu
+* Parameters for Sending:: \e$BAw?.$N0Y$N%Q%i%a!<%?\e(B
* Editing Header:: \e$B%X%C%@$NJT=8\e(B
* Editing Message Body and Sending:: \e$B%a%C%;!<%8$NJT=8$HAw?.\e(B
* Dynamical Message Re-arrangement:: \e$B%a%C%;!<%8$NF0E*$JJQ99\e(B
* POP-before-SMTP:: POP-before-SMTP \e$B$K$h$k%a!<%k$NAw?.\e(B
@end menu
+@node Parameters for Sending, Editing Header, Usage of Draft Mode, Usage of Draft Mode
+@subsection \e$BAw?.$N0Y$N%Q%i%a!<%?\e(B
-@node Editing Header, Editing Message Body and Sending, Usage of Draft Mode, Usage of Draft Mode
+\e$B%a%C%;!<%8$NAw?.$K;H$&%5!<%P$N>pJs$K1h$C$F0J2<$NJQ?t$r@_Dj$7$F2<$5$$!#\e(B
+
+@table @code
+@item wl-smtp-posting-server
+\e$B%a!<%kAw?.;~$N\e(B SMTP \e$B%5!<%PL>$G$9!#\e(B
+
+@item wl-smtp-posting-port
+\e$B%a!<%kAw?.;~$N\e(B SMTP \e$B%]!<%HHV9f$G$9!#\e(B
+\e$B@_Dj$7$F$$$J$$>l9g$O%G%U%)%k%H$N\e(B SMTP \e$B%]!<%HHV9f\e(B(25)\e$B$r;H$$$^$9!#\e(B
+
+@item wl-nntp-posting-server
+\e$B%K%e!<%9Ej9F;~$N\e(B NNTP \e$B%5!<%PL>$G$9!#\e(B
+\e$B@_Dj$7$F$$$J$$>l9g$O\e(B @code{elmo-nntp-default-server} \e$B$r;H$$$^$9!#\e(B
+
+@item wl-nntp-posting-port
+\e$B%K%e!<%9Ej9F;~$N\e(B NNTP \e$B%5!<%P$N%]!<%HHV9f$G$9!#\e(B
+\e$B@_Dj$7$F$$$J$$>l9g$O\e(B @code{elmo-nntp-default-port} \e$B$r;H$$$^$9!#\e(B
+@end table
+
+\e$BI,MW$K1~$8$F0J2<$NJQ?t$b@_Dj$7$F2<$5$$!#>\:Y$O%+%9%?%^%$%:JQ?t$N@a$r;2>H\e(B
+\e$B$7$F2<$5$$!#\e(B
+@xref{Variables of Draft Mode}.
+
+@table @code
+@item wl-smtp-posting-user
+SMTP AUTH \e$B$K$h$kG'>Z$r9T$J$&$H$-$N%f!<%6L>$G$9!#\e(B
+
+@item wl-smtp-authenticate-type
+SMTP AUTH \e$B$K$h$kG'>Z$r9T$J$&$H$-$NG'>ZJ}<0$G$9!#\e(B
+\e$B@_Dj$7$F$$$J$$>l9g$OG'>Z$r9T$$$^$;$s!#\e(B
+
+@item wl-smtp-authenticate-realm
+SMTP AUTH \e$B$K$h$kG'>Z$r9T$J$&$H$-$N%l%k%`\e(B(realm)\e$B$r;XDj$7$^$9!#\e(B
+\e$B@_Dj$7$F$$$J$$>l9g$O%l%k%`$N;XDj$r9T$$$^$;$s!#\e(B
+
+@item wl-smtp-connection-type
+SMTP \e$B$N%3%M%/%7%g%s$r$I$N$h$&$KD%$k$+$r;XDj$7$^$9!#\e(B
+
+@item wl-nntp-posting-user
+\e$B%K%e!<%9Ej9F;~$K\e(B AUTHINFO \e$B$K$h$kG'>Z$r9T$J$&$H$-$N%f!<%6L>$G$9!#\e(B
+
+@item wl-nntp-posting-stream-type
+NNTP \e$B$N%3%M%/%7%g%s$r$I$N$h$&$KD%$k$+$r;XDj$7$^$9!#\e(B
+@end table
+
+@node Editing Header, Editing Message Body and Sending, Parameters for Sending, Usage of Draft Mode
@subsection \e$B%X%C%@$NJT=8\e(B
\e$B<B:]$KAw?.A`:n$r9T$J$&$^$G$G$"$l$P!"\e(B@samp{--text follows this line--}
@cindex SMTP-after-POP
POP-before-SMTP \e$B$K$h$k%a!<%k$NAw?.$,$G$-$^$9!#\e(B
-\e$B@_Dj$O!"\e(B
+\e$B$=$N$?$a$KI,MW$J@_Dj$O!"%a!<%kAw?.$KMQ$$$k4X?t$r%G%U%)%k%H$N\e(B
+@code{wl-draft-send-mail-with-smtp} \e$B$+$iJQ99$9$k\e(B
@lisp
(setq wl-draft-send-mail-function 'wl-draft-send-mail-with-pop-before-smtp)
@end lisp
@noindent
-\e$B$N\e(B1\e$B9T$N$_$G$9$,!"I,MW$K1~$8$F0J2<$NJQ?t$r@_Dj$7$F$/$@$5$$!#\e(B
+\e$B$H9g$o$;$F!"I,MW$K1~$8$F0J2<$NJQ?t$r@_Dj$7$F$/$@$5$$!#\e(B
@table @code
@item wl-pop-before-smtp-user
@example
@group
-http://spam.ayamura.org/tools/smPbS.html
http://www.iecc.com/pop-before-smtp.html
@end group
@end example
Non-nil \e$B$G!"\e(B@samp{To:}, @samp{Cc:} \e$B$,\e(B \e$BJQ?t\e(B @code{wl-subscribed-mailing-list} \e$B$K\e(B
\e$B4^$^$l$F$$$k>l9g!"\e(B@samp{Bcc:} , @samp{Fcc:} \e$B$r$D$1$^$;$s!%\e(B
+@item wl-draft-send-mail-function
+@vindex wl-draft-send-mail-function
+\e$B=i4|@_Dj$O\e(B @code{wl-draft-send-mail-with-smtp}\e$B!#\e(B
+\e$B%a!<%kAw?.$K;H$&4X?t$G$9!#\e(BPOP-before-SMTP \e$B$rMxMQ$9$k>l9g$O\e(B
+@code{wl-draft-send-mail-with-pop-before-smtp} \e$B$K@_Dj$7$^$9!#\e(B
+
@item wl-smtp-posting-server
@vindex wl-smtp-posting-server
\e$B=i4|@_Dj$O\e(B @code{nil}\e$B!#\e(B
@vindex wl-nntp-posting-port
\e$B=i4|@_Dj$O\e(B @code{nil}\e$B!#\e(B
\e$B%K%e!<%9Ej9F;~$N\e(B NNTP \e$B%5!<%P$N%]!<%HHV9f!#\e(B
-@code{nil} \e$B$J$i\e(B @code{elmo-nntp-default-server} \e$B$r;H$$$^$9!#\e(B
+@code{nil} \e$B$J$i\e(B @code{elmo-nntp-default-port} \e$B$r;H$$$^$9!#\e(B
@item wl-nntp-posting-stream-type
@vindex wl-nntp-posting-stream-type
\e$B%+!<%=%k9T$N%a%C%;!<%8$r%F%9%H$7!"\e(Bspam \e$B$HH=Dj$5$l$?>l9g$K\e(B spam \e$B%^!<%/$r\e(B
\e$BIU$1$^$9!#\e(B
+@item r k c
+@kindex r k c (Summary)
+@findex wl-summary-test-spam-region
+\e$B;XDj%j!<%8%g%s$K$"$k%a%C%;!<%8$r%F%9%H$7!"\e(Bspam \e$B$HH=Dj$5$l$?>l9g$K\e(B spam \e$B%^!<%/$r\e(B
+\e$BIU$1$^$9!#\e(B
+
@item k C
@kindex k C (Summary)
@findex wl-summary-mark-spam
@example
@group
-@samp{-} @var{newsgroup} [[@samp{:} @var{username}][@samp{@@} @var{hostname}][@samp{:} @var{port}]][@samp{!}]
+@samp{-} @var{newsgroup} [@samp{:} @var{username}][@samp{@@} @var{hostname}][@samp{:} @var{port}][@samp{!}]
@end group
@end example
@example
@group
-@samp{&} [@var{username}][[@samp{/} @var{authenticate-type}][@samp{:} @var{numbering-method}][@samp{@@} @var{hostname}][@samp{:} @var{port}]][@samp{!}]
+@samp{&} [@var{username}][@samp{/} @var{authenticate-type}][@samp{:} @var{numbering-method}][@samp{@@} @var{hostname}][@samp{:} @var{port}][@samp{!}]
@end group
@end example
Basically it is Emacs-standard mail mode.
@menu
+* Parameters for Sending::
* Editing Header::
* Editing Message Body and Sending::
* Dynamical Message Re-arrangement::
* POP-before-SMTP::
@end menu
-@node Editing Header, Editing Message Body and Sending, Usage of Draft Mode, Usage of Draft Mode
+@node Parameters for Sending, Editing Header, Usage of Draft Mode, Usage of Draft Mode
+@subsection Parameters for Sending
+
+According to the information of servers to send messages, configure
+following variables.
+
+@table @code
+@item wl-smtp-posting-server
+The name of the SMTP server used for mail transmission.
+
+@item wl-smtp-posting-port
+The SMTP port number for mail transmission.
+Without configuration, use default SMTP port number (25).
+
+@item wl-nntp-posting-server
+The name of NNTP server used for news submission.
+Without configuration, use @code{elmo-nntp-default-server}.
+
+@item wl-nntp-posting-port
+The NNTP port number for news submission.
+Without configuration, use @code{elmo-nntp-default-port}.
+@end table
+
+You may configure following variables on demand. See section
+Variables of Draft Mode for detail @xref{Variables of Draft Mode}.
+
+@table @code
+@item wl-smtp-posting-user
+User name for authentication by SMTP AUTH.
+
+@item wl-smtp-authenticate-type
+The authentication method for SMTP AUTH.
+Without configuration, authentication will not be carried out.
+
+@item wl-smtp-authenticate-realm
+The authentication realm for SMTP AUTH.
+Without configuration, authentication realm will not be specified.
+
+@item wl-smtp-connection-type
+Specify how to establish SMTP connections.
+
+@item wl-nntp-posting-user
+User name for AUTHINFO authentication on news submission.
+
+@item wl-nntp-posting-stream-type
+Specify how to establish NNTP connections.
+@end table
+
+@node Editing Header, Editing Message Body and Sending, Parameters for Sending, Usage of Draft Mode
@subsection Editing Message Header
You can freely edit header region above @samp{--text follows this line--},
@subsection Sending mail by POP-before-SMTP
@cindex POP-before-SMTP
-You can send mail by POP-before-SMTP with this single line:
+You can send mail by POP-before-SMTP. Necessary setting is
@lisp
(setq wl-draft-send-mail-function 'wl-draft-send-mail-with-pop-before-smtp)
@end lisp
@noindent
-Configure the following variables if you need.
+to change mail posting function from its default value @code{wl-draft-send-mail-with-smtp}.
+Also you would configure following variables on demand.
@table @code
@item wl-pop-before-smtp-user
@example
@group
-http://spam.ayamura.org/tools/smPbS.html
http://www.iecc.com/pop-before-smtp.html
@end group
@end example
If any of @code{wl-subscribed-mailing-list} are contained in @samp{To:}
or @samp{Cc:} field, do not insert @samp{Bcc:} or @samp{Fcc:} field.
+@item wl-draft-send-mail-function
+@vindex wl-draft-send-mail-function
+The initial setting is @code{wl-draft-send-mail-with-smtp}.
+This is the function to post mails. To use POP-before-SMTP, set this to
+@code{wl-draft-send-mail-with-pop-before-smtp}.
+
@item wl-smtp-posting-server
@vindex wl-smtp-posting-server
The initial setting is @code{nil}.
@vindex wl-nntp-posting-port
The initial setting is @code{nil}.
This is the port number of the NNTP server used for news submission.
-If @code{nil}, @code{elmo-nntp-default-server} is used.
+If @code{nil}, @code{elmo-nntp-default-port} is used.
@item wl-nntp-posting-stream-type
@vindex wl-nntp-posting-stream-type
@findex wl-summary-test-spam
Test current message and put spam mark if judged as spam.
+@item r k c
+@kindex r k c (Summary)
+@findex wl-summary-test-spam-region
+Test messages in the specified region and put spam mark if judged as spam.
+
@item k C
@kindex k C (Summary)
@findex wl-summary-mark-spam
+2005-09-17 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-version.el (elmo-version): Up to 2.15.2.
+
+2005-09-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-search.el: New file.
+
+2005-09-02 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * modb-entity.el (elmo-msgdb-message-match-condition): Add new
+ condition `larger' and `smaller'.
+
+2005-07-30 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-safe-filename): Rewrite to replace
+ `"' (double quote) into "_Q_".
+
+2005-07-18 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-net.el (elmo-net-quote-chars): Abolish.
+ (elmo-net-format-quoted): Ditto.
+
+2005-06-12 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo.el (elmo-get-folder-function): New variable.
+ (elmo-get-folder): New function.
+ (elmo-folder-rename): Call `elmo-make-folder' with specified
+ mime-charset.
+
+ * elmo-split.el (elmo-split): Use `elmo-get-folder' instead of
+ `elmo-make-folder'.
+ (elmo-split-subr): Ditto.
+
+ * elmo-multi.el (elmo-folder-initialize): Ditto.
+
+ * elmo-internal.el (elmo-folder-list-subfolders): Ditto.
+
+ * elmo-flag.el (elmo-flag-folder-delete-message): Ditto.
+ (elmo-flag-get-folder): Ditto.
+
+ * elmo-filter.el (elmo-folder-initialize): Ditto.
+
+ * elmo-access.el (elmo-folder-initialize): Ditto.
+ (elmo-access-folder-update-children): Ditto.
+
+ * elmo-dop.el (elmo-dop-queue-flush): Ditto.
+ (elmo-dop-queue-flush): Ditto.
+ (elmo-folder-append-buffer-dop-delayed): Ditto.
+ (elmo-dop-spool-folder): Call `elmo-make-folder' with specified
+ mime-charset.
+
+ * elmo-pipe.el (elmo-folder-initialize): Use `elmo-get-folder'
+ instead of `elmo-make-folder'.
+ (elmo-folder-rename): Ditto. Use `elmo-folder-rename' to
+ destination folder instead of send `elmo-folder-rename-internal'.
+
+ * elmo-shimbun.el (elmo-folder-list-subfolders): Use `shimbun'
+ slot of subfolder instead of create it.
+
+2005-06-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-collect-separators): New function.
+ (elmo-collect-separators-internal): Ditto.
+ (elmo-collect-trail-separators): Ditto.
+ (elmo-parse-separated-tokens): Ditto.
+ (elmo-parse-separated-tokens-internal): Ditto.
+ (elmo-quote-syntactical-element): Ditto.
+
+ * elmo-pop3.el (elmo-pop3-folder-name-syntax): New constant.
+ (elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
+
+ * elmo-nntp.el (elmo-nntp-folder-name-syntax): New constant.
+ (elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
+ (elmo-nntp-folder-list-subfolders): Quote a user name.
+
+ * elmo-net.el (elmo-net-folder-name-syntax): New constant.
+ (elmo-net-parse-network): Abolish.
+ (elmo-net-folder-set-parameters): New function.
+ (elmo-folder-initialize): Follow the above change.
+
+ * elmo-imap4.el (elmo-imap4-folder-name-syntax): New constant.
+ (elmo-folder-initialize): Rewrite by `elmo-parse-separated-tokens'.
+ (elmo-folder-list-subfolders): Use
+ `elmo-quote-syntactical-element' instead of
+ `elmo-net-format-quoted' to quote mailbox and user name.
+
+2005-06-07 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-token-valid-p): New function.
+ (elmo-parse-token): Add optional argument `requirement'.
+ (elmo-parse-prefixed-element): Likewise.
+
+ * elmo-net.el (elmo-net-quote-chars): Renamed from
+ `elmo-net-quote-chars-regexp'.
+ (elmo-net-format-quoted): Add optional argument `extra-chars'.
+
+ * elmo-pop3.el (elmo-folder-initialize): Fix the token separators
+ by info document. Check token `uidl' is started an alphabet.
+
+ * elmo-nntp.el (elmo-folder-initialize): Fix the token separators
+ by info document. Check token `user' is started an alphabet.
+
+ * elmo-imap4.el (elmo-folder-initialize): Ditto.
+ (elmo-folder-list-subfolders): Quote user.
+
+2005-06-05 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-quoted-specials-list): New constant.
+ (elmo-quoted-token): New function.
+
+ * elmo-net.el (elmo-net-quote-chars-regexp): New constant.
+ (elmo-net-format-quoted): New function.
+ (elmo-net-parse-network): Ditto.
+ (elmo-folder-initialize): Use it.
+
+ * elmo-nntp.el (elmo-folder-initialize): Use
+ `elmo-net-parse-network' to parse network specification instead of
+ `elmo-folder-initialize#elmo-net'.
+
+ * elmo-pop3.el (elmo-folder-initialize): Ditto.
+
+ * elmo-imap4.el (elmo-folder-initialize): Ditto.
+ (elmo-folder-list-subfolders): Quote folder name by
+ `elmo-net-format-quoted'.
+
+2005-05-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-nntp.el (elmo-nntp-use-server-search-p): New function.
+ (elmo-folder-search): Use it.
+
+2005-04-13 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * modb-standard.el (modb-standard-loaded-message-id): Use
+ `elmo-msgdb-message-entity-field'.
+
+2005-04-11 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-object-load): Call `elmo-set-auto-coding'
+ without filename.
+
+2005-04-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * elmo-util.el (elmo-set-auto-coding): New function.
+ (elmo-object-load): Use it.
+
+2005-04-09 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-date.el (elmo-time-less-p): Renamed from `elmo-time<'.
+ (elmo-time<): Define as alias of `elmo-time-less-p'.
+ (elmo-time-to-datevec): New function.
+
+ * elmo-date.el (elmo-time-to-days): New function.
+
+2005-04-08 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-util.el (elmo-map-recursive): Call `function' if `object'
+ is not cons cell.
+
+2005-04-07 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * modb-entity.el (modb-entity-encode-string-recursive): Fixed
+ parenthesis.
+
+ * elmo-util.el (elmo-map-recursive): New function.
+
+ * modb-entity.el (modb-entity-decode-string-recursive): Use it.
+ (modb-entity-encode-string-recursive): Ditto.
+
+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
(luna-define-method elmo-folder-initialize ((folder elmo-access-folder) name)
(elmo-access-folder-set-base-folder-internal
folder
- (elmo-make-folder name))
+ (elmo-get-folder name))
(elmo-multi-folder-set-children-internal
folder
- (mapcar #'elmo-make-folder
+ (mapcar #'elmo-get-folder
(elmo-object-load
(expand-file-name elmo-access-folder-list-filename
(elmo-folder-msgdb-path folder)))))
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))
(if subfolders
(nconc children
(mapcar (lambda (name)
- (let ((folder (elmo-make-folder name)))
+ (let ((folder (elmo-get-folder name)))
(when open
(elmo-folder-open-internal folder))
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-less-p (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)))
+
+(defalias 'elmo-time< 'elmo-time-less-p)
+
+(defun elmo-time-to-days (time)
+ (let ((date (decode-time time)))
+ (timezone-absolute-from-gregorian
+ (nth 4 date) (nth 3 date) (nth 5 date))))
+
+;; from timezone-fix-time in `timezone.el'
+(defun elmo-time-to-datevec (time &optional timezone)
+ (when time
+ (let* ((date (decode-time time))
+ (year (nth 5 date))
+ (month (nth 4 date))
+ (day (nth 3 date))
+ (hour (nth 2 date))
+ (minute (nth 1 date))
+ (second (nth 0 date))
+ (local (nth 8 date))
+ (timezone
+ (or timezone
+ (timezone-time-zone-from-absolute
+ (timezone-absolute-from-gregorian month day year)
+ (+ second (* 60 (+ minute (* 60 hour)))))))
+ (diff (- (timezone-zone-to-minute timezone) (/ local 60)))
+ (minute (+ minute diff))
+ (hour-fix (floor minute 60)))
+ (setq hour (+ hour hour-fix))
+ (setq minute (- minute (* 60 hour-fix)))
+ ;; HOUR may be larger than 24 or smaller than 0.
+ (cond ((<= 24 hour) ;24 -> 00
+ (setq hour (- hour 24))
+ (setq day (1+ day))
+ (when (< (timezone-last-day-of-month month year) day)
+ (setq month (1+ month))
+ (setq day 1)
+ (when (< 12 month)
+ (setq month 1)
+ (setq year (1+ year)))))
+ ((> 0 hour)
+ (setq hour (+ hour 24))
+ (setq day (1- day))
+ (when (> 1 day)
+ (setq month (1- month))
+ (when (> 1 month)
+ (setq month 12)
+ (setq year (1- year)))
+ (setq day (timezone-last-day-of-month month year)))))
+ (vector year month day hour minute second timezone))))
+
(require 'product)
(product-provide (provide 'elmo-date) (require 'elmo-version))
len)
(while queue-all
(if (elmo-folder-plugged-p
- (elmo-make-folder (elmo-dop-queue-fname (car queue-all))))
+ (elmo-get-folder (elmo-dop-queue-fname (car queue-all))))
(setq queue (append queue (list (car queue-all)))))
(setq queue-all (cdr queue-all)))
(setq count (length queue))
(apply (elmo-dop-queue-method (car queue))
(prog1
(setq folder
- (elmo-make-folder
+ (elmo-get-folder
(elmo-dop-queue-fname (car queue))))
(elmo-folder-open folder)
(unless (elmo-folder-plugged-p folder)
'elmo-folder-append-buffer-dop-delayed)
(elmo-folder-delete-messages
(elmo-dop-spool-folder
- (elmo-make-folder (elmo-dop-queue-fname (car queue))))
+ (elmo-get-folder (elmo-dop-queue-fname (car queue))))
(list (nth 1 (elmo-dop-queue-arguments (car queue))))))
(setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
(setq queue (cdr queue)))
(setq elmo-dop-queue new-queue)))
;;; dop spool folder
-(defmacro elmo-dop-spool-folder (folder)
+(defsubst elmo-dop-spool-folder (folder)
"Return a spool folder for disconnected operations
which is corresponded to the FOLDER."
- (` (elmo-make-folder
- (concat "+" (expand-file-name "spool" (elmo-folder-msgdb-path
- (, folder)))))))
+ (elmo-make-folder
+ (concat "+" (expand-file-name "spool" (elmo-folder-msgdb-path folder)))
+ nil
+ (elmo-folder-mime-charset-internal folder)))
(defun elmo-dop-spool-folder-append-buffer (folder flags)
"Append current buffer content to the dop spool folder.
(error))
;; Append failed...
(elmo-folder-append-buffer
- (elmo-make-folder elmo-lost+found-folder)
+ (elmo-get-folder elmo-lost+found-folder)
flags))
(elmo-folder-delete-messages spool-folder (list number)))))
;; ignore failure (already dequed)
(if (string-match "^ */\\(.*\\)$" (cdr pair))
(elmo-filter-folder-set-target-internal
folder
- (elmo-make-folder (elmo-match-string 1 (cdr pair))))
+ (elmo-get-folder (elmo-match-string 1 (cdr pair))))
(error "Folder syntax error `%s'" (elmo-folder-name-internal folder)))
(elmo-filter-folder-set-require-msgdb-internal
folder
(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)
(elmo-flag-folder-minfo-hash-internal
folder))
(unless keep-referrer
- (setq target-folder (elmo-make-folder (car pair)))
+ (setq target-folder (elmo-get-folder (car pair)))
(elmo-folder-open target-folder 'load-msgdb)
;; Unset the flag of the original folder.
;; (XXX Should the message-id checked?)
(defmacro elmo-flag-get-folder (flag)
"Get the flag folder structure for FLAG."
`(when (memq ,flag elmo-global-flags)
- (elmo-make-folder (concat "'flag/" (symbol-name ,flag)))))
+ (elmo-get-folder (concat "'flag/" (symbol-name ,flag)))))
(defun elmo-flag-folder-referrer (folder number)
"Return a list of referrer message information.
(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"
(personal "$Personal")
(shouldreply "$ShouldReply")))
+(defconst elmo-imap4-folder-name-syntax
+ `(mailbox
+ (?: [user "^[A-Za-z]"] (?/ [auth ".+"]))
+ ,@elmo-net-folder-name-syntax))
+
;; For debugging.
(defvar elmo-imap4-debug nil
"Non-nil forces IMAP4 folder as debug mode.
(elmo-imap4-forward)
(nreverse body)))))
-(luna-define-method elmo-folder-initialize :around ((folder
- elmo-imap4-folder)
- name)
+(luna-define-method elmo-folder-initialize ((folder elmo-imap4-folder) name)
(let ((default-user elmo-imap4-default-user)
(default-server elmo-imap4-default-server)
(default-port elmo-imap4-default-port)
(append elmo-imap4-stream-type-alist
elmo-network-stream-type-alist)
elmo-network-stream-type-alist))
- parse)
+ tokens)
(when (string-match "\\(.*\\)@\\(.*\\)" default-server)
;; case: imap4-default-server is specified like
;; "hoge%imap.server@gateway".
(setq default-user (elmo-match-string 1 default-server))
(setq default-server (elmo-match-string 2 default-server)))
- (setq name (luna-call-next-method))
+ (setq tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-imap4-folder-name-syntax)))
;; mailbox
- (setq parse (elmo-parse-token name ":"))
(elmo-imap4-folder-set-mailbox-internal folder
(elmo-imap4-encode-folder-string
- (car parse)))
+ (cdr (assq 'mailbox tokens))))
;; user
- (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "/"))
(elmo-net-folder-set-user-internal folder
- (if (eq (length (car parse)) 0)
- default-user
- (car parse)))
+ (or (cdr (assq 'user tokens))
+ default-user))
;; auth
- (setq parse (elmo-parse-prefixed-element ?/ (cdr parse)))
(elmo-net-folder-set-auth-internal
folder
- (if (eq (length (car parse)) 0)
- (or elmo-imap4-default-authenticate-type 'clear)
- (intern (car parse))))
- (unless (elmo-net-folder-server-internal folder)
- (elmo-net-folder-set-server-internal folder default-server))
- (unless (elmo-net-folder-port-internal folder)
- (elmo-net-folder-set-port-internal folder default-port))
- (unless (elmo-net-folder-stream-type-internal folder)
- (elmo-net-folder-set-stream-type-internal
- folder
- (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
+ (let ((auth (cdr (assq 'auth tokens))))
+ (or (and auth (intern auth))
+ elmo-imap4-default-authenticate-type
+ 'clear)))
+ ;; network
+ (elmo-net-folder-set-parameters
+ folder
+ tokens
+ (list :server default-server
+ :port default-port
+ :stream-type
+ (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
folder))
;;; ELMO IMAP4 folder
elmo-imap4-default-user))
(not (eq (elmo-net-folder-auth-internal folder)
(or elmo-imap4-default-authenticate-type 'clear))))
- (setq append-serv (concat ":" (elmo-net-folder-user-internal folder))))
+ (setq append-serv (concat ":"
+ (elmo-quote-syntactical-element
+ (elmo-net-folder-user-internal folder)
+ 'user elmo-imap4-folder-name-syntax))))
(unless (eq (elmo-net-folder-auth-internal folder)
(or elmo-imap4-default-authenticate-type 'clear))
(setq append-serv
fld))
(cdr result)))
folder (concat prefix
- (elmo-imap4-decode-folder-string folder)
+ (elmo-quote-syntactical-element
+ (elmo-imap4-decode-folder-string folder)
+ 'mailbox elmo-imap4-folder-name-syntax)
(and append-serv
(eval append-serv)))
ret (append ret (if has-child-p
(list folder)))))
ret)
(mapcar (lambda (fld)
- (concat prefix (elmo-imap4-decode-folder-string fld)
+ (concat prefix
+ (elmo-quote-syntactical-element
+ (elmo-imap4-decode-folder-string fld)
+ 'mailbox elmo-imap4-folder-name-syntax)
(and append-serv
(eval append-serv))))
result))))
: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)))
(lambda (x)
(let ((name (concat (elmo-folder-prefix-internal folder)
(symbol-name x))))
- (if (elmo-folder-have-subfolder-p (elmo-make-folder name))
+ (if (elmo-folder-have-subfolder-p (elmo-get-folder name))
(list name)
name)))
elmo-internal-folder-list)
(lambda (x)
(let* ((name (concat (elmo-folder-prefix-internal folder)
(symbol-name x)))
- (subfolder (elmo-make-folder name)))
+ (subfolder (elmo-get-folder name)))
(if (elmo-folder-have-subfolder-p subfolder)
(elmo-folder-list-subfolders subfolder)
(list name))))
(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))
folder
(nconc (elmo-multi-folder-children-internal
folder)
- (list (elmo-make-folder (car name)))))
+ (list (elmo-get-folder (car name)))))
(setq name (cdr name))
(when (and (> (length name) 0)
(eq (aref name 0) ?,))
(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
;;; Code:
;;
+(defconst elmo-net-folder-name-syntax '((?@ [server ".+"])
+ (?: [port "^[0-9]+$"])
+ (?! stream-type)))
+
;;; ELMO net folder
(eval-and-compile
(luna-define-class elmo-net-folder
(setq alist (cdr alist)))
spec))
-(luna-define-method elmo-folder-initialize ((folder
- elmo-net-folder)
- name)
+(defun elmo-net-folder-set-parameters (folder tokens &optional defaults)
+ (let ((port (cdr (assq 'port tokens)))
+ (stream-type (cdr (assq 'stream-type tokens))))
+ ;; server
+ (elmo-net-folder-set-server-internal
+ folder
+ (or (cdr (assq 'server tokens))
+ (plist-get defaults :server)))
+ ;; port
+ (elmo-net-folder-set-port-internal
+ folder
+ (or (and port (string-to-int port))
+ (plist-get defaults :port)))
+ ;; stream-type
+ (elmo-net-folder-set-stream-type-internal
+ folder
+ (or (and stream-type (assoc (concat "!" stream-type)
+ elmo-network-stream-type-alist))
+ (plist-get defaults :stream-type)))))
+
+(luna-define-method elmo-folder-initialize ((folder elmo-net-folder) name)
;; user and auth should be set in subclass.
(when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name)
- (if (match-beginning 1)
- (elmo-net-folder-set-server-internal
- folder
- (elmo-match-substring 1 name 1)))
- (if (match-beginning 2)
- (elmo-net-folder-set-port-internal
- folder
- (string-to-int (elmo-match-substring 2 name 1))))
- (if (match-beginning 3)
- (elmo-net-folder-set-stream-type-internal
- folder
- (assoc (elmo-match-string 3 name)
- elmo-network-stream-type-alist)))
- (substring name 0 (match-beginning 0))))
+ (elmo-net-folder-set-parameters
+ folder
+ (car (elmo-parse-separated-tokens
+ (substring name (match-beginning 0))
+ elmo-net-folder-name-syntax))))
+ folder)
(luna-define-method elmo-net-port-info ((folder elmo-net-folder))
(list (elmo-net-folder-server-internal folder)
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)
(defvar elmo-nntp-group-coding-system nil
"A coding system for newsgroup string.")
+(defconst elmo-nntp-folder-name-syntax `(group
+ (?: [user "^\\([A-Za-z]\\|$\\)"])
+ ,@elmo-net-folder-name-syntax))
+
(defsubst elmo-nntp-encode-group-string (string)
(if elmo-nntp-group-coding-system
(encode-coding-string string elmo-nntp-group-coding-system)
(group temp-crosses reads))
(luna-define-internal-accessors 'elmo-nntp-folder))
-(luna-define-method elmo-folder-initialize :around ((folder
- elmo-nntp-folder)
- name)
+(luna-define-method elmo-folder-initialize ((folder elmo-nntp-folder) name)
(let ((elmo-network-stream-type-alist
(if elmo-nntp-stream-type-alist
(setq elmo-network-stream-type-alist
(append elmo-nntp-stream-type-alist
elmo-network-stream-type-alist))
elmo-network-stream-type-alist))
- explicit-user parse)
- (setq name (luna-call-next-method))
- (setq parse (elmo-parse-token name ":"))
+ tokens)
+ (setq tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-nntp-folder-name-syntax)))
+ ;; group
(elmo-nntp-folder-set-group-internal folder
(elmo-nntp-encode-group-string
- (car parse)))
- (setq explicit-user (eq ?: (string-to-char (cdr parse))))
- (setq parse (elmo-parse-prefixed-element ?: (cdr parse)))
+ (cdr (assq 'group tokens))))
+ ;; user
(elmo-net-folder-set-user-internal folder
- (if (eq (length (car parse)) 0)
- (unless explicit-user
- elmo-nntp-default-user)
- (car parse)))
- (unless (elmo-net-folder-server-internal folder)
- (elmo-net-folder-set-server-internal folder
- elmo-nntp-default-server))
- (unless (elmo-net-folder-port-internal folder)
- (elmo-net-folder-set-port-internal folder
- elmo-nntp-default-port))
- (unless (elmo-net-folder-stream-type-internal folder)
- (elmo-net-folder-set-stream-type-internal
- folder
- (elmo-get-network-stream-type
- elmo-nntp-default-stream-type)))
+ (let ((user (cdr (assq 'user tokens))))
+ (if user
+ (and (> (length user) 0) user)
+ elmo-nntp-default-user)))
+ ;; network
+ (elmo-net-folder-set-parameters
+ folder
+ tokens
+ (list :server elmo-nntp-default-server
+ :port elmo-nntp-default-port
+ :stream-type
+ (elmo-get-network-stream-type elmo-nntp-default-stream-type)))
folder))
(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder))
(elmo-display-progress
'elmo-nntp-list-folders "Parsing active..." 100))))
- (setq username (elmo-net-folder-user-internal folder))
- (when (and username
- elmo-nntp-default-user
- (string= username elmo-nntp-default-user))
- (setq username nil))
-
- (when (or username ; XXX: ad-hoc fix against username includes "@"
- (not (string= (elmo-net-folder-server-internal folder)
- elmo-nntp-default-server)))
- (setq append-serv (concat "@" (elmo-net-folder-server-internal
- folder))))
+ (setq username (or (elmo-net-folder-user-internal folder) ""))
+ (unless (string= username (or elmo-nntp-default-user ""))
+ (setq append-serv (concat append-serv
+ ":" (elmo-quote-syntactical-element
+ username
+ 'user elmo-nntp-folder-name-syntax))))
+ (unless (string= (elmo-net-folder-server-internal folder)
+ elmo-nntp-default-server)
+ (setq append-serv (concat append-serv
+ "@" (elmo-net-folder-server-internal folder))))
(unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
(setq append-serv (concat append-serv
":" (int-to-string
(concat append-serv
(elmo-network-stream-type-spec-string
(elmo-net-folder-stream-type-internal folder)))))
- (mapcar '(lambda (fld)
- (if (consp fld)
- (list (concat "-" (elmo-nntp-decode-group-string (car fld))
- (and username
- (concat
- ":"
- username))
- (and append-serv
- (concat append-serv))))
- (concat "-" (elmo-nntp-decode-group-string fld)
- (and username
- (concat ":" username))
- (and append-serv
- (concat append-serv)))))
+ (mapcar (lambda (fld)
+ (if (consp fld)
+ (list (concat "-" (elmo-nntp-decode-group-string (car fld))
+ append-serv))
+ (concat "-" (elmo-nntp-decode-group-string fld) append-serv)))
ret-val)))
(defun elmo-nntp-make-msglist (beg-str end-str)
(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)
from-msgs)))
result (sort result '<))))))
+(defun elmo-nntp-use-server-search-p (condition)
+ (if (vectorp condition)
+ (not (string= "body" (elmo-filter-key condition)))
+ (and (elmo-nntp-use-server-search-p (nth 1 condition))
+ (elmo-nntp-use-server-search-p (nth 2 condition)))))
+
(luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder)
condition &optional from-msgs)
(if (and (elmo-folder-plugged-p folder)
- (not (string= "body" (elmo-filter-key condition))))
+ (elmo-nntp-use-server-search-p condition))
(elmo-nntp-search-internal folder condition from-msgs)
(luna-call-next-method)))
name)
(when (string-match "^\\([^|]*\\)|\\(:?\\)\\(.*\\)$" name)
(elmo-pipe-folder-set-src-internal folder
- (elmo-make-folder
+ (elmo-get-folder
(elmo-match-string 1 name)))
(elmo-pipe-folder-set-dst-internal folder
- (elmo-make-folder
+ (elmo-get-folder
(elmo-match-string 3 name)))
(elmo-pipe-folder-set-copy-internal folder
(string= ":"
(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-folder-pack-numbers (elmo-pipe-folder-dst-internal folder)))
(luna-define-method elmo-folder-rename ((folder elmo-pipe-folder) new-name)
- (let* ((new-folder (elmo-make-folder new-name)))
+ (let* ((new-folder (elmo-get-folder new-name)))
(unless (string= (elmo-folder-name-internal
(elmo-pipe-folder-src-internal folder))
(elmo-folder-name-internal
(elmo-folder-type-internal
(elmo-pipe-folder-dst-internal new-folder)))
(error "Not same folder type"))
- (if (or (file-exists-p (elmo-folder-msgdb-path
- (elmo-pipe-folder-dst-internal new-folder)))
- (elmo-folder-exists-p
- (elmo-pipe-folder-dst-internal new-folder)))
- (error "Already exists folder: %s" new-name))
- (elmo-folder-send (elmo-pipe-folder-dst-internal folder)
- 'elmo-folder-rename-internal
- (elmo-pipe-folder-dst-internal new-folder))
+ (elmo-folder-rename (elmo-pipe-folder-dst-internal folder)
+ (elmo-folder-name-internal
+ (elmo-pipe-folder-dst-internal new-folder)))
(elmo-msgdb-rename-path folder new-folder)))
(luna-define-method elmo-folder-synchronize ((folder elmo-pipe-folder)
(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)
:type 'boolean
:group 'elmo)
+(defconst elmo-pop3-folder-name-syntax `(([user ".+"])
+ (?/ [auth ".+"])
+ (?: [uidl "^[A-Za-z]+$"])
+ ,@elmo-net-folder-name-syntax))
+
(defvar sasl-mechanism-alist)
(defvar elmo-pop3-total-size nil)
(use-uidl location-alist))
(luna-define-internal-accessors 'elmo-pop3-folder))
-(luna-define-method elmo-folder-initialize :around ((folder
- elmo-pop3-folder)
- name)
+(luna-define-method elmo-folder-initialize ((folder elmo-pop3-folder) name)
(let ((elmo-network-stream-type-alist
(if elmo-pop3-stream-type-alist
(append elmo-pop3-stream-type-alist
elmo-network-stream-type-alist)
elmo-network-stream-type-alist))
- parse)
- (setq name (luna-call-next-method))
+ tokens auth uidl)
+ (setq tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-pop3-folder-name-syntax)))
;; user
- (setq parse (elmo-parse-token name "/:"))
(elmo-net-folder-set-user-internal folder
- (if (eq (length (car parse)) 0)
- elmo-pop3-default-user
- (car parse)))
+ (or (cdr (assq 'user tokens))
+ elmo-pop3-default-user))
;; auth
- (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) ":"))
+ (setq auth (cdr (assq 'auth tokens)))
(elmo-net-folder-set-auth-internal folder
- (if (eq (length (car parse)) 0)
- elmo-pop3-default-authenticate-type
- (intern (downcase (car parse)))))
+ (if auth
+ (intern (downcase auth))
+ elmo-pop3-default-authenticate-type))
;; uidl
- (setq parse (elmo-parse-prefixed-element ?: (cdr parse)))
+ (setq uidl (cdr (assq 'uidl tokens)))
(elmo-pop3-folder-set-use-uidl-internal folder
- (if (eq (length (car parse)) 0)
- elmo-pop3-default-use-uidl
- (string= (car parse) "uidl")))
- (unless (elmo-net-folder-server-internal folder)
- (elmo-net-folder-set-server-internal folder
- elmo-pop3-default-server))
- (unless (elmo-net-folder-port-internal folder)
- (elmo-net-folder-set-port-internal folder
- elmo-pop3-default-port))
- (unless (elmo-net-folder-stream-type-internal folder)
- (elmo-net-folder-set-stream-type-internal
- folder
- (elmo-get-network-stream-type
- elmo-pop3-default-stream-type)))
+ (if uidl
+ (string= uidl "uidl")
+ elmo-pop3-default-use-uidl))
+ ;; network
+ (elmo-net-folder-set-parameters
+ folder
+ tokens
+ (list :server elmo-pop3-default-server
+ :port elmo-pop3-default-port
+ :stream-type
+ (elmo-get-network-stream-type elmo-pop3-default-stream-type)))
folder))
;;; POP3 session
--- /dev/null
+;;; elmo-search.el --- Search by external program interface for ELMO.
+
+;; Copyright (C) 2005 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+
+;;; Code:
+;;
+(eval-when-compile (require 'cl))
+
+(require 'elmo)
+(require 'elmo-map)
+(require 'mime-edit)
+
+(defcustom elmo-search-use-drive-letter
+ (memq system-type '(OS/2 emx windows-nt))
+ "*If non-nil, do a drive letter conversion (e.g. /a|/ => a:/)."
+ :type '(choice (const :tag "Not use" nil)
+ (other :tag "Use" t))
+ :group 'elmo)
+
+(defcustom elmo-search-engine-alist
+ '((namazu local-file
+ :prog "namazu"
+ :args ("--all" "--list" "--early" pattern elmo-search-namazu-index)
+ :charset 'iso-2022-jp)
+ (grep local-file
+ :prog "grep"
+ :args ("-l" "-e" pattern elmo-search-grep-target)))
+ "*An alist of search engines.
+Each element looks like (ENGINE CLASS PROPERTIES...)
+ENGINE is a symbol, the name of the search engine.
+CLASS is a symbol, the class name that performs a search.
+PROPERTIES is a plist, it configure an engine with the CLASS."
+ :group 'elmo)
+
+(defcustom elmo-search-default-engine 'namazu
+ "*Default search engine for elmo-search folder."
+ :type 'symbol
+ :group 'elmo)
+
+
+(defconst elmo-search-folder-name-syntax `(pattern (?\] param (?! engine))))
+
+
+;; Search engine I/F
+(eval-and-compile
+ (luna-define-class elmo-search-engine () (param))
+ (luna-define-internal-accessors 'elmo-search-engine))
+
+(luna-define-generic elmo-search-engine-do-search (engine pattern)
+ "Search messages which is match PATTERN by ENGINE.")
+
+(luna-define-generic elmo-search-engine-create-message-entity (engine
+ handler
+ folder number)
+ "Create msgdb entity for the message in the FOLDER with NUMBER.")
+
+(luna-define-generic elmo-search-engine-fetch-message (engine location)
+ "Fetch a message into current buffer.
+ENGINE is the ELMO search engine structure.
+LOCATION is the location of the message.
+Returns non-nil if fetching was succeed.")
+
+(defun elmo-make-search-engine (type &optional param)
+ (let ((spec (or (cdr (assq type elmo-search-engine-alist))
+ (error "Undefined search engine `%s'" type))))
+ (require (intern (format "else-%s" (car spec))))
+ (apply 'luna-make-entity
+ (intern (format "elmo-search-engine-%s" (car spec)))
+ :param param
+ (cdr spec))))
+
+
+;; ELMO search folder
+(eval-and-compile
+ (luna-define-class elmo-search-folder (elmo-map-folder)
+ (engine pattern))
+ (luna-define-internal-accessors 'elmo-search-folder))
+
+(luna-define-method elmo-folder-initialize ((folder elmo-search-folder)
+ name)
+ (when (> (length name) 0)
+ (let* ((tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-search-folder-name-syntax)))
+ (engine (cdr (assq 'engine tokens))))
+ (elmo-search-folder-set-engine-internal
+ folder
+ (elmo-make-search-engine (if (> (length engine) 0)
+ (intern engine)
+ elmo-search-default-engine)
+ (cdr (assq 'param tokens))))
+ (elmo-search-folder-set-pattern-internal
+ folder
+ (cdr (assq 'pattern tokens)))))
+ folder)
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-search-folder))
+ (expand-file-name
+ (elmo-replace-string-as-filename
+ (elmo-folder-name-internal folder))
+ (expand-file-name "search" elmo-msgdb-directory)))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-search-folder)
+ numbers flag-table)
+ (let ((new-msgdb (elmo-make-msgdb))
+ (num (length numbers))
+ entity)
+ (message "Creating msgdb...")
+ (elmo-with-progress-display (> num elmo-display-progress-threshold)
+ (elmo-folder-msgdb-create num "Creating msgdb...")
+ (dolist (number numbers)
+ (setq entity (elmo-search-engine-create-message-entity
+ (elmo-search-folder-engine-internal folder)
+ (elmo-msgdb-message-entity-handler new-msgdb)
+ folder number))
+ (when entity
+ (elmo-msgdb-append-entity new-msgdb entity '(new unread)))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)
+ (setq numbers (cdr numbers))))
+ (message "Creating msgdb...done")
+ new-msgdb))
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-search-folder))
+ nil)
+
+(defun elmo-search-location-to-filename (location)
+ (when (string-match "^file://" location)
+ (let ((filename (substring location (match-end 0))))
+ (expand-file-name
+ (if (and elmo-search-use-drive-letter
+ (string-match "^/\\([A-Za-z]\\)[:|]/\\(.*\\)$" filename))
+ (replace-match "\\1:/\\2" t nil filename)
+ filename)))))
+
+(luna-define-method elmo-message-file-name ((folder elmo-search-folder)
+ number)
+ (elmo-search-location-to-filename
+ (elmo-map-message-location folder number)))
+
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-search-folder))
+ nil)
+
+(luna-define-method elmo-folder-diff ((folder elmo-search-folder))
+ (cons nil nil))
+
+(luna-define-method elmo-folder-message-make-temp-files ((folder
+ elmo-search-folder)
+ numbers
+ &optional
+ start-number)
+ (let ((temp-dir (elmo-folder-make-temporary-directory folder))
+ (cur-number (if start-number 0)))
+ (dolist (number numbers)
+ (elmo-copy-file
+ (elmo-message-file-name folder number)
+ (expand-file-name
+ (int-to-string (if start-number (incf cur-number) number))
+ temp-dir)))
+ temp-dir))
+
+(luna-define-method elmo-map-message-fetch ((folder elmo-search-folder)
+ location strategy
+ &optional section unseen)
+ (elmo-search-engine-fetch-message
+ (elmo-search-folder-engine-internal folder)
+ location))
+
+(luna-define-method elmo-map-folder-list-message-locations
+ ((folder elmo-search-folder))
+ (elmo-search-engine-do-search
+ (elmo-search-folder-engine-internal folder)
+ (elmo-search-folder-pattern-internal folder)))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-search-folder))
+ (elmo-search-folder-pattern-internal folder))
+
+(luna-define-method elmo-folder-have-subfolder-p ((folder elmo-search-folder))
+ (null (elmo-search-folder-pattern-internal folder)))
+
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-search-folder)
+ &optional one-level)
+ (mapcar
+ (lambda (name) (elmo-recover-string-from-filename name))
+ (directory-files (expand-file-name "search" elmo-msgdb-directory)
+ nil
+ (concat "^" (regexp-quote
+ (elmo-folder-prefix-internal folder))))))
+
+
+;;; Search engine
+
+;; search engine for local files
+(eval-and-compile
+ (luna-define-class elmo-search-engine-local-file (elmo-search-engine)
+ (prog args charset parser))
+ (luna-define-internal-accessors 'elmo-search-engine-local-file))
+
+(luna-define-method elmo-search-engine-do-search
+ ((engine elmo-search-engine-local-file) pattern)
+ (with-temp-buffer
+ (let* ((charset (elmo-search-engine-local-file-charset-internal engine))
+ (pattern (if charset
+ (encode-mime-charset-string pattern charset)
+ pattern))
+ (parser (or (elmo-search-engine-local-file-parser-internal engine)
+ #'elmo-search-parse-filename-list)))
+ (apply 'call-process
+ (elmo-search-engine-local-file-prog-internal engine)
+ nil t t
+ (elmo-flatten
+ (mapcar
+ (lambda (arg)
+ (cond ((stringp arg) arg)
+ ((functionp arg)
+ (funcall arg engine))
+ ((and (symbolp arg)
+ (boundp arg))
+ (symbol-value arg))))
+ (elmo-search-engine-local-file-args-internal engine))))
+ (funcall parser))))
+
+(defun elmo-search-parse-filename-list ()
+ (let (bol locations)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (beginning-of-line)
+ (when (and elmo-search-use-drive-letter
+ (looking-at "^\\([A-Za-z]\\)[:|]/"))
+ (replace-match "/\\1:/")
+ (beginning-of-line))
+ (unless (looking-at "^file://")
+ (insert "file://")
+ (beginning-of-line))
+ (setq bol (point))
+ (end-of-line)
+ (setq locations (cons (buffer-substring bol (point)) locations))
+ (forward-line 1))
+ (nreverse locations)))
+
+(luna-define-method elmo-search-engine-create-message-entity
+ ((engine elmo-search-engine-local-file) handler folder number)
+ (let ((filename (elmo-message-file-name folder number))
+ entity uid)
+ (setq entity (elmo-msgdb-create-message-entity-from-file
+ handler number filename))
+ (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
+ (file-name-nondirectory filename))
+ (setq uid (nth 2 (file-attributes filename)))
+ (elmo-message-entity-set-field entity 'from
+ (concat
+ (user-full-name uid)
+ " <"(user-login-name uid) "@"
+ (system-name) ">")))
+ entity))
+
+(luna-define-method elmo-search-engine-fetch-message
+ ((engine elmo-search-engine-local-file) location)
+ (let ((filename (elmo-search-location-to-filename location)))
+ (when (file-exists-p filename)
+ (prog1
+ (insert-file-contents-as-binary filename)
+ (unless (or (std11-field-body "To")
+ (std11-field-body "Cc")
+ (std11-field-body "Subject"))
+ (let (charset guess uid)
+ (erase-buffer)
+ (set-buffer-multibyte t)
+ (insert-file-contents filename)
+ (setq charset (detect-mime-charset-region (point-min)
+ (point-max)))
+ (goto-char (point-min))
+ (setq guess (mime-find-file-type filename))
+ (setq uid (nth 2 (file-attributes filename)))
+ (insert "From: " (concat (user-full-name uid)
+ " <"(user-login-name uid) "@"
+ (system-name) ">") "\n")
+ (insert "Subject: " filename "\n")
+ (insert "Content-Type: "
+ (concat (nth 0 guess) "/" (nth 1 guess))
+ "; charset=" (upcase (symbol-name charset))
+ "\nMIME-Version: 1.0\n\n")
+ (encode-mime-charset-region (point-min) (point-max) charset)
+ (set-buffer-multibyte nil)))))))
+
+(provide 'else-local-file)
+
+;; namazu
+(defcustom elmo-search-namazu-default-index-path "~/Mail"
+ "*Default index path for namazu.
+If the value is a list, all elements are used as index paths for namazu."
+ :type '(choice (directory :tag "Index Path")
+ (repeat (directory :tag "Index Path")))
+ :group 'elmo)
+
+(defcustom elmo-search-namazu-index-alias-alist nil
+ "*Alist of ALIAS and INDEX-PATH."
+ :type '(repeat (cons (string :tag "Alias Name")
+ (choice (directory :tag "Index Path")
+ (repeat (directory :tag "Index Path")))))
+ :group 'elmo)
+
+(defun elmo-search-namazu-index (engine)
+ (let* ((param (elmo-search-engine-param-internal engine))
+ (index (cond ((cdr (assoc param
+ elmo-search-namazu-index-alias-alist)))
+ ((eq (length param) 0)
+ elmo-search-namazu-default-index-path)
+ (t
+ param))))
+ (if (listp index)
+ (mapcar 'expand-file-name index)
+ (expand-file-name index))))
+
+;; grep
+(defun elmo-search-grep-target (engine)
+ (let ((dirname (expand-file-name (elmo-search-engine-param-internal engine)))
+ (files (list null-device)))
+ (dolist (filename (directory-files dirname))
+ (unless (string-match "^\\.\\.?" filename)
+ (setq files (cons (expand-file-name filename dirname) files))))
+ files))
+
+
+(require 'product)
+(product-provide (provide 'elmo-search) (require 'elmo-version))
+
+;;; elmo-search.el ends here
(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))
(setq folders
(append folders
(mapcar
- (lambda (fld) (concat prefix server "." fld))
+ (lambda (group) (concat prefix server "." group))
(shimbun-groups
- (shimbun-open server
- (let ((fld
- (elmo-make-folder
- (concat prefix server))))
- (luna-make-entity
- 'shimbun-elmo-mua
- :folder fld))))))))
+ (elmo-shimbun-folder-shimbun-internal
+ (elmo-get-folder (concat prefix server))))))))
folders)))))
(luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
(lambda (field-name)
(or (elmo-message-entity-field entity
(intern (downcase field-name))
- 'decode)
+ 'string)
(progn
(unless buffer
(setq buffer (get-buffer-create
(fcount 0)
ret)
(dolist (folder folders)
- (setq ret (elmo-split-subr (elmo-make-folder folder) arg)
+ (setq ret (elmo-split-subr (elmo-get-folder folder) arg)
count (+ count (car ret))
fcount (+ fcount (cdr ret))))
(run-hooks 'elmo-split-hook)
((stringp action)
(condition-case nil
(progn
- (setq target-folder (elmo-make-folder action))
+ (setq target-folder (elmo-get-folder action))
(unless (elmo-folder-exists-p target-folder)
(when
(and
(put 'elmo-with-enable-multibyte 'lisp-indent-function 0)
(def-edebug-spec elmo-with-enable-multibyte t)
+(eval-when-compile
+ (unless (fboundp 'coding-system-base)
+ (defalias 'coding-system-base 'ignore))
+ (unless (fboundp 'coding-system-name)
+ (defalias 'coding-system-name 'ignore))
+ (unless (fboundp 'find-file-coding-system-for-read-from-filename)
+ (defalias 'find-file-coding-system-for-read-from-filename 'ignore))
+ (unless (fboundp 'find-operation-coding-system)
+ (defalias 'find-operation-coding-system 'ignore)))
+
+(defun elmo-set-auto-coding (&optional filename)
+ "Find coding system used to decode the contents of the current buffer.
+This function looks for the coding system magic cookie or examines the
+coding system specified by `file-coding-system-alist' being associated
+with FILENAME which defaults to `buffer-file-name'."
+ (cond
+ ((boundp 'set-auto-coding-function) ;; Emacs
+ (if filename
+ (or (funcall (symbol-value 'set-auto-coding-function)
+ filename (- (point-max) (point-min)))
+ (car (find-operation-coding-system 'insert-file-contents
+ filename)))
+ (let (auto-coding-alist)
+ (condition-case nil
+ (funcall (symbol-value 'set-auto-coding-function)
+ nil (- (point-max) (point-min)))
+ (error nil)))))
+ ((featurep 'file-coding) ;; XEmacs
+ (let ((case-fold-search t)
+ (end (point-at-eol))
+ codesys start)
+ (or
+ (and (re-search-forward "-\\*-+[\t ]*" end t)
+ (progn
+ (setq start (match-end 0))
+ (re-search-forward "[\t ]*-+\\*-" end t))
+ (progn
+ (setq end (match-beginning 0))
+ (goto-char start)
+ (or (looking-at "coding:[\t ]*\\([^\t ;]+\\)")
+ (re-search-forward
+ "[\t ;]+coding:[\t ]*\\([^\t ;]+\\)"
+ end t)))
+ (find-coding-system (setq codesys
+ (intern (match-string 1))))
+ codesys)
+ (and (re-search-forward "^[\t ]*;+[\t ]*Local[\t ]+Variables:"
+ nil t)
+ (progn
+ (setq start (match-end 0))
+ (re-search-forward "^[\t ]*;+[\t ]*End:" nil t))
+ (progn
+ (setq end (match-beginning 0))
+ (goto-char start)
+ (re-search-forward
+ "^[\t ]*;+[\t ]*coding:[\t ]*\\([^\t\n\r ]+\\)"
+ end t))
+ (find-coding-system (setq codesys
+ (intern (match-string 1))))
+ codesys)
+ (and (progn
+ (goto-char (point-min))
+ (setq case-fold-search nil)
+ (re-search-forward "^;;;coding system: "
+ ;;(+ (point-min) 3000) t))
+ nil t))
+ (looking-at "[^\t\n\r ]+")
+ (find-coding-system
+ (setq codesys (intern (match-string 0))))
+ codesys)
+ (and filename
+ (setq codesys
+ (find-file-coding-system-for-read-from-filename
+ filename))
+ (coding-system-name (coding-system-base codesys))))))))
+
(defun elmo-object-load (filename &optional mime-charset no-err)
"Load OBJECT from the file specified by FILENAME.
File content is decoded with MIME-CHARSET."
(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 (elmo-set-auto-coding)
+ (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))
(setq dest (cons (cons name body) dest))))
dest)))
-(defun elmo-safe-filename (folder)
- (elmo-replace-in-string
- (elmo-replace-in-string
- (elmo-replace-in-string folder "/" " ")
- ":" "__")
- "|" "_or_"))
+(defun elmo-safe-filename (filename)
+ (let* ((replace-alist '(("/" . " ")
+ (":" . "__")
+ ("|" . "_or_")
+ ("\"" . "_Q_")))
+ (regexp (concat "["
+ (regexp-quote (mapconcat 'car replace-alist ""))
+ "]"))
+ (rest filename)
+ converted)
+ (while (string-match regexp rest)
+ (setq converted (concat converted
+ (substring rest 0 (match-beginning 0))
+ (cdr (assoc (substring rest
+ (match-beginning 0)
+ (match-end 0))
+ replace-alist)))
+ rest (substring rest (match-end 0))))
+ (concat converted rest)))
(defvar elmo-filename-replace-chars nil)
newtext)))
;;; Folder parser utils.
-(defun elmo-parse-token (string &optional seps)
+(defconst elmo-quoted-specials-list '(?\\ ?\"))
+
+(defun elmo-quoted-token (string)
+ (concat "\""
+ (std11-wrap-as-quoted-pairs string elmo-quoted-specials-list)
+ "\""))
+
+(defun elmo-token-valid-p (token requirement)
+ (cond ((null requirement))
+ ((stringp requirement)
+ (string-match requirement token))
+ ((functionp requirement)
+ (funcall requirement token))))
+
+(defun elmo-parse-token (string &optional seps requirement)
"Parse atom from STRING using SEPS as a string of separator char list."
(let ((len (length string))
(seps (and seps (string-to-char-list seps)))
(t (setq content (cons c content)
i (1+ i)))))
(if in (error "Parse error in quoted"))
- (cons (if (null content) "" (char-list-to-string (nreverse content)))
- (substring string i)))))
-
-(defun elmo-parse-prefixed-element (prefix string &optional seps)
- (if (and (not (eq (length string) 0))
- (eq (aref string 0) prefix))
- (elmo-parse-token (substring string 1) seps)
- (cons "" string)))
+ (let ((atom (if (null content)
+ ""
+ (char-list-to-string (nreverse content)))))
+ (if (elmo-token-valid-p atom requirement)
+ (cons atom (substring string i))
+ (cons "" string))))))
+
+(defun elmo-parse-prefixed-element (prefix string &optional seps requirement)
+ (let (parsed)
+ (if (and (not (eq (length string) 0))
+ (eq (aref string 0) prefix)
+ (setq parsed (elmo-parse-token (substring string 1) seps))
+ (elmo-token-valid-p (car parsed) requirement))
+ parsed
+ (cons "" string))))
+
+(defun elmo-collect-separators (spec)
+ (when (listp spec)
+ (let ((result (elmo-collect-separators-internal spec)))
+ (and result
+ (char-list-to-string (elmo-uniq-list result #'delq))))))
+
+(defun elmo-collect-separators-internal (specs)
+ (let (separators)
+ (while specs
+ (let ((spec (car specs)))
+ (cond
+ ((listp spec)
+ (setq separators (nconc (elmo-collect-separators-internal spec)
+ separators)
+ specs (cdr specs)))
+ ((characterp spec)
+ (setq separators (cons spec separators)
+ specs nil))
+ (t
+ (setq specs nil)))))
+ separators))
+
+(defun elmo-collect-trail-separators (element specs)
+ (cond
+ ((symbolp specs)
+ (eq specs element))
+ ((vectorp specs)
+ (eq (aref specs 0) element))
+ ((listp specs)
+ (let (spec result)
+ (while (setq spec (car specs))
+ (if (setq result (elmo-collect-trail-separators element spec))
+ (setq result (concat (if (stringp result) result)
+ (elmo-collect-separators (cdr specs)))
+ specs nil)
+ (setq specs (cdr specs))))
+ result))))
+
+(defun elmo-parse-separated-tokens (string spec)
+ (let ((result (elmo-parse-separated-tokens-internal string spec)))
+ (if (eq (car result) t)
+ (cons nil (cdr result))
+ result)))
+
+(defun elmo-parse-separated-tokens-internal (string spec &optional separators)
+ (cond
+ ((symbolp spec)
+ (let ((parse (elmo-parse-token string separators)))
+ (cons (list (cons spec (car parse))) (cdr parse))))
+ ((vectorp spec)
+ (let ((parse (elmo-parse-token string separators)))
+ (if (elmo-token-valid-p (car parse) (aref spec 1))
+ (cons (list (cons (aref spec 0) (car parse))) (cdr parse))
+ (cons nil string))))
+ ((characterp spec)
+ (if (and (> (length string) 0)
+ (eq (aref string 0) spec))
+ (cons t (substring string 1))
+ (cons nil string)))
+ ((listp spec)
+ (catch 'unmatch
+ (let ((rest string)
+ result tokens)
+ (while spec
+ (setq result (elmo-parse-separated-tokens-internal
+ rest
+ (car spec)
+ (concat (elmo-collect-separators (cdr spec))
+ separators)))
+ (cond ((null (car result))
+ (throw 'unmatch (cons t string)))
+ ((eq t (car result)))
+ (t
+ (setq tokens (nconc (car result) tokens))))
+ (setq rest (cdr result)
+ spec (cdr spec)))
+ (cons (or tokens t) rest))))))
+
+(defun elmo-quote-syntactical-element (value element syntax)
+ (let ((separators (elmo-collect-trail-separators element syntax)))
+ (if (and separators
+ (string-match (concat "[" separators "]") value))
+ (elmo-quoted-token value)
+ value)))
;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
;;
(t (funcall func x))))
list-of-list))
+(defun elmo-map-recursive (function object)
+ (if (consp object)
+ (let* ((prev (list 'dummy))
+ (result prev))
+ (while (consp object)
+ (setq prev (setcdr prev (list (elmo-map-recursive function
+ (car object))))
+ object (cdr object)))
+ (when object
+ (setcdr prev (funcall function object)))
+ (cdr result))
+ (funcall function object)))
+
(defun elmo-parse (string regexp &optional matchn)
(or matchn (setq matchn 1))
(let (list)
(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 2)))
;; 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))))
+(defvar elmo-get-folder-function nil)
+
+(defun elmo-get-folder (name)
+ (or (and elmo-get-folder-function
+ (funcall elmo-get-folder-function name))
+ (elmo-make-folder name)))
+
;; Note that this function is for internal use only.
(luna-define-generic elmo-folder-msgdb (folder)
"Return the msgdb of FOLDER (on-demand loading).
t))
(luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
- (let* ((new-folder (elmo-make-folder new-name)))
+ (let* ((new-folder (elmo-make-folder
+ new-name
+ nil
+ (elmo-folder-mime-charset-internal folder))))
(unless (eq (elmo-folder-type-internal folder)
(elmo-folder-type-internal new-folder))
(error "Not same folder type"))
- (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
- (elmo-folder-exists-p new-folder))
- (error "Already exists folder: %s" new-name))
+ (when (or (file-exists-p (elmo-folder-msgdb-path new-folder))
+ (elmo-folder-exists-p new-folder))
+ (error "Already exists folder: %s" new-name))
(elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
(elmo-msgdb-rename-path folder new-folder)))
(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)
+ (elmo-map-recursive
+ (lambda (element)
+ (if (stringp element)
+ (elmo-msgdb-get-decoded-cache element)
+ element))
+ value))
+
+(defun modb-entity-encode-string-recursive (field value)
+ (elmo-map-recursive
+ (lambda (element)
+ (if (stringp element)
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string element elmo-mime-charset))
+ element))
+ 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))))
+ ((or (string= key "larger")
+ (string= key "smaller"))
+ (let ((bytes (elmo-msgdb-message-entity-field handler entity 'size))
+ (threshold (string-to-int (elmo-filter-value condition))))
+ (if (string= key "larger")
+ (> bytes threshold)
+ (< bytes threshold))))
+ ((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))
(modb-standard-key number)
(modb-standard-entity-map-internal msgdb))))
(cond
- ((and ret (eq (car-safe ret) 'autoload))
- (cdr (cdr ret))) ; message-id.
- ((and ret (stringp (car-safe ret)))
- ;; Already loaded.
- (car ret))
((null ret)
;; Garbage entity.
(elmo-clear-hash-val (modb-standard-key number)
(modb-standard-entity-map-internal msgdb))
nil) ; return nil.
+ ((eq (car-safe ret) 'autoload)
+ (cdr (cdr ret))) ; message-id.
+ ((elmo-msgdb-message-entity-field (elmo-message-entity-handler ret)
+ ret 'message-id)) ; Already loaded.
(t (error "Internal error: invalid msgdb status")))))
(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-09-02 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * ptexinfmt.el: Support @frenchspacing, @euro, @sansserif.
+ (texinfo-format-ordf): Fix typo.
+
+2005-08-08 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-addrbook.el (wl-addrbook-setup): Set
+ `wl-summary-get-petname-function' instead of
+ `wl-summary-from-function'.
+
+2005-08-05 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-addrbook.el (wl-addrbook-get-names): Abolish.
+ (wl-summary-addrbook-from): Ditto.
+ (wl-addrbook-get-nickname): New function.
+
2005-02-24 Katsumi Yamaoka <yamaoka@jpl.org>
* ptexinfmt.el (texinfo-multitable-widths): Reverse the logic that
;; @definfoenclose
;; @deftypeivar
;; @deftypeop
+;; @allowcodebreaks
;;; Code:
(put 'setcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
(put 'setshortcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
(put 'novalidate 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'frenchspacing 'texinfo-format 'texinfo-discard-line-with-args)
;; head & foot
(put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
;; @slanted{} (makeinfo 4.8 or later)
(put 'slanted 'texinfo-format 'texinfo-format-noop)
+;; @sansserif{} (makeinfo 4.8 or later)
+(put 'sansserif 'texinfo-format 'texinfo-format-noop)
+
;; @tie{} (makeinfo 4.3 or later)
(put 'tie 'texinfo-format 'texinfo-format-tie)
(ptexinfmt-defun-if-void texinfo-format-tie ()
(insert "(R)"))
;;; Accents and Special characters
+;; @euro{} ==> Euro
+(put 'euro 'texinfo-format 'texinfo-format-euro)
+(ptexinfmt-defun-if-void texinfo-format-euro ()
+ (texinfo-parse-arg-discard)
+ (insert "Euro "))
+
;; @pounds{} ==> # Pounds Sterling
(put 'pounds 'texinfo-format 'texinfo-format-pounds)
(ptexinfmt-defun-if-void texinfo-format-pounds ()
(put 'ordf 'texinfo-format 'texinfo-format-ordf)
(ptexinfmt-defun-if-void texinfo-format-ordf ()
(texinfo-parse-arg-discard)
- (insert "o"))
+ (insert "a"))
;; @ordm{} ==> o Spanish masculine
(put 'ordm 'texinfo-format 'texinfo-format-ordm)
(setq wl-address-init-function 'wl-addrbook-init)
;;
(when wl-summary-use-addrbook-from-func
- (setq wl-summary-from-function 'wl-summary-addrbook-from))
+ (setq wl-summary-get-petname-function 'wl-addrbook-get-nickname))
(define-key wl-summary-mode-map "\C-c\C-a" 'wl-summary-addrbook-add)
(define-key wl-draft-mode-map "\C-i" 'wl-draft-addrbook-header-comp-or-tab)
(define-key wl-draft-mode-map "\e\t" 'wl-draft-addrbook-expand)
;;; Show nick name of Addrbook in summary.
;;;
-(defsubst wl-addrbook-get-names (names)
- (let (addrs)
- (mapconcat
- (function
- (lambda (name)
- (or (wl-addrbook-nickname-get
- (wl-address-header-extract-address name))
- (and (setq addrs (std11-extract-address-components name))
- (or (car addrs) (cadr addrs))))))
- (wl-parse-addresses names)
- ",")))
-
-(eval-when-compile (defvar-maybe entity nil)) ; silence byte compiler.
-(defun wl-summary-addrbook-from (from)
- "A candidate for wl-summary-from-function.
-Show destination in summary matched by `wl-summary-show-dest-folder-regexp'.
-And use Addrbook for get user name."
- (let ((fromaddr (wl-address-header-extract-address from))
- dest)
- (or
- (and (eq major-mode 'wl-summary-mode)
- (string-match wl-summary-showto-folder-regexp
- wl-summary-buffer-folder-name)
- (wl-address-user-mail-address-p fromaddr)
- (cond ((setq dest (elmo-message-entity-field entity 'to))
- (concat "To:" (eword-decode-string (wl-addrbook-get-names dest))))
- ((setq dest (elmo-message-entity-field entity 'newsgroups))
- (concat "Ng:" dest))))
- (wl-addrbook-nickname-get fromaddr)
- from)))
+(defun wl-addrbook-get-nickname (mailbox)
+ "For `wl-summary-get-petname-function'."
+ (wl-addrbook-nickname-get
+ (wl-address-header-extract-address mailbox)))
(provide 'wl-addrbook)
+2005-09-17 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * Version number is increased to 2.15.2.
+
+2005-09-02 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * wl-util.el (wl-read-search-condition-internal): Add "Larger" and
+ "Smaller".
+ * wl-folder.el (wl-folder-complete-filter-condition): Ditto.
+
+2005-08-04 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * wl-vars.el (wl-summary-showto-folder-regexp): Update docstring.
+
+2005-07-17 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-vars.el (wl-draft-additional-header-alist): Add into the
+ customize group `wl-draft'.
+ (wl-draft-add-in-reply-to): Move customize group from `wl' to
+ `wl-draft'.
+ (wl-draft-add-references): Ditto.
+
+ * wl-action.el (wl-summary-print-argument): Rename argument from
+ `folder' to `data'.
+
+2005-06-24 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-rescan-message): Call
+ `wl-thread-cleanup-symbols' before insert thread.
+
+2005-06-12 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl.el (wl-init): Set `elmo-get-folder-function' as
+ `wl-folder-make-elmo-folder'.
+
+ * wl-spam.el (wl-summary-exec-action-spam): Use
+ `wl-folder-make-elmo-folder' instead of `elmo-make-folder'.
+
+ * wl-folder.el (wl-folder-make-elmo-folder): New function.
+ (wl-draft-get-folder): Use `wl-folder-make-elmo-folder' instead of
+ `elmo-make-folder'.
+ (wl-folder-get-elmo-folder): Ditto.
+ (wl-folder-create-subr): Simplify.
+
+2005-06-05 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-mime.el (wl-message-verify-pgp-nonmime): Fix the last change.
+
+2005-06-04 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-mime.el (wl-message-verify-pgp-nonmime): Verify encoded
+ contents in message buffer instead of original buffer. If optional
+ argument specified, ask coding system for encode.
+
+2005-06-02 Tetsurou Okazaki <okazaki@be.to>
+
+ * wl-spam.el (wl-summary-test-spam-region): New function.
+ (wl-spam-setup): Bind "rkc".
+
+2005-05-10 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * wl-fldmgr.el (wl-fldmgr-add): Undo the last change.
+
+2005-04-22 Tetsurou Okazaki <okazaki@be.to>
+
+ * wl-spam.el (wl-summary-test-spam): Fix typo.
+ (wl-message-check-spam): Ditto.
+
+2005-04-16 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-default-from): Simplify.
+
+2005-04-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-action.el (wl-summary-exec-action-refile): Simplify.
+ (wl-summary-exec-action-copy): Ditto.
+ (wl-summary-auto-refile): Check existence of temporary mark.
+
+2005-04-09 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-create-line): Use
+ `elmo-time-to-datevec'.
+
+ * wl-expire.el (wl-expire-archive-date): Ditto.
+ (wl-expire-localdir-date): Ditto.
+
+ * wl-util.el (wl-day-number): Abolish.
+
+ * wl-score.el (wl-score-headers): Use `elmo-time-to-days' instead
+ of `wl-day-number'.
+ (wl-score-followup): Ditto.
+ (wl-score-add-followups): Ditto.
+ (wl-score-get-latest-msgs): Ditto.
+ (wl-score-get-header-entry): Ditto.
+ (wl-score-edit-insert-date): Ditto.
+
+2005-04-08 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-print-message-with-ps-print): Call
+ `elmo-message-entity-field' with 2nd argument `type'.
+
+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'.
(let ((start (point))
(failures 0)
(refile-len (length mark-list))
- dst-msgs ; loop counter
- result)
+ dst-msgs)
;; begin refile...
- (setq dst-msgs
- (wl-summary-make-destination-numbers-list mark-list))
+ (setq dst-msgs (wl-summary-make-destination-numbers-list mark-list))
(goto-char start) ; avoid moving cursor to the bottom line.
(when (> refile-len elmo-display-progress-threshold)
(elmo-progress-set 'elmo-folder-move-messages
refile-len "Refiling messages..."))
- (while dst-msgs
- (setq result nil)
- (condition-case nil
- (setq result (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- (cdr (car dst-msgs))
- (wl-folder-get-elmo-folder (car (car dst-msgs)))))
- (error nil))
- (if result ; succeeded.
+ (dolist (pair dst-msgs)
+ (if (condition-case nil
+ (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ (cdr pair)
+ (wl-folder-get-elmo-folder (car pair)))
+ (error nil))
(progn
;; update buffer.
- (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
+ (wl-summary-delete-messages-on-buffer (cdr pair))
(setq wl-summary-buffer-temp-mark-list
(wl-delete-associations
- (cdr (car dst-msgs))
+ (cdr pair)
wl-summary-buffer-temp-mark-list)))
- (setq failures
- (+ failures (length (cdr (car dst-msgs))))))
- (setq dst-msgs (cdr dst-msgs)))
+ (setq failures (+ failures (length (cdr pair))))))
(elmo-progress-clear 'elmo-folder-move-messages)
(if (<= failures 0)
(message "Refiling messages...done"))
(let ((start (point))
(failures 0)
(refile-len (length mark-list))
- dst-msgs ; loop counter
- result)
+ dst-msgs)
;; begin refile...
(setq dst-msgs
(wl-summary-make-destination-numbers-list mark-list))
(when (> refile-len elmo-display-progress-threshold)
(elmo-progress-set 'elmo-folder-move-messages
refile-len "Copying messages..."))
- (while dst-msgs
- (setq result nil)
- (condition-case nil
- (setq result (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- (cdr (car dst-msgs))
- (wl-folder-get-elmo-folder (car (car dst-msgs)))
- 'no-delete))
- (error nil))
- (if result ; succeeded.
+ (dolist (pair dst-msgs)
+ (if (condition-case nil
+ (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ (cdr pair)
+ (wl-folder-get-elmo-folder (car pair))
+ 'no-delete)
+ (error nil))
(progn
;; update buffer.
- (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
+ (wl-summary-delete-copy-marks-on-buffer (cdr pair))
(setq wl-summary-buffer-temp-mark-list
(wl-delete-associations
- (cdr (car dst-msgs))
+ (cdr pair)
wl-summary-buffer-temp-mark-list)))
- (setq failures
- (+ failures (length (cdr (car dst-msgs))))))
- (setq dst-msgs (cdr dst-msgs)))
+ (setq failures (+ failures (length (cdr pair))))))
(elmo-progress-clear 'elmo-folder-move-messages)
(if (<= failures 0)
(message "Copying messages...done"))
;; 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)
fld))))
fld))
-(defun wl-summary-print-argument (msg-num folder)
+(defun wl-summary-print-argument (msg-num data)
"Print action argument on line."
- (when folder
+ (when data
(wl-summary-remove-argument)
(save-excursion
(let ((inhibit-read-only t)
- (folder (copy-sequence folder))
+ (data (copy-sequence data))
(buffer-read-only nil)
len rs re c)
- (setq len (string-width folder))
+ (setq len (string-width data))
(if (< len 1) ()
;;(end-of-line)
(beginning-of-line)
(1- (window-width)))))
(c (current-column))
(padding 0))
- (if (and width (> (+ c len) width))
+ (if (and width
+ (> (+ c len) width))
(progn
(move-to-column width)
(setq c (current-column))
(forward-char -1)
(setq c (current-column)))
(when (< (+ c len) width)
- (setq folder (concat " " folder)))
+ (setq data (concat " " data)))
(setq rs (point))
(put-text-property rs re 'invisible t))
(when (and width
(> (setq padding (- width len c)) 0))
- (setq folder (concat (make-string padding ?\ )
- folder)))
+ (setq data (concat (make-string padding ?\ ) data)))
(setq rs (1- re))))
(put-text-property rs re 'wl-summary-action-argument t)
(goto-char re)
- (wl-highlight-action-argument-string folder)
- (insert folder)
+ (wl-highlight-action-argument-string data)
+ (insert data)
(set-buffer-modified-p nil))))))
(defsubst wl-summary-reserve-temp-mark-p (mark)
(wl-thread-get-entity number))))
(wl-thread-entity-get-descendant
thr-entity))))
- (when (and (not (wl-summary-no-auto-refile-message-p
- number))
+ (when (and (not (wl-summary-no-auto-refile-message-p number))
+ (not (wl-summary-reserve-temp-mark-p
+ (nth 1 (wl-summary-registered-temp-mark number))))
(setq dst
(wl-folder-get-realname
(wl-refile-guess
(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 time
- (condition-case nil
- (timezone-fix-time date nil nil)
- (error [0 0 0 0 0 0 0])))
+ (setq time (or (elmo-time-to-datevec
+ (elmo-message-field folder msg 'date))
+ (make-vector 7 0)))
(if (= (aref time 1) 0) ;; if (month == 0)
(aset time 0 0)) ;; year = 0
(setq dst-folder (format dst-folder-fmt
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 time
- (condition-case nil
- (timezone-fix-time date nil nil)
- (error [0 0 0 0 0 0 0])))
+ (setq time (or (elmo-time-to-datevec
+ (elmo-message-field folder msg 'date))
+ (make-vector 7 0)))
(if (= (aref time 1) 0) ;; if (month == 0)
(aset time 0 0)) ;; year = 0
(setq dst-folder (format dst-folder-fmt
(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
(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 (wl-folder-make-elmo-folder
+ 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))
+
+(defun wl-folder-make-elmo-folder (folder-name)
+ (elmo-make-folder folder-name nil (wl-folder-mime-charset folder-name)))
+
+(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
+ (wl-folder-make-elmo-folder name)
+ (if (string= name wl-draft-folder)
+ (wl-draft-get-folder)
+ (or (wl-folder-elmo-folder-cache-get name)
+ (let ((folder (wl-folder-make-elmo-folder 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)))))
(kill-buffer bufname))))
(defun wl-folder-create-subr (folder)
- (if (elmo-folder-creatable-p folder)
- (if (y-or-n-p (format "Folder %s does not exist, create it? "
- (elmo-folder-name-internal folder)))
- (progn
- (message "")
- (setq wl-folder-entity-hashtb
- (wl-folder-create-entity-hashtb
- (elmo-folder-name-internal folder)
- wl-folder-entity-hashtb))
- (unless (elmo-folder-create folder)
- (error "Create folder failed")))
- (error "Folder %s is not created" (elmo-folder-name-internal folder)))
- (error "Folder %s does not exist" (elmo-folder-name-internal folder))))
+ (let ((name (elmo-folder-name-internal folder)))
+ (unless (elmo-folder-creatable-p folder)
+ (error "Folder %s does not exist" name))
+ (unless (y-or-n-p (format "Folder %s does not exist, create it? " name))
+ (error "Folder %s is not created" name))
+ (message "")
+ (setq wl-folder-entity-hashtb
+ (wl-folder-create-entity-hashtb name wl-folder-entity-hashtb))
+ (unless (elmo-folder-create folder)
+ (error "Create folder failed"))))
(defun wl-folder-confirm-existence (folder &optional force)
(if force
(mapcar (lambda (x) (list (concat (downcase x) ":")))
(append '("last" "first"
"from" "subject" "to" "cc" "body"
- "since" "before" "tocc")
+ "since" "before" "tocc"
+ "larger" "smaller")
elmo-msgdb-extra-fields))))
(if (not flag)
(try-completion string candidate)
(message "Cannot find pgp encrypted region")))
(message "Cannot find pgp encrypted region"))))
-(defun wl-message-verify-pgp-nonmime ()
- "Verify PGP signed region"
- (interactive)
+(defun wl-message-verify-pgp-nonmime (&optional arg)
+ "Verify PGP signed region.
+With ARG, ask coding system and encode the region with it before verifying."
+ (interactive "P")
(require 'pgg)
(save-excursion
(beginning-of-line)
- (if (and (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t)
- (re-search-backward "^-+END PGP SIGNATURE-+$" nil t))
- (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
- (let (status)
- (let* ((beg (point))
- (situation (mime-preview-find-boundary-info))
- (p-end (aref situation 1))
- (entity (aref situation 2))
- (count 0))
- (goto-char p-end)
- (while (< beg (point))
- (if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
- (setq count (+ count 1))
- (debug)))
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert (mime-entity-body entity))
- (goto-char (point-max))
- (while (> count 0)
- (if (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
- (setq count (- count 1))
- (debug)))
- (let ((r-beg (point))
- (r-end (re-search-forward "^-+END PGP SIGNATURE-+$" nil t)))
- (if r-end
- (setq status (pgg-verify-region r-beg r-end nil 'fetch))
- (debug)))))
- (mime-show-echo-buffer)
- (set-buffer mime-echo-buffer-name)
- (set-window-start
- (get-buffer-window mime-echo-buffer-name)
- (point-max))
- (insert-buffer-substring
- (if status pgg-output-buffer pgg-errors-buffer)))
- (message "Cannot find pgp signed region"))))
+ (let ((message-buffer (current-buffer))
+ beg end coding-system success)
+ (setq end (and (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t)
+ (re-search-backward "^-+END PGP SIGNATURE-+$" nil t)
+ (error "Cannot find pgp signed region"))
+ (match-end 0)))
+ (setq beg (or (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
+ (error "Cannot find pgp signed region")))
+ (setq coding-system
+ (or (let* ((situation (mime-preview-find-boundary-info))
+ (entity (aref situation 2)))
+ (mime-charset-to-coding-system
+ (mime-content-type-parameter
+ (mime-entity-content-type entity)
+ "charset")))
+ buffer-file-coding-system))
+ (when arg
+ (setq coding-system (read-coding-system
+ (format "Coding system (%S): " coding-system)
+ coding-system)))
+ (with-temp-buffer
+ (insert-buffer-substring message-buffer beg end)
+ (encode-coding-region (point-min) (point-max) coding-system)
+ (setq success (pgg-verify-region (point-min) (point-max) nil 'fetch)))
+ (mime-show-echo-buffer)
+ (set-buffer mime-echo-buffer-name)
+ (set-window-start
+ (get-buffer-window mime-echo-buffer-name)
+ (point-max))
+ (insert-buffer-substring
+ (if success pgg-output-buffer pgg-errors-buffer)))))
;; XXX: encrypted multipart isn't represented as multipart
(defun wl-mime-preview-application/pgp (parent-entity entity situation)
(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)
(defun wl-score-headers (scores &optional force-msgs not-add)
(let* ((elmo-mime-charset wl-summary-buffer-mime-charset)
(folder wl-summary-buffer-elmo-folder)
- (now (wl-day-number (current-time-string)))
+ (now (elmo-time-to-days (current-time)))
(expire (and wl-score-expiry-days
(- now wl-score-expiry-days)))
(wl-score-stop-add-entry not-add)
expire
(< expire
(setq day
- (wl-day-number
+ (elmo-time-to-days
(elmo-message-entity-field
(car art) 'date))))))
(when (setq new (wl-score-add-followups
(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
(setq dont t)))
(unless dont
(let ((entry (list id score
- (or day (wl-day-number (current-time-string))) 's)))
+ (or day (elmo-time-to-days (current-time))) 's)))
(unless (or thread wl-score-stop-add-entry)
(wl-score-update-score-entry "references" entry alist))
(wl-score-set 'touched '(t) alist)
(wl-summary-score-effect (car entry) list (eq (nth 2 list) 'now)))))
(defun wl-score-get-latest-msgs ()
- (let* ((now (wl-day-number (current-time-string)))
+ (let* ((now (elmo-time-to-days (current-time)))
(expire (and wl-score-expiry-days
(- now wl-score-expiry-days)))
(rnumbers (reverse wl-summary-buffer-number-list))
nil t)
(catch 'break
(while rnumbers
- (if (< (wl-day-number
- (elmo-message-entity-field
- (elmo-message-entity wl-summary-buffer-elmo-folder
- (car rnumbers))
- 'date))
+ (if (< (elmo-time-to-days
+ (elmo-message-entity-field 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*")
(perm (cond ((eq perm 'perm)
nil)
((eq perm 'temp)
- (wl-day-number (current-time-string)))
+ (elmo-time-to-days (current-time)))
((eq perm 'now)
perm)))
(new (list match score perm type extra)))
(defun wl-score-edit-insert-date ()
"Insert date in numerical format."
(interactive)
- (princ (wl-day-number (current-time-string)) (current-buffer)))
+ (princ (elmo-time-to-days (current-time)) (current-buffer)))
(defun wl-score-pretty-print ()
"Format the current score file."
(let ((folder (or folder wl-summary-buffer-elmo-folder))
(number (or number (wl-summary-message-number)))
spam)
- (message "Cheking spam...")
+ (message "Checking spam...")
(when (setq spam (elmo-spam-message-spam-p (elmo-spam-processor)
folder number))
(wl-summary-spam number))
- (message "Cheking spam...done")
+ (message "Checking spam...done")
(when (interactive-p)
(message "No: %d is %sa spam message." number (if spam "" "not ")))))
+(defun wl-summary-test-spam-region (beg end)
+ (interactive "r")
+ (let ((numbers (wl-summary-collect-numbers-region beg end)))
+ (cond (numbers
+ (wl-spam-map-spam-messages wl-summary-buffer-elmo-folder
+ numbers
+ #'wl-summary-spam))
+ ((interactive-p)
+ (message "No message to test.")))))
+
(defun wl-summary-mark-spam (&optional all)
"Set spam mark to messages which is spam classification."
(interactive "P")
(let ((domain (wl-spam-domain (elmo-folder-name-internal
wl-summary-buffer-elmo-folder)))
(total (length mark-list)))
- (wl-folder-confirm-existence (elmo-make-folder wl-spam-folder))
+ (wl-folder-confirm-existence (wl-folder-get-elmo-folder wl-spam-folder))
(when (memq domain '(undecided good))
(message "Registering spam...")
(elmo-with-progress-display (> total elmo-display-progress-threshold)
(let ((original (wl-message-get-original-buffer))
(number wl-message-buffer-cur-number)
spam)
- (message "Cheking spam...")
+ (message "Checking spam...")
(when (setq spam (elmo-spam-buffer-spam-p (elmo-spam-processor) original))
(with-current-buffer wl-message-buffer-cur-summary-buffer
(wl-summary-spam number)))
- (message "Cheking spam...done")
+ (message "Checking spam...done")
(message "No: %d is %sa spam message." number (if spam "" "not "))))
(defun wl-refile-guess-by-spam (entity)
wl-summary-skip-mark-list))))
(define-key wl-summary-mode-map "k" wl-summary-spam-map)
(define-key
+ wl-summary-mode-map "rkc" 'wl-summary-test-spam-region)
+ (define-key
wl-summary-mode-map "mk" 'wl-summary-target-mark-spam)
(define-key
wl-summary-mode-map "ms" 'wl-summary-target-mark-register-as-spam)
and (2) sender address is yours.
See also variable `wl-use-petname'."
- (let (retval tos ng)
- (unless
- (and (eq major-mode 'wl-summary-mode)
+ (let ((translator (if wl-use-petname
+ (lambda (string)
+ (or (funcall wl-summary-get-petname-function string)
+ (car (std11-extract-address-components string))
+ string))
+ #'identity))
+ to ng)
+ (or (and (eq major-mode 'wl-summary-mode)
(stringp wl-summary-showto-folder-regexp)
(string-match wl-summary-showto-folder-regexp
(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 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)
- ","))))
- ((setq ng (elmo-message-entity-field
- wl-message-entity 'newsgroups))
- (setq retval (concat "Ng:" ng)))))
- (if wl-use-petname
- (setq retval (or (funcall wl-summary-get-petname-function from)
- (car (std11-extract-address-components from))
- from))
- (setq retval from)))
- retval))
+ ((setq to (elmo-message-entity-field wl-message-entity 'to))
+ (concat "To:" (mapconcat translator to ",")))
+ ((setq ng (elmo-message-entity-field wl-message-entity
+ 'newsgroups))
+ (concat "Ng:" ng))))
+ (funcall translator from))))
(defun wl-summary-simple-from (string)
(if wl-use-petname
(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)
(inhibit-read-only t))
(if (eq wl-summary-buffer-view 'thread)
(let* ((thread-entity (wl-thread-get-entity number))
- (descendant (wl-thread-entity-get-descendant thread-entity))
(thread-parent (wl-thread-entity-get-parent thread-entity))
(entity-parent (elmo-message-entity-number
(elmo-message-entity-parent folder entity)))
(progn
(wl-thread-entity-set-linked thread-entity nil)
(wl-thread-update-line-on-buffer-sub nil number))
- (wl-thread-delete-message number 'deep 'update)
- (dolist (number (cons number descendant))
- (setq update-top-list
- (nconc
- update-top-list
- (wl-summary-insert-thread
- (elmo-message-entity folder number)
- folder
- 'update))))
- (when update-top-list
- (wl-thread-update-indent-string-thread
- (elmo-uniq-list update-top-list)))))
+ (let ((replacements
+ (cons number
+ (wl-thread-entity-get-descendant thread-entity))))
+ (wl-thread-delete-message number 'deep 'update)
+ (wl-thread-cleanup-symbols replacements)
+ (dolist (number replacements)
+ (setq update-top-list
+ (nconc
+ update-top-list
+ (wl-summary-insert-thread
+ (elmo-message-entity folder number)
+ folder
+ 'update))))
+ (when update-top-list
+ (wl-thread-update-indent-string-thread
+ (elmo-uniq-list update-top-list))))))
(delete-region (point-at-bol) (1+ (point-at-eol)))
(wl-summary-insert-line
(wl-summary-create-line entity nil
(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))
- (make-vector 5 0)))
+ (wl-datevec (or (elmo-time-to-datevec
+ (elmo-message-entity-field wl-message-entity 'date)
+ wl-summary-fix-timezone)
+ (make-vector 7 0)))
(entity wl-message-entity) ; backward compatibility.
line mark)
(if (and wl-thr-indent-string
wl-summary-buffer-elmo-folder
(wl-summary-message-number))))
(wl-ps-subject
- (and entity
- (or (elmo-message-entity-field entity 'subject t)
- "")))
+ (or (elmo-message-entity-field entity 'subject 'string)
+ ""))
(wl-ps-from
- (and entity
- (or (elmo-message-entity-field entity 'from t) "")))
+ (or (elmo-message-entity-field entity 'from 'string)
+ ""))
(wl-ps-date
- (and entity
- (or (elmo-message-entity-field entity 'date) ""))))
+ (or (elmo-message-entity-field entity 'date 'string)
+ "")))
(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
(wl-get-date-iso8601 date)
(error "")))
-(defun wl-day-number (date)
- (let ((dat (mapcar '(lambda (s) (and s (string-to-int s)) )
- (timezone-parse-date date))))
- (timezone-absolute-from-gregorian
- (nth 1 dat) (nth 2 dat) (car dat))))
-
(defun wl-url-news (url &rest args)
(interactive "sURL: ")
(if (string-match "^news:\\(.*\\)$" url)
(let* ((completion-ignore-case t)
(denial-fields (nconc (mapcar 'capitalize elmo-msgdb-extra-fields)
'("Flag" "Since" "Before"
- "From" "Subject" "To" "Cc" "Body" "ToCc")))
+ "From" "Subject" "To" "Cc" "Body" "ToCc"
+ "Larger" "Smaller")))
(field (completing-read
(format "%s (%s): " prompt default)
(mapcar 'list
"*Additional headers in the draft."
:type '(repeat (cons (symbol :tag "Field Name")
(choice (string :tag "String")
- (function :tag "Function")))))
+ (function :tag "Function"))))
+ :group 'wl-draft)
(defcustom wl-draft-add-in-reply-to t
"*If non-nil, message-id of the cited message is inserted to the
in-reply-to field of the current draft.
Note: default value follows RFC2822."
:type 'boolean
- :group 'wl)
+ :group 'wl-draft)
(defcustom wl-draft-add-references nil
"*If non-nil, message-id of the cited message is inserted to the
references field of the current draft.
Note: default value follows RFC2822."
:type 'boolean
- :group 'wl)
+ :group 'wl-draft)
(defcustom wl-draft-cite-function 'wl-default-draft-cite
"*A function for citation."
(defcustom wl-summary-showto-folder-regexp nil
"Regexp specifying the folder that shows the To (or Newsgroups) field as
-Sender information in summary mode."
+Sender information in summary mode. It is effective when the value of
+`wl-summary-from-function' is `wl-summary-default-from'"
:type '(choice (const :tag "none" nil)
regexp)
:group 'wl-summary)
"*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)
(make-face (intern
(format "wl-highlight-summary-%s-flag-face" (car spec))))
(nth 1 spec)))
+ (setq elmo-get-folder-function #'wl-folder-make-elmo-folder)
(setq elmo-no-from wl-summary-no-from-message)
(setq elmo-no-subject wl-summary-no-subject-message)
(elmo-global-flags-initialize (mapcar 'car wl-summary-flag-alist))
projects / elisp / wanderlust.git / commitdiff