From 8b003dd16e3d4a1f0d29b5fcd0f57a2ee294f967 Mon Sep 17 00:00:00 2001 From: teranisi Date: Fri, 15 Jun 2001 10:22:31 +0000 Subject: [PATCH] Synch up with elmo-lunafy. Version number is increased to 2.7.0. wl: * wl-version.el (wl-version): Changed codename. elmo: * elmo-version.el (elmo-version): Up to 2.7.0. --- ChangeLog | 37 + WL-ELS | 20 +- doc/TODO.ja | 3 +- doc/texinfo.tex | 64 +- doc/version.texi | 2 +- doc/wl-ja.texi | 52 +- doc/wl.texi | 45 +- elmo/ChangeLog | 900 ++++++++++++++++++++-- elmo/elmo-archive.el | 826 ++++++++++---------- elmo/elmo-cache.el | 854 ++++----------------- elmo/elmo-date.el | 61 +- elmo/elmo-dop.el | 688 +++++------------ elmo/elmo-filter.el | 298 +++++--- elmo/elmo-imap4.el | 1701 +++++++++++++++++++++++++----------------- elmo/elmo-internal.el | 283 ++----- elmo/elmo-localdir.el | 609 ++++++--------- elmo/elmo-localnews.el | 102 +-- elmo/elmo-maildir.el | 615 ++++++++------- elmo/elmo-map.el | 314 ++++++++ elmo/elmo-mark.el | 209 ++++++ elmo/elmo-mime.el | 322 ++++++++ elmo/elmo-msgdb.el | 420 ++++------- elmo/elmo-multi.el | 710 +++++++++++------- elmo/elmo-net.el | 362 ++++++++- elmo/elmo-nmz.el | 240 ++++++ elmo/elmo-nntp.el | 772 ++++++++++++------- elmo/elmo-pipe.el | 302 +++++--- elmo/elmo-pop3.el | 394 ++++++---- elmo/elmo-shimbun.el | 371 +++++++++ elmo/elmo-util.el | 1038 +++++++++++++------------- elmo/elmo-vars.el | 168 +---- elmo/elmo-version.el | 2 +- elmo/elmo.el | 1438 +++++++++++++++++++++++++++++++++++ elmo/elmo2.el | 945 ----------------------- elmo/mmelmo-imap4.el | 359 --------- elmo/mmelmo.el | 265 ------- elmo/mmimap.el | 295 ++++++++ samples/en/dot.addresses | 13 +- samples/en/dot.folders | 119 +-- samples/en/dot.wl | 342 +++++---- samples/ja/dot.addresses | 11 +- samples/ja/dot.folders | 123 +-- samples/ja/dot.wl | 371 +++++---- utils/bbdb-wl.el | 19 +- wl/ChangeLog | 628 ++++++++++++++-- wl/wl-address.el | 6 +- wl/wl-draft.el | 228 +++--- wl/wl-e21.el | 15 +- wl/wl-expire.el | 404 +++++----- wl/wl-fldmgr.el | 124 +-- wl/wl-folder.el | 704 ++++++++--------- wl/wl-highlight.el | 54 +- wl/wl-message.el | 881 +++++++++++----------- wl/wl-mime.el | 100 +-- wl/wl-mule.el | 2 +- wl/wl-refile.el | 35 +- wl/wl-score.el | 67 +- wl/wl-summary.el | 1866 ++++++++++++++++++---------------------------- wl/wl-template.el | 7 +- wl/wl-thread.el | 53 +- wl/wl-util.el | 114 +-- wl/wl-vars.el | 111 ++- wl/wl-version.el | 29 +- wl/wl-xmas.el | 8 +- wl/wl.el | 290 +++---- 65 files changed, 12729 insertions(+), 10081 deletions(-) create mode 100644 elmo/elmo-map.el create mode 100644 elmo/elmo-mark.el create mode 100644 elmo/elmo-mime.el create mode 100644 elmo/elmo-nmz.el create mode 100644 elmo/elmo-shimbun.el create mode 100644 elmo/elmo.el delete mode 100644 elmo/elmo2.el delete mode 100644 elmo/mmelmo-imap4.el delete mode 100644 elmo/mmelmo.el create mode 100644 elmo/mmimap.el diff --git a/ChangeLog b/ChangeLog index 001b1e3..1504214 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,11 +3,30 @@ * WL-MK (wl-detect-info-directory): Call `info-initialize' for Emacs21. +2001-05-22 Hiroya Murata + + * utils/bbdb-wl.el (bbdb-wl-get-update-record): Use function + `wl-summary-buffer-folder-name' instead of same name variable. + +2001-05-08 Kenichi OKADA + + * utils/bbdb-wl.el (bbdb-wl-folder-regexp): New variable. + (bbdb-wl-get-update-record): Use `bbdb-wl-folder-regexp'. + 2001-04-16 Yuuichi Teranishi * utils/bbdb-wl.el (bbdb-wl-get-update-record): Use `with-current-buffer'. +2001-04-04 Yuuichi Teranishi + + * WL-ELS (ELMO-MODULES): Removed shimbun related modules; + Add elmo-shimbun only if shimbun is installed. + +2001-04-03 Yuuichi Teranishi + + * WL-ELS (ELMO-MODULES): Added sb-tcup. + 2001-04-02 Yuuichi Teranishi * utils/bbdb-wl.el: Applied patch from @@ -15,6 +34,24 @@ (X-Mail-Count: 07190, 07195 in the ML); Added workaround for older version of bbdb. + * WL-ELS (ELMO-MODULES): Added shimbun related modules. + +2001-02-06 Yuuichi Teranishi + + * WL-ELS (ELMO-MODULES): Added elmo-mark. + +2001-01-30 Yuuichi Teranishi + + * etc/icons/nmz.xpm: New file. + + * WL-ELS (ELMO-MODULES): Added elmo-nmz. + +2000-12-18 Yuuichi Teranishi + + * WL-ELS (ELMO-MODULES): Changed order. + Added mmimap, elmo, elmo-mime. + Removed mmelmo-imap4, mmelmo. + 2001-02-01 Yuuichi Teranishi * 2.4.1 - "Stand By Me" diff --git a/WL-ELS b/WL-ELS index 956bc51..8d31d2e 100644 --- a/WL-ELS +++ b/WL-ELS @@ -14,11 +14,14 @@ )) (defconst ELMO-MODULES '( - elmo-util elmo-version elmo-net elmo-imap4 elmo-nntp elmo-archive - elmo-localdir elmo-msgdb elmo-vars elmo2 - elmo-cache elmo-multi elmo-filter elmo-pipe - elmo-dop elmo-pop3 elmo-localnews elmo-maildir - elmo-date elmo-internal utf7 pldap + utf7 pldap mmimap + elmo-date elmo-util elmo-version elmo-vars elmo elmo-msgdb + elmo-net elmo-imap4 elmo-pop3 elmo-nntp + elmo-localdir elmo-localnews elmo-map elmo-maildir + elmo-multi elmo-filter + elmo-archive elmo-pipe elmo-cache + elmo-internal elmo-mark + elmo-dop elmo-nmz )) @@ -45,6 +48,9 @@ (fboundp 'open-database)) (add-to-list 'ELMO-MODULES 'elmo-database)) +(if (module-installed-p 'shimbun) + (add-to-list 'ELMO-MODULES 'elmo-shimbun)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; tm-8 / SEMI @@ -52,7 +58,7 @@ (progn (defconst wl-use-semi t) (setq WL-MODULES (append WL-MODULES (list 'wl-mime))) - (setq ELMO-MODULES (append ELMO-MODULES (list 'mmelmo 'mmelmo-imap4)))) + (setq ELMO-MODULES (append ELMO-MODULES (list 'elmo-mime)))) (defconst wl-use-semi nil) (setq WL-MODULES (append WL-MODULES (list 'tm-wl)))) @@ -81,4 +87,4 @@ (if (exec-installed-p "imput") (cons UTILSDIR (list 'im-wl))) (if wl-install-utils - (cons UTILSDIR UTILS-MODULES)))) \ No newline at end of file + (cons UTILSDIR UTILS-MODULES)))) diff --git a/doc/TODO.ja b/doc/TODO.ja index d329d56..254e0a5 100644 --- a/doc/TODO.ja +++ b/doc/TODO.ja @@ -1,7 +1,6 @@ -elmo-search $B$G(B msgdb $B$H%U%)%k%@K\BN$r%7!<%`%l%9$K8!:w(B -pick/virtual $B$N(B completion $BE}9g(B msgdb $B9=B$$N8+D>$7$H(B obarray $B2=(B $B=EMW%^!<%/$N4IM}(B +IMAP $B%U%)%k%@%A%'%C%/$G(B RECENT $B$NCM$r;H$&$h$&$K$9$k!#(B $B%5%^%j%U%)!<%^%C%H<+M32=(B $B%W%j%U%'%C%AM=Ls%^!<%/(B $BJV;v:Q$_!"%U%)%o!<%I:Q$_%^!<%/(B diff --git a/doc/texinfo.tex b/doc/texinfo.tex index cd88ce7..0b5b903 100644 --- a/doc/texinfo.tex +++ b/doc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2001-05-24.09} +\def\texinfoversion{2001-03-28.08} % % Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, % 2000, 01 Free Software Foundation, Inc. @@ -170,16 +170,6 @@ }% \fi -% add check for \lastpenalty to plain's definitions. If the last thing -% we did was a \nobreak, we don't want to insert more space. -% -\def\smallbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\smallskipamount - \removelastskip\penalty-50\smallskip\fi\fi} -\def\medbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\medskipamount - \removelastskip\penalty-100\medskip\fi\fi} -\def\bigbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\bigskipamount - \removelastskip\penalty-200\bigskip\fi\fi} - % For @cropmarks command. % Do @cropmarks to get crop marks. % @@ -1040,7 +1030,6 @@ where each line of input produces a line of output.} \def\pdfurl#1{% \begingroup \normalturnoffactive\def\@{@}% - \let\value=\expandablevalue \leavevmode\Red \startlink attr{/Border [0 0 0]}% user{/Subtype /Link /A << /S /URI /URI (#1) >>}% @@ -1156,18 +1145,6 @@ where each line of input produces a line of output.} \font\smalli=cmmi9 \font\smallsy=cmsy9 -% Fonts for small examples (8pt). -\setfont\smallerrm\rmshape{8}{1000} -\setfont\smallertt\ttshape{8}{1000} -\setfont\smallerbf\bfshape{10}{800} -\setfont\smallerit\itshape{8}{1000} -\setfont\smallersl\slshape{8}{1000} -\setfont\smallersf\sfshape{8}{1000} -\setfont\smallersc\scshape{10}{800} -\setfont\smallerttsl\ttslshape{10}{800} -\font\smalleri=cmmi8 -\font\smallersy=cmsy8 - % Fonts for title page: \setfont\titlerm\rmbshape{12}{\magstep3} \setfont\titleit\itbshape{10}{\magstep4} @@ -1285,14 +1262,7 @@ where each line of input produces a line of output.} \let\tenbf=\smallbf \let\tentt=\smalltt \let\smallcaps=\smallsc \let\tensf=\smallsf \let\teni=\smalli \let\tensy=\smallsy \let\tenttsl=\smallttsl - \resetmathfonts \setleading{10.5pt}} -\def\smallerfonts{% - \let\tenrm=\smallerrm \let\tenit=\smallerit \let\tensl=\smallersl - \let\tenbf=\smallerbf \let\tentt=\smallertt \let\smallcaps=\smallersc - \let\tensf=\smallersf \let\teni=\smalleri \let\tensy=\smallersy - \let\tenttsl=\smallerttsl - \resetmathfonts \setleading{9.5pt}} -\let\smallexamplefonts = \smallerfonts + \resetmathfonts \setleading{11pt}} % Set up the default fonts, so we can use them for creating boxes. % @@ -2486,14 +2456,10 @@ width0pt\relax} \fi \let\tenrm=\nullfont \let\tenit=\nullfont \let\tensl=\nullfont \let\tenbf=\nullfont \let\tentt=\nullfont \let\smallcaps=\nullfont \let\tensf=\nullfont - % Similarly for index fonts. + % Similarly for index fonts (mostly for their use in smallexample). \let\smallrm=\nullfont \let\smallit=\nullfont \let\smallsl=\nullfont \let\smallbf=\nullfont \let\smalltt=\nullfont \let\smallsc=\nullfont \let\smallsf=\nullfont - % Similarly for smallexample fonts. - \let\smallerrm=\nullfont \let\smallerit=\nullfont \let\smallersl=\nullfont - \let\smallerbf=\nullfont \let\smallertt=\nullfont \let\smallersc=\nullfont - \let\smallersf=\nullfont % % Don't complain when characters are missing from the fonts. \tracinglostchars = 0 @@ -4180,17 +4146,9 @@ width0pt\relax} \fi % is reset to zero; thus the \afterenvbreak inserts no space -- but the % start of the next paragraph will insert \parskip % -\def\aboveenvbreak{{% - \ifnum\lastpenalty < 10000 - \advance\envskipamount by \parskip - \endgraf - \ifdim\lastskip<\envskipamount - \removelastskip - \penalty-50 - \vskip\envskipamount - \fi - \fi -}} +\def\aboveenvbreak{{\advance\envskipamount by \parskip +\endgraf \ifdim\lastskip<\envskipamount +\removelastskip \penalty-50 \vskip\envskipamount \fi}} \let\afterenvbreak = \aboveenvbreak @@ -4322,7 +4280,7 @@ width0pt\relax} \fi \def\smalllispx{\begingroup \def\Esmalllisp{\nonfillfinish\endgroup}% \def\Esmallexample{\nonfillfinish\endgroup}% - \smallexamplefonts + \smallfonts \lisp } @@ -4333,12 +4291,12 @@ width0pt\relax} \fi \let\Edisplay = \nonfillfinish \gobble } -% + % @smalldisplay (when @smallbook): @display plus smaller fonts. % \def\smalldisplayx{\begingroup \def\Esmalldisplay{\nonfillfinish\endgroup}% - \smallexamplefonts \rm + \smallfonts \rm \display } @@ -4350,12 +4308,12 @@ width0pt\relax} \fi \let\Eformat = \nonfillfinish \gobble } -% + % @smallformat (when @smallbook): @format plus smaller fonts. % \def\smallformatx{\begingroup \def\Esmallformat{\nonfillfinish\endgroup}% - \smallexamplefonts \rm + \smallfonts \rm \format } diff --git a/doc/version.texi b/doc/version.texi index 68d4040..393b701 100644 --- a/doc/version.texi +++ b/doc/version.texi @@ -1 +1 @@ -@set VERSION 2.5.8 +@set VERSION 2.7.0 diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index 8b20c04..9d57b6d 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -198,20 +198,15 @@ Wanderlust $B$,@\B3$7$FF0:n$9$k$3$H$,3NG'$5$l$F$$$k(B IMAP $B%5!<%P$O0J2<$NDL @itemize @bullet @item UW imapd 4.1$B!A(B4.7, 4.7a, 4.7b, 4.7c, 2000 $B0J9_(B -@item Cyrus imapd 1.4, 1.5.19, 1.6.22$B!A(B1.6.24, 2.0.5 $B0J9_(B -@item Courier-IMAP 1.3.2 $B0J9_(B +@item Cyrus imapd 1.4, 1.5.19, 1.6.22, 2.0.5 $B0J9_(B @item AIR MAIL (AIRC imapd release 2.00) @item Express Mail @item Microsoft Exchange Server 5.5 -@item Sun Internet Mail Server 3.5, 3.5.alpha, 4.0 +@item Sun Internet Mail Server 4.0 @end itemize -Wanderlust $B$,@\B3$7$FF0:n$9$k$3$H$,3NG'$5$l$F$$$k(B LDAP $B%5!<%P$O0J2<$NDL(B -$B$j$G$9!#(B - -@itemize @bullet -@item OpenLDAP 2.0.6 $B0J9_(B -@end itemize +@c Wanderlust $B$,@\B3$7$FF0:n$9$k$3$H$,3NG'$5$l$F$$$k(B LDAP $B%5!<%P$O0J2<$NDL(B +@c $B$j$G$9!#(B @node Start Me Up, Folders, Introduction, Top @@ -282,7 +277,7 @@ APEL, FLIM, SEMI $B$N=g$K%$%s%9%H!<%k$7$F$/$@$5$$!#(B $B?d>)$5$l$k(B APEL, FLIM, SEMI $B$N%P!<%8%g%s$NAH9g$;$O!"0J2<$NDL$j$G$9!#(B @itemize @minus -@item APEL 10.3, FLIM 1.14.3, SEMI 1.14.3 +@item APEL 10.3, FLIM 1.14.2, SEMI 1.14.3 @end itemize $B$=$NB>!"(BFLIM, SEMI $B$K$O$$$m$$$m$JJQ7A%P!<%8%g%s$,B8:_$7$^$9$,!"(B @@ -608,8 +603,8 @@ Wanderlust $B$K8GM-$N@_Dj$O(B @file{~/.wl} $B$K5-=R$7$F$*$1$P@0M}$7$d$9$$$G$7 # @var{$B%a!<%k%"%I%l%9(B} "@var{$B$"$@L>(B}" "@var{$BK\L>(B}" # teranisi@@gohome.org "$B$F$i$K$7(B" "$B;{@>M50l(B" -foo@@example.com "$B$U!<$5$s(B" "John Foo" -bar@@example.org "$B$P!<$5$s(B" "Michael Bar" +foo@@bar.gohome.org "Foo $B$5$s(B" "John Foo" +bar@@foo.gohome.org "Bar $B$5$s(B" "Michael Bar" @end group @end example @@ -3630,6 +3625,29 @@ Non-nil $B$J$i(B @code{wl-summary-jump-to-msg-by-message-id} $B$G!"%a%C%;!<%8 @vindex elmo-pop3-use-cache $B=i4|@_Dj$O(B @code{t}$B!#(BNon-nil $B$J$i!"(BPOP3 $B$GFI$s$@%a%C%;!<%8$r%-%c%C%7%e$7(B $B$^$9!#(B + +@item wl-folder-process-duplicates-alist +@vindex wl-folder-process-duplicates-alist +$B=i4|@_Dj$O(B @code{nil}$B!#=EJ#$7$?%a%C%;!<%8$,F1$8%U%)%k%@$K$"$k>l9g$NF0:n(B +$B$r;XDj$7$^$9!#3F9`L\$O!"%U%)%k%@L>$N@55,I=8=$HF0:n$+$i$J$j$^$9!#(B +$BF0:n$H$7$F$O0J2<$N$b$N$,;XDj$G$-$^$9!#(B + +@example +@code{nil} : $B=EJ#%a%C%;!<%8$KBP$7!$2?$b$7$J$$!%(B +@code{hide} : $B=EJ#%a%C%;!<%8$r%5%^%j$KI=<($7$J$$!%(B +@code{read} : $B=EJ#%a%C%;!<%8$r4{FI$K$9$k!%(B +@end example + +@noindent +$BNc$($P0J2<$N$h$&$K@_Dj$7$^$9(B ($B%^%k%A%U%)%k%@$G=EJ#%a%C%;!<%8$r1#$9>l9g(B) + +@lisp +@group +(setq wl-folder-process-duplicates-alist + '(("^\\+draft$" . nil) ("^\\+trash$" . nil) + ("^\\*.*" . hide) (".*" . read))) +@end group +@end lisp @end table @@ -4190,16 +4208,6 @@ Non-nil $B$J$i%&%#%s%I%&$rI=<($7$J$,$i%F%s%W%l!<%H$rA*Br$9$k>l9g!"%j%?!<%s(B $B=i4|@_Dj$O(B @code{nil}$B!#(B Non-nil $B$J$i%I%i%U%HMQ$K?7$7$$%U%l!<%`$r3+$-$^$9!#(B -@item wl-folder-use-frame -@vindex wl-folder-use-frame -$B=i4|@_Dj$O(B @code{nil}$B!#(B -Non-nil $B$J$i%U%)%k%@0lMwMQ$K?7$7$$%U%l!<%`$r3+$-$^$9!#(B - -@item wl-summary-use-frame -@vindex wl-summary-use-frame -$B=i4|@_Dj$O(B @code{nil}$B!#(B -Non-nil $B$J$i%5%^%jI=<(MQ$K?7$7$$%U%l!<%`$r3+$-$^$9!#(B - @item wl-from @vindex wl-from $B=i4|@_Dj$OJQ?t(B @code{user-mail-address} $B$NCM!#(B diff --git a/doc/wl.texi b/doc/wl.texi index 84f6ce3..21bc00e 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -173,20 +173,15 @@ Wanderlust: @itemize @bullet @item UW imapd 4.1--4.7, 4.7a, 4.7b, 4.7c, 2000 or later -@item Cyrus imapd 1.4, 1.5.19, 1.6.22--1.6.24, 2.0.5 or later -@item Courier-IMAP 1.3.2 or later +@item Cyrus imapd 1.4, 1.5.19, 1.6.22, 2.0.5 or later @item AIR MAIL (AIRC imapd release 2.00) @item Express Mail @item Microsoft Exchange Server 5.5 -@item Sun Internet Mail Server 3.5, 3.5.alpha, 4.0 +@item Sun Internet Mail Server 4.0 @end itemize -LDAP connectivity with following LDAPd are confirmed to work with -Wanderlust: - -@itemize @bullet -@item OpenLDAP 2.0.6 or later -@end itemize +@c LDAP connectivity with following LDAPd are confirmed to work with +@c Wanderlust: @node Start Me Up, Folders, Introduction, Top @@ -581,9 +576,9 @@ The format is very simple. Like this. @refill # @r{Format of each line:} # @var{email-address} "@var{nickname} "@var{realname}" # -teranisi@@gohome.org "YT" "Yuuichi Teranishi" -foo@@example.com "Mr. Foo" "John Foo" -bar@@example.org "Mr. Bar" "Michael Bar" +teranisi@@gohome.org "Yuuichi" "Yuuichi Teranishi" +foo@@bar.gohome.org "Mr. Foo" "John Foo" +bar@@foo.gohome.org "Mr. Bar" "Michael Bar" @end group @end example @@ -1283,7 +1278,7 @@ Example: @end group @end example -To use APOP as an @var{authenticate-type}, @file{md5.el} is needed +To use apop as an @var{authenticate-type}, @file{md5.el} is needed (XEmacs doesn't need @file{md5.el}). @file{md5.el} is included in @file{utils/sasl/lisp/} or Emacs/W3 package (@uref{http://www.cs.indiana.edu/elisp/w3/docs.html}) or LCD archive @@ -3637,6 +3632,30 @@ cached. @vindex elmo-pop3-use-cache The initial setting is @code{t}. If non-nil, messages read via POP3 are cached. + +@item wl-folder-process-duplicates-alist +@vindex wl-folder-process-duplicates-alist +The initial setting is @code{nil}. +This list determines how to deal with duplicated messages in the same folder. +Each item in the list is regexp of folder name and action; you can specify any +one of the following in the place of action: + +@example +@code{nil} : do nothing for duplicated messages. +@code{hide} : hide duplicated messages from the summary. +@code{read} : set duplicated messages as read. +@end example + +@noindent +Following is an example (hide duplicated messages in multi folders) + +@lisp +@group +(setq wl-folder-process-duplicates-alist + '(("^\\+draft$" . nil) ("^\\+trash$" . nil) + ("^\\*.*" . hide) (".*" . read))) +@end group +@end lisp @end table diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 5b2bd23..bfdcb34 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,5 +1,7 @@ 2001-06-15 Yuuichi Teranishi + * elmo-version.el (elmo-version): Up to 2.7.0. + * elmo-pop3.el (elmo-pop3-debug): New variable. (elmo-pop3-debug-inhibit-logging): Ditto. (elmo-pop3-debug): New function. @@ -15,6 +17,8 @@ (elmo-pop3-locked-p): Call elmo-pop3-debug. (elmo-pop3-read-body): Call elmo-pop3-unlock. (elmo-network-initialize-session): Call elmo-pop3-lock. + (elmo-folder-close-internal): Don't clear location-alist slot. + (elmo-folder-check): Clear location-alist slot. 2001-06-13 Yuuichi Teranishi @@ -25,23 +29,29 @@ (elmo-pop3-lock): New function. (elmo-pop3-unlock): Ditto. (elmo-pop3-locked-p): Ditto. - (elmo-pop3-commit): Don't delete process if elmo-pop3-locked-p + (elmo-folder-check): Don't delete process if elmo-pop3-locked-p returns t. 2001-06-11 Yuuichi Teranishi + * elmo-shimbun.el (elmo-shimbun-msgdb-to-headers): Inverted logic. + * elmo-util.el (elmo-file-field-primitive-condition-match): New inline function (Don't fetch file content if "first" or "last"). (elmo-file-field-condition-match): Use elmo-file-field-primitive-condition-match. - * elmo-localdir.el (elmo-localdir-field-primitive-condition-match): - New inline function. - (elmo-localdir-field-condition-match): - Use elmo-localdir-field-primitive-condition-match. - (elmo-localdir-search): Speed up simple "last" and "first". + * elmo-localdir.el (elmo-folder-search): Speed up simple "last" and + "first". + + * elmo-pop3.el (elmo-pop3-process-filter): Don't use floor nor float. + (elmo-message-fetch-plugged): Fixed. + + * elmo-imap4.el (elmo-imap4-find-next-line): Ditto. - * elmo2.el (elmo-move-msgs): Bind +2001-06-10 Yuuichi Teranishi + + * elmo.el (elmo-folder-move-messages): Bind elmo-inhibit-display-retrieval-progress as t while moving messages. * elmo-vars.el (elmo-display-retrieval-progress-threshold): @@ -52,68 +62,663 @@ for retrieval progress; Don't display progress when total buffer size is smaller than elmo-display-retrieval-progress-threshold. - (elmo-pop3-read-msg): Don't display progress when - elmo-inhibit-display-retrieval-progress is non-nil; - Remove progress bar after retrieval. + (elmo-message-fetch-plugged): Don't display progress when + elmo-inhibit-display-retrieval-progress is non-nil. * elmo-imap4.el (elmo-imap4-find-next-line): Use elmo-display-progress for retrieval progress; Don't display progress when literal size is smaller than elmo-display-retrieval-progress-threshold. - (elmo-imap4-read-msg): Don't display progress when - elmo-inhibit-display-retrieval-progress is non-nil; - Remove progress bar after retrieval. - * elmo-imap4.el (elmo-imap4-read-part): Ditto. + (elmo-imap4-message-fetch): Don't display progress when + elmo-inhibit-display-retrieval-progress is non-nil. 2001-06-07 Yuuichi Teranishi * elmo-imap4.el (elmo-imap4-display-literal-progress): New variable. - (elmo-imap4-find-next-line): Display progress while literal fetching. - (elmo-imap4-read-msg): Likewise. - (elmo-imap4-read-part): Ditto. + (elmo-imap4-find-next-line): Display progress whille literal fetching. + (elmo-imap4-message-fetch): Likewise. + + * elmo-shimbun.el (elmo-shimbun-default-index-range): New user option. + (elmo-shimbun-index-range-alist): Ditto. + (elmo-shimbun-use-entire-index): Abolish. + (shimbun-mua-use-entire-index): Ditto. + (elmo-shimbun-folder): Added new slot `range'. + (elmo-folder-initialize): Setup slot `range'. 2001-06-06 Yuuichi Teranishi + * elmo-shimbun.el (elmo-shimbun-parse-time-string): New function. + (elmo-shimbun-msgdb-to-headers): Added `expire-days' argument. + (elmo-shimbun-get-headers): Use return value of + `shimbun-article-expiration-days'. + (elmo-folder-close-internal): Clean up last-check slot. + * elmo-pop3.el (elmo-pop3-process-filter): Show retrieve progress. (elmo-pop3-total-size): New variable. - (elmo-pop3-read-msg): Bind elmo-pop3-total-size while fetching. + (elmo-message-fetch-plugged): Bind elmo-pop3-total-size while fetching. + + * elmo.el (elmo-folder-reserve-status-p): New method. + + * elmo-shimbun.el (elmo-shimbun-headers-cache): Abolish. + (elmo-shimbun-use-entire-index): New user option. + (shimbun-elmo-mua): New class. + (shimbun-mua-search-id): Define. + (shimbun-mua-use-entire-index): Ditto. + (elmo-shimbun-folder:last-check): New slot. + (elmo-shimbun-headers-cache-header-list): Abolish. + (elmo-shimbun-headers-cache-set-header-list): Ditto. + (elmo-shimbun-headers-cache-header-hash): Ditto. + (elmo-shimbun-headers-cache-set-header-hash): Ditto. + (elmo-shimbun-headers-cache-last-check): Ditto. + (elmo-shimbun-headers-cache-set-last-check): Ditto. + (elmo-shimbun-headers-check-p): Rewrite. + (elmo-shimbun-msgdb-to-headers): New function. + (elmo-shimbun-get-headers): Rewrite. + (elmo-folder-initialize): Set 1st argument of `shimbun-open'. + (elmo-folder-open-internal): Get headers only if + `elmo-shimbun-headers-check-p' is non-nil. + (elmo-folder-check): Check only if `elmo-shimbun-headers-check-p' + is non-nil. + (elmo-shimbun-msgdb-create-entity): Re-use old msgdb entities. + (elmo-quit): Removed. + + * elmo-msgdb.el (elmo-msgdb-overview-entity-get-extra): New inline + function. + (elmo-msgdb-overview-entity-set-extra): Ditto. + (elmo-msgdb-make-overview-hashtb): Make hash if overview is non-nil. + + * elmo-map.el (elmo-folder-status): Don't call + elmo-folder-close-internal if `elmo-folder-reserve-status-p' + is non-nil. + +2001-06-05 Hiroya Murata + + * elmo-msgdb.el (elmo-msgdb-search-internal): Call itself instead + of `elmo-msgdb-search-internal-primitive' when condition's car is + `and' or `or'. + +2001-05-23 Kenichi OKADA + + * elmo-nntp.el (elmo-nntp-get-newsgroup-by-msgid): Fix for luna. + +2001-05-22 Hiroya Murata + + * elmo-pipe.el (elmo-folder-open-internal): Check plugged before + call `elmo-pipe-drain'. + +2001-05-19 Masahiro MURATA + + * elmo-mark.el (elmo-message-fetch-with-cache-process): Fixed + typo. (elmo-cache-folder -> elmo-mark-folder) + +2001-05-11 Hiroya Murata + + * elmo-net.el (elmo-message-fetch-unplugged): Don't call + `elmo-message-fetch'. + +2001-05-10 Hiroya Murata + + * elmo-net.el (elmo-message-encache): Fixed typo. + (elmo-message-fetch-unplugged): Changed call + `elmo-message-fetch-internal' without argument `outbuf'. + +2001-05-10 Yuuichi Teranishi + + * elmo.el (elmo-message-encache): Define as generic function. + (elmo-message-fetch-field): New generic function. + (elmo-message-fetch-with-cache-process): Cause an error when + fetch strategy is 'entire but only 'section cache is available. + (toplevel): Fixed nmz folder definition. + + * elmo-vars.el (elmo-msgdb-lock-list-filename): Removed. + (elmo-msgdb-resume-list-filename): Ditto. + (elmo-queue-filename): Ditto. + (elmo-enable-disconnected-operation): Changed default value to t. + + * elmo-util.el (elmo-cache-path-section-p): New function. + (elmo-file-cache-get): Use it. + (elmo-dop-queue-filename): Moved from elmo-dop.el. + (elmo-dop-queue-load): Moved from elmo-msgdb.el. + (elmo-dop-queue-save): Ditto. + + * elmo-net.el (elmo-folder-status-unplugged): Call + elmo-folder-status-dop. + (elmo-folder-list-messages-unplugged): Implemented. + (elmo-folder-delete-messages-unplugged): Define. + (elmo-folder-msgdb-create): Define. + (elmo-folder-msgdb-create-unplugged): Define. + (elmo-folder-mark-as-read-unplugged): Ditto. + (elmo-folder-unmark-read-unplugged): Ditto. + (elmo-folder-mark-as-important-unplugged): Ditto. + (elmo-folder-unmark-important-unplugged): Ditto. + (elmo-message-encache): Ditto. + + * elmo-msgdb.el (elmo-dop-queue-load): Moved to elmo-util.el. + (elmo-dop-queue-save): Ditto. + + * elmo-imap4.el (elmo-folder-msgdb-create-plugged): Renamed from + `elmo-folder-msgdb-create'. + (elmo-folder-append-buffer): Implemented unplugged operation. + (elmo-folder-append-messages): Call parent method in unplugged status. + (elmo-message-fetch-unplugged): Removed definition. + (elmo-message-fetch-field): Implemented. + + * elmo-dop.el (toplevel): Require 'elmo-localdir. + (elmo-dop-folder): Removed variable definition. + (elmo-dop-queue-append): Changed argument `fname' to `folder'. + (elmo-dop-queue-flush): Implemented. + (elmo-dop-queue-merge): Removed definition (TODO). + (elmo-dop-spool-folder): New function. + (elmo-dop-spool-folder-append-buffer): Ditto. + (elmo-dop-spool-folder-list-messages): Ditto. + (elmo-dop-list-deleting-messages): Ditto. + (elmo-folder-append-buffer-dop): Ditto. + (elmo-folder-delete-messages-dop): Ditto. + (elmo-message-encache-dop): New inline function. + (elmo-create-folder-dop): Ditto. + (elmo-folder-mark-as-read-dop): Ditto. + (elmo-folder-unmark-read-dop): Ditto. + (elmo-folder-mark-as-important-dop): Ditto. + (elmo-folder-unmark-important-dop): Ditto. + (elmo-folder-status-dop): Fixed. + (elmo-folder-append-buffer-dop-delayed): New function. + (elmo-folder-delete-messages-dop-delayed): Ditto. + (elmo-dop-msgdb): Ditto. + +2001-05-10 Hiroya Murata + + * elmo-localdir.el (elmo-folder-pack-numbers): Fixed. + +2001-05-10 Hiroya Murata + + * elmo.el (elmo-folder-move-messages): Fixed problem when + `dst-folder' is 'null. + +2001-05-09 Hiroya Murata + + * elmo.el (elmo-folder-list-importants): Rewirte. Use global mark + instead of current mark. + + * elmo-multi.el (elmo-folder-list-importants-internal): No + operation if importants is not list. + + * elmo-filter.el (elmo-filter-folder-list-importants-internal): + Return t if importants is not list. + + * elmo-map.el (elmo-map-folder-list-importants): Define. + (elmo-folder-list-importants-internal): Check return value of + `elmo-map-folder-list-importants-internal'. + + * elmo-cache.el (elmo-folder-list-importants-internal): Eliminated. + + * elmo-mark.el (elmo-folder-list-importants-internal): Ditto. + + * elmo-nmz.el (elmo-folder-list-importants-internal): Ditto. + + * elmo-shimbun.el (elmo-folder-list-importants-internal): Ditto. + +2001-05-08 Yuuichi Teranishi + + * elmo.el (elmo-message-fetch-confirm): Fixed docstring. + (Patch is provided by ). + +2001-05-08 Hiroya Murata + + * elmo.el (elmo-folder-synchronize): Don't check important mark in + mark folder. + +2001-05-08 Hiroya Murata + + * elmo.el (elmo-message-fetch): Define. + (elmo-message-fetch-with-cache-process): New generic method. + (elmo-message-fetch-internal): New generic method. + (elmo-folder-synchronize): + + * elmo-archive.el (elmo-message-fetch-internal): Define. + (elmo-message-fetch): Eliminated. + + * elmo-localdir.el (elmo-message-fetch-internal): Define. + (elmo-message-fetch): Eliminated. + + * elmo-map.el (elmo-map-message-fetch): Eliminated optional + argument OUTBUF. + (elmo-message-fetch-internal): Define (Renamed from `elmo-message-fetch'). + + * elmo-cache.el (elmo-message-fetch-with-cache-process): Define. + (elmo-map-message-fetch): Merged with elmo-cache-folder-map-message-fetch. + + * elmo-mark.el (elmo-message-fetch-with-cache-process): Define. + (elmo-map-message-fetch): Merged with `elmo-mark-folder-map-message-fetch'. + + * elmo-maildir.el (elmo-map-message-fetch): Rewrite. + + * elmo-nmz.el (elmo-map-message-fetch): Ditto. + + * elmo-shimbun.el (elmo-map-message-fetch): Ditto. + + * elmo-net.el (elmo-message-fetch-plugged): Remove cache process. + (elmo-message-fetch-unplugged): New generic method. + (elmo-message-fetch-internal): Remove cache process (Renamed from + `elmo-message-fetch'). + + * elmo-nntp.el (elmo-message-fetch-with-cache-process): Define. + (elmo-message-fetch): Eliminated. + (elmo-message-fetch-unplugged): Ditto. + + * elmo-imap4.el (elmo-message-fetch-unplugged): Remove cache process. + +2001-05-02 Hiroya Murata + + * elmo-multi.el (elmo-multi-folder-append-msgdb): Fixed structure + of `to-be-deleted' from number-alist to number-list. + +2001-04-26 Hiroya Murata + + * elmo-pipe.el (elmo-folder-unmark-important): Fixed typo. + (elmo-folder-mark-as-important): Ditto. + +2001-04-26 Yuuichi Teranishi + + * elmo.el (elmo-folder): Added process-duplicates slot. + + * elmo-pipe.el (elmo-folder-mark-as-read): Define. + (elmo-folder-unmark-read): Ditto. + (elmo-folder-unmark-important): Ditto. + (elmo-folder-mark-as-important): Ditto. + + * elmo-multi.el (elmo-multi-folder-append-msgdb): Implemented + duplicated message processing. + + * elmo.el (elmo-generic-folder-append-msgdb): Ditto. + +2001-04-24 Hiroya Murata + + * elmo-util.el (elmo-list-subdirectories-1): New function. + (elmo-list-subdirectories): Use `elmo-list-subdirectories-1'. + (elmo-mapcar-list-of-list): New function. + + * elmo-archive.el (elmo-archive-folder-list-subfolders): Use + `elmo-mapcar-list-of-list' instead of `mapcar'. + + * elmo-localdir.el (elmo-folder-list-subfolders): Ditto. + + * elmo-maildir.el (elmo-folder-list-subfolders): Ditto. Bind + `elmo-have-link-count'. Return the fully qualified folder name. + +2001-04-23 Yuuichi Teranishi + + * elmo-shimbun.el (elmo-shimbun-check-interval): New user option. + (elmo-shimbun-headers-cache): New internal variable. + (elmo-shimbun-headers-cache-header-list): New inline function. + (elmo-shimbun-headers-cache-set-header-list): Ditto. + (elmo-shimbun-headers-cache-header-hash): Ditto. + (elmo-shimbun-headers-cache-set-header-hash): Ditto. + (elmo-shimbun-headers-cache-last-check): Ditto. + (elmo-shimbun-headers-cache-set-last-check): Ditto. + (elmo-shimbun-lapse-seconds): Ditto. + (elmo-shimbun-headers-cache-check-p): Ditto. + (elmo-shimbun-get-headers): New function. + (elmo-folder-open-internal): Call it. + (elmo-quit): Define (Clear headers-cache). + +2001-04-18 Yuuichi Teranishi + + * elmo-nntp.el (elmo-folder-initialize): Fixed typo (folder->name). + + * elmo-msgdb.el (elmo-msgdb-flist-load): Use elmo-mime-charset. + (elmo-msgdb-flist-save): Ditto. + + * elmo-shimbun.el (elmo-folder-list-subfolders): + Use `shimbun-groups' instead of `shimbun-groups-internal'. + (elmo-folder-exists-p): Ditto. + + * elmo-shimbun.el (elmo-shimbun-msgdb-create-entity): Set `shimbun' + argument for `shimbun-header-insert'. + +2001-04-17 Yuuichi Teranishi + + * elmo-multi.el (elmo-multi-folder-diff): Use dummy number list + at first time. + + * elmo-util.el (toplevel): Require 'mcharset and 'pces. + (With a little help from 'NAKAJIMA Mikio ') + +2001-04-16 Yuuichi Teranishi + + * elmo-shimbun.el (elmo-folder-open-internal): Do nothing if unplugged. + (elmo-folder-plugged-p): Define. + (elmo-folder-set-plugged): Ditto. + (elmo-shimbun-msgdb-create-entity): Do nothing if there's no header. + (elmo-folder-list-messages-internal): Return t if unplugged. + (elmo-folder-initialize): Fixed for "@gnome.gnome-1.4-list". + + * elmo-multi.el (elmo-folder-list-messages-internal): Fixed problem + when elmo-folder-list-messages-internal method of children returns t. + + * elmo-map.el (elmo-map-folder-update-locations): Fixed problem when + pair is nil. + (elmo-folder-open-internal): Don't update if unplugged status. + +2001-04-13 Yuuichi Teranishi + + * elmo.el (elmo-folder-synchronize): Fixed problem when there's no + new message. + +2001-04-12 Yuuichi Teranishi + + * elmo-util.el (elmo-file-cache-save): Ignore errors. + + * elmo-net.el (elmo-message-fetch): Check cache-path is non-nil before + saving. + +2001-04-09 Yuuichi Teranishi + + * elmo.el (elmo-folder-synchronize): Added optional no-check argument. + + * elmo-shimbun.el (elmo-shimbun-folder): Added headers slot. + (elmo-folder-open-internal): Set up headers slot. + (elmo-folder-check): Call elmo-folder-close-internal and + elmo-folder-open-internal. + (elmo-folder-close-internal): Clean up headers slot. + +2001-04-07 Masahiro MURATA + + * elmo-archive.el (elmo-archive-folder-list-subfolders): Match + exactly folder list. + (elmo-folder-append-messages): Fixed append archive with prefix. + + * elmo-localdir.el (elmo-folder-message-make-temp-files): Fixed + make temp files with start-number. + + * elmo-pipe.el (elmo-folder-message-make-temp-file-p): Fixed typo. + +2001-04-05 Hiroya Murata + + * elmo.el (elmo-folder-list-messages-internal): Fixed lucking optional + argument `visible-only'. + (elmo-generic-folder-append-messages): Fixed condition. Use `unless' + instead of `if'. + + * elmo-pop3.el (elmo-folder-open-internal): Check + `elmo-inhibit-number-mapping' is non-nil. + + * elmo-pipe.el (elmo-folder-status): Fixed. + +2001-04-05 Yuuichi Teranishi + + * elmo.el (elmo-dop-queue-flush): Added autload setting. + + * elmo-shimbun.el (elmo-shimbun-folder): Added `header-hash' slot. + (elmo-folder-open-internal): Setup `header-hash' slot. + (elmo-shimbun-msgdb-create-entity): Use `header-hash' to get header + information. + (elmo-map-message-fetch): Ditto. + +2001-04-04 Yuuichi Teranishi + + * shimbun.el, sb-airs.el, sb-asahi.el, sb-bbdb-ml.el, sb-cnet.el, + sb-fml.el, sb-lump.el, sb-mew.el, sb-mhonarc.el, + sb-netbsd.el, sb-sponichi.el, sb-text.el, sb-wired.el, + sb-xemacs.el, sb-yomiuri.el, sb-zdnet.el, sb-tcup.el: Removed. + + * elmo-util.el (elmo-resque-obsolete-variable): Fix. + +2001-04-03 Yuuichi Teranishi + + * sb-airs.el: Added footer. + + * shimbun.el (shimbun-article): Define as luna-method. + + * sb-tcup.el: New file. + + * sb-airs.el (toplevel): Require 'sb-mhonarc. + (According to the report from ABE Yasushi ) + +2001-04-02 Yuuichi Teranishi + + * sb-asahi.el (shimbun-index-url): Removed redundant '/' in URL string. + (shimbun-get-headers): Ditto. + + * elmo.el: Moved obsolete variable definitions from + elmo-imap4.el, elmo-nntp.el and elmo-pop3.el. + + * sb-asahi.el (shimbun-asahi-groups): Deleted "feneral" and "personal" + groups. + + * shimbun.el: New file. + + * elmo-shimbun.el: New file. + + * sb-airs.el, sb-asahi.el, sb-bbdb-ml.el, sb-cnet.el, + sb-fml.el, sb-lump.el, sb-mew.el, sb-mhonarc.el, + sb-netbsd.el, sb-sponichi.el, sb-text.el, sb-wired.el, + sb-xemacs.el, sb-yomiuri.el, sb-zdnet.el: New files. 2001-03-27 Kenichi OKADA * elmo-imap4.el (elmo-imap4-list-folders): Fixed problem when hierarchy is t. -2001-03-07 TAKAHASHI Kaoru +2001-03-12 Yuuichi Teranishi + + * elmo.el (elmo-folder-msgdb): Define as macro. + (elmo-folder-open): Added argument `load-msgdb'. + (elmo-generic-folder-open): Ditto. + (elmo-folder-encache): New function. + + * elmo-dop.el (elmo-dop-queue): Moved from elmo-dop.el. + + * elmo-net.el (elmo-message-fetch): Check the cache path is non-nil. + + * elmo-msgdb.el (elmo-msgdb-delete-msgs): + Eliminated argument FOLDER and added argument MSGDB. + (elmo-dop-queue-load): Moved from elmo-dop.el. + (elmo-dop-queue-save): Ditto. + + * elmo-map.el (elmo-map-folder-update-locations): Sort by number. + + * elmo-imap4.el (elmo-folder-open): Added argument load-msgdb. + + * elmo-filter.el (elmo-filter-folder-list-unreads-internal): + Use elmo-folder-msgdb instead of elmo-folder-msgdb-internal. + (elmo-filter-folder-list-importants-internal): Ditto. + + * elmo-map.el (elmo-folder-pack-number): Ditto. - * elmo-version.el (elmo-appname): Fixed typo. + * elmo-mime.el (elmo-mime-message-display): Ditto. + + * elmo.el (elmo-generic-folder-commit): Ditto. + (elmo-folder-list-unreads): Ditto. + (elmo-folder-list-importants): Ditto. + (elmo-generic-folder-commit): Ditto. + (elmo-message-set-mark): Ditto. + (elmo-generic-folder-append-msgdb): Ditto. + (elmo-folder-synchronize): Ditto. + (elmo-folder-messages): Ditto. + (elmo-init): Call elmo-dop-queue-load. + (elmo-folder-list-messages): Ditto. + + * elmo-nntp.el (elmo-folder-update-number): Ditto. + (elmo-nntp-folder-process-crosspost): Ditto. + (elmo-folder-list-unreads-internal): Ditto. + + * elmo-dop.el: Removed old functions. + +2001-03-05 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-msgdb-delete-msgs): Changed argument from + `folder' to `msgdb'. + +2001-03-01 Yuuichi Teranishi + + * mmimap.el (mmimap-parse-parameters-from-list): Define as alias for + `mime-decode-parameters' instead of `mime-decode-parameter-plist'. + + * elmo-msgdb.el (elmo-msgdb-search-internal-primitive): Bind + case-fold-search. + +2001-02-28 Yuuichi Teranishi + + * elmo-util.el (elmo-resque-obsolete-variable): Use defvaralias if + defined. + + * mmimap.el (toplevel): Require 'mime-parse and 'static. + (mmimap-parse-parameters-from-list): Define as alias for + `mime-decode-parameter-plist' if it is defined as function. + (mmimap-make-mime-entity): Added argument `number'. + (initialize-instance): Set `number' argument of mmimap-make-mime-entity + as 0. + (mime-imap-entity-header-string): Arrange node-id for rfc2060 section. + + * elmo.el (elmo-folder-have-subfolder-p): New generic function. + + * elmo-mark.el (elmo-folder-have-subfolder-p): Define. + + * elmo-internal.el (elmo-folder-list-subfolders): Rewrite. 2001-02-27 Yuuichi Teranishi - * elmo-imap4.el (elmo-imap4-list-folders): Fixed problem when - elmo-default-imap4-authenticate-type is nil - (Reported by Bun Mizuhara ). + * elmo-maildir.el (elmo-folder-msgdb-create): Fixed. + + * elmo-imap4.el (elmo-folder-initialize): Fixed problem + when elmo-imap4-default-authenticate-type is nil. + (elmo-folder-list-subfolders): Ditto + (According to the reported of Bun Mizuhara ) + (elmo-imap4-fetch-callback-1-subr): Renamed from + `elmo-imap4-fetch-callback-1' and define as inline function. + (elmo-imap4-fetch-callback-1): + Renamed from `elmo-imap4-fetch-callback'. + (elmo-imap4-parse-fetch): Funcall `elmo-imap4-fetch-callback'. + + * elmo-localdir.el (elmo-folder-expand-msgdb-path): Fixed + msgdb path (To keep compatibility with main trunk). + + * elmo-vars.el (elmo-inhibit-number-mapping): New variable. + + * elmo-util.el (elmo-make-file-cache): Moved position of + some macros. + + * elmo-pop3.el (elmo-pop3-inhibit-uidl): Eliminated. + (elmo-pop3-get-session): Use `elmo-inhibit-number-mapping' + instead of `elmo-pop3-inhibit-uidl'. + (elmo-folder-exists-p): Ditto. + (elmo-pop3-folder-list-messages): Ditto. + + * elmo-pipe.el (elmo-pipe-drain): Use `elmo-inhibit-number-mapping' + instead of `elmo-pop3-inhibit-uidl'. + (elmo-folder-status): Ditto. + + * elmo-dop.el (elmo-dop-folder): New variable. + (elmo-dop-lock-message): Eliminated. + (elmo-dop-unlock-message): Ditto. + (elmo-dop-lock-list-load): Ditto. + (elmo-dop-lock-list-save): Ditto. + (elmo-dop-delete-folder): Ditto. + (elmo-dop-rename-folder): Ditto. + + * elmo.el: Removed incomplete commentary. + +2001-02-25 TAKAHASHI Kaoru + + * elmo.el (toplevel): Require 'elmo-version first; + for little `recursive-load-depth' settings. + Fix "ends here" comment. + +2001-02-23 Yuuichi Teranishi + + * elmo-util.el (toplevel): Require 'poem; + Some functions are moved from elmo-cache.el. + + * elmo-net.el (toplevel): Require 'elmo-cache. + + * elmo-msgdb.el (toplevel): Don't require 'elmo-cache. - * elmo-vars.el (elmo-pop3-use-uidl): Moved from `elmo-pop3.el'. - (Adviced by Akihiro MOTOKI ) + * elmo.el (toplevel): Ditto. + + * elmo-cache.el: Rewrite with luna; + Some functions are moved to elmo-util.el. + + * elmo-internal.el (elmo-internal-folder-list): New variable. + (elmo-internal-folder-initialize): Rewrite. + (elmo-folder-list-subfolders): Ditto. + + * elmo-cache.el (elmo-cache-search-all): Eliminated. + (elmo-cache-collect-sub-directories): Ditto. 2001-02-22 Yuuichi Teranishi * elmo-version.el (elmo-version): Up to 2.5.8. - * elmo2.el (elmo-msgdb-list-messages-mark-match): New function. + * elmo.el (elmo-folder-list-messages-mark-match): New function. * elmo-util.el (elmo-list-insert): New function. -2001-02-21 OKAZAKI Tetsurou +2001-02-21 Yuuichi Teranishi - * elmo-util.el (elmo-display-progress): Prefer - `progress-feedback-with-label' to `lprogress-display'. + * elmo.el (elmo-init): New function. + (elmo-quit): Call `elmo-crosspost-message-alist-save'. + + * elmo-vars.el (elmo-msgdb-file-header-chop-length): New variable + (Renamed from `elmo-localdir-header-chop-length'). + + * elmo-pop3.el (elmo-pop3-use-cache, + elmo-pop3-send-command-synchronously): Moved from `elmo-vars.el'. + + * elmo-nntp.el (elmo-message-fetch): Define. + (elmo-message-fetch-unplugged): Ditto. + (elmo-nntp-overview-fetch-chop-length): Moved from `elmo-vars.el'. + (elmo-nntp-use-cache): Ditto. + (elmo-nntp-max-number-precedes-list-active): Ditto. + + * elmo-multi.el (elmo-multi-divide-number): Moved from `elmo-vars.el'. + + * elmo-msgdb.el (elmo-localdir-insert-header): Renamed to + `elmo-msgdb-insert-file-header'. + Use `elmo-msgdb-file-header-chop-length'. + + * elmo-localdir.el (elmo-localdir-lockfile-list): Moved from + `elmo-vars.el'. + + * elmo-cache.el (elmo-cache-insert-header): Eliminated. + (elmo-cache-msgdb-create-overview-entity-from-file): Use + `elmo-msgdb-insert-file-header'. + + * elmo-imap4.el, elmo-nntp.el, elmo-pop3.el: + Use new variable; + Define obsolete variables with `elmo-define-obsolete-variable', + + * elmo-util.el (elmo-warning-buffer-name): New constant. + (elmo-warning): New function. + (elmo-obsolete-variable-alist): New variable. + (elmo-obsolete-variable-show-warnings): New variable. + (elmo-define-obsolete-variable): New function. + (elmo-resque-obsolete-variable): Ditto. + (elmo-resque-obsolete-variables): Ditto. + +2001-02-20 Yuuichi Teranishi + + * elmo-vars.el (elmo-use-buffer-cache, elmo-buffer-cache-size): + Eliminated. + + * elmo-pop3.el, elmo-nntp.el: Use custom. 2000-02-20 Kenichi OKADA * elmo-imap4.el (elmo-network-authenticate-session): Fix. * elmo-pop3.el (elmo-network-authenticate-session): Add comments. +2001-02-20 Yuuichi Teranishi + + * Luna-fy Kenichi OKADA's following changes. + * elmo.el (elmo-folder-list-messages-internal): Added optional argument + `nohide'. + (elmo-folder-synchronize): Changed meaning of argument `ignore-msgdb'. + +2001-02-21 OKAZAKI Tetsurou + + * elmo-util.el (elmo-display-progress): Prefer + `progress-feedback-with-label' to `lprogress-display'. + 2000-02-20 Kenichi OKADA * elmo-imap4.el (elmo-imap4-list-folder): Added 'uid' @@ -139,63 +744,224 @@ * elmo-msgdb.el (elmo-msgdb-max-of-killed): New function. * elmo-imap4.el (elmo-imap4-list-folder): Use killed-list. +2001-02-20 Yuuichi Teranishi + + * elmo.el (elmo-folder-process-crosspost): New generic method. + (elmo-folder-writable-p): Ditto. + (elmo-folder-message-appendable-p): Eliminated. + (elmo-generic-folder-append-msgdb): Rewrite. + (elmo-newsgroups-hashtb): New internal variable. + (elmo-crosspost-message-set): Eliminated. + (elmo-crosspost-message-delete): Ditto. + (elmo-setup-subscribed-newsgroups): New function. + (elmo-crosspost-message-alist-modified): New internal variable. + (elmo-crosspost-message-alist-load): New function (Renamed from + `wl-crosspost-alist-load'). + (elmo-crosspost-message-alist-save): Ditto (Renamed from + `wl-crosspost-alist-save'). + + * elmo-util.el (elmo-parse): New function (Renamed from `wl-parse'). + + * elmo-nntp.el (elmo-nntp-folder): New slots `temp-crosses' and + `unreads'. + (elmo-nntp-groups-hashtb): Eliminated (Renamed to + elmo-newsgroups-hashtb). + (elmo-nntp-message-fetch): Call `elmo-nntp-setup-crosspost-buffer', + `elmo-nntp-folder-update-crosspost-message-alist'. + (elmo-nntp-get-folders-info): Use `elmo-newsgroups-hashtb' instead of + `elmo-nntp-groups-hashtb'. + (elmo-nntp-make-groups-hashtb): Eliminated. + (elmo-nntp-parse-newsgroups): New function (Renamed from + `wl-parse-newsgroups'). + (elmo-folder-creatable-p, elmo-folder-writable-p, + elmo-folder-close-internal, elmo-folder-mark-as-read, + elmo-folder-process-crosspost, elmo-folder-list-unreads-internal): + Define. + (elmo-nntp-folder-update-crosspost-message-alist): New function. + + * elmo-net.el (elmo-message-fetch): Check buffer size. + + * elmo-multi.el (elmo-multi-split-number-alist): New function. + + * elmo-localdir.el (elmo-folder-append-buffer): Fixed logic. + + * elmo-imap4.el (elmo-folder-rename-internal): Send `select' command + before `close' command. + + * elmo.el (elmo-folder-list-unreads-internal): Added argument + `mark-alist' (All other related portions are changed). + +2001-02-13 Yuuichi Teranishi + + * elmo-util.el (elmo-create-hash-size): Eliminated. + (elmo-make-hash) Make a hash with `one less than a power of two' + length. + + * elmo-vars.el (elmo-hash-minimum-size): New variable. + (elmo-hash-maximum-size): Changed value. + +2001-02-09 Yuuichi Teranishi + + * elmo-mime.el (elmo-mime-message-display): Added argument `unread'. + (elmo-mime-message-display-as-is): Ditto. + +2001-02-07 Yuuichi Teranishi + + * elmo-pipe.el (elmo-pipe-drain): Eliminated needless bindings; + Use `elmo-folder-close-internal' instead of `elmo-folder-close'. + +2001-02-06 Yuuichi Teranishi + + * elmo-mark.el: New file. + + * elmo-internal.el: Rewrite (Almost empty). + +2001-02-05 Yuuichi Teranishi + + * mmimap.el (mmimap-make-mime-entity): Consider message/rfc822. + (mime-imap-entity-header-string): Ditto. + (mmimap-entity-section): Rewrite. + +2001-01-30 Yuuichi Teranishi + + * elmo-nmz.el: New file. + + * elmo-pipe.el: Rewrite with luna. + +2001-01-29 Yuuichi Teranishi + + * elmo-archive.el: Rewrite with luna. + + * elmo-multi.el (elmo-folder-list-unreads-internal): Fixed. + (elmo-folder-list-importants-internal): Ditto. + +2001-01-24 Yuuichi Teranishi + + * elmo-archive.el (elmo-archive-version): Abolish. + (toplevel) Removed `boso' comment. + +2001-01-23 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-msgdb-add-msgs-to-seen-list): Renamed from + elmo-msgdb-add-msgs-to-seen-list-subr; + Changed argument seen-marks to unread-marks. + + * elmo-nntp.el: Rewrite with luna. + +2001-01-22 Yuuichi Teranishi + + * elmo-filter.el: Rewrite with luna. + +2001-01-18 Yuuichi Teranishi + + * elmo-pop3.el: Rewrite with luna. + +2001-01-17 Yuuichi Teranishi + + * elmo-multi.el: Rewrite with luna. + + * elmo-vars.el (elmo-use-killed-list): Abolish. + All other related portions are changed. + (elmo-filename-replace-string-alist): Renamed from + elmo-msgid-replace-string-alist. + +2001-01-16 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-msgdb-delete-msgs): Changed argument. + + * elmo-map.el: New file. + * elmo-maildir.el: Rewrite with luna. + +2001-01-14 Yuuichi Teranishi + + * elmo.el: Changed meaning of `elmo-folder-commit'. + * elmo-mime.el (elmo-mime-display-as-is-internal): New function. + +2001-01-07 Yuuichi Teranishi + + * elmo.el (elmo-folder-append-buffer): New function. + (Renamed from `elmo-append-msg') + +2000-12-18 Yuuichi Teranishi + + * elmo-mime.el: New file. + +2000-12-14 Yuuichi Teranishi + + * elmo-cache.el: Rewrite. + 2000-02-17 Kenichi OKADA * elmo-pop3.el (elmo-network-authenticate-session): Bind `sasl-mechanisms' -2001-02-16 Yuuichi Teranishi +2000-12-08 Yuuichi Teranishi - * elmo-msgdb.el (elmo-msgdb-rename-path): Fix. + * elmo-vars.el (elmo): New group. + (elmo-strict-diff-folder-regexp): New variable. - * elmo-imap4.el (elmo-imap4-rename-folder): Send select command - before rename command. + * elmo-util.el (elmo-call-func): Abolish. + (elmo-folder-get-type): Ditto. + (elmo-*-get-spec): Ditto. + (elmo-*-spec-*): Ditto. + (elmo-imap4-identical-name-space-p): Ditto. + (elmo-folder-identical-system-p): Ditto. + (elmo-folder-direct-copy-alist): Ditto. + (elmo-folder-direct-copy-p): Ditto. -2001-02-14 Yuuichi Teranishi + * elmo-pipe.el (elmo-pipe-folder): New luna class. + (elmo-folder-initialize): Define. + (elmo-folder-get-primitive-list): Ditto. - * elmo2.el (elmo-buffer-cache-message): Added argument `unread'. + * elmo-nntp.el (elmo-nntp-folder): New luna class. + (elmo-folder-initialize): Define. + Renamed `elmo-network-session-host-internal' to + `elmo-network-session-server-internal'. -2001-02-13 OKAZAKI Tetsurou + * elmo-multi.el (elmo-multi-folder): New luna class. + (elmo-folder-initialize): Define. + (elmo-folder-get-primitive-list): Ditto. + (elmo-folder-contains-type): Ditto. + (elmo-message-use-cache-p): Ditto. - * elmo-imap4.el (elmo-imap4-prefetch-msg): Set `msgdb' - argument of `elmo-imap4-read-msg' as nil. + * elmo-msgdb.el (elmo-msgdb-expand-path): Abolish. + Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path'. -2001-02-13 Yuuichi Teranishi + * elmo-maildir.el (elmo-maildir-folder): New luna class. + (elmo-folder-initialize): Define. - * elmo2.el (elmo-prefetch-msg): Set `unread' argument of - `elmo-read-msg' as 'unread. - (elmo-read-msg-with-cache): Set `msgdb' argument as nil. - - * elmo-archive.el (elmo-archive-read-msg): Fixed arguments. - * elmo-cache.el (elmo-cache-read-msg): Ditto. - * elmo-filter.el (elmo-filter-read-msg): Ditto. - * elmo-imap4.el (elmo-imap4-read-msg): Ditto. - * elmo-internal.el (elmo-internal-read-msg): Ditto. - * elmo-localdir.el (elmo-localdir-read-msg): Ditto. - * elmo-localnews.el (elmo-localnews-read-msg): Ditto. - * elmo-maildir.el (elmo-maildir-read-msg): Ditto. - * elmo-multi.el (elmo-multi-read-msg): Ditto. - * elmo-nntp.el (elmo-nntp-read-msg): Ditto. - * elmo-pipe.el (elmo-pipe-read-msg): Ditto. - * elmo-pop3.el (elmo-pop3-read-msg): Ditto. + * elmo-filter.el (elmo-filter-folder): New luna class. + (elmo-folder-initialize): Define. + (elmo-folder-get-primitive-list): Ditto. + (elmo-folder-contains-type): Ditto. -2001-02-09 Yuuichi Teranishi +2000-12-06 Yuuichi Teranishi - * elmo2.el (elmo-buffer-cache-message): Call `elmo-read-msg' with - argument `unread' as non-nil. - (elmo-read-msg-with-cache): Added argument `unread'. - (elmo-read-msg-no-cache): Ditto. - (elmo-read-msg): Ditto. + * elmo-imap4.el: Rewrite with luna. -2001-02-07 Yuuichi Teranishi + * mmimap.el: New file. + + * mmelmo.el, mmelmo-imap4.el: Removed. + + * elmo-net.el: Ditto. + + * elmo-pop3.el (elmo-pop3-folder): New luna class. + (elmo-folder-initialize): Define. - * elmo-pipe.el (elmo-pipe-drain): Bind `elmo-inhibit-read-cache' as t - while moving messages. + * elmo-archive.el (elmo-archive-folder): New luna class. + (elmo-folder-initialize): Define. - * elmo2.el (elmo-read-msg): Don't use cache if - `elmo-inhibit-read-cache' is non-nil. + * elmo-dop.el: Rename `elmo-msgdb-expand-path' to + `elmo-folder-msgdb-path'. + (elmo-dop-queue-append): Use `elmo-folder-name-internal' and + `elmo-make-folder'. - * elmo-vars.el (elmo-inhibit-read-cache): New global switch. +2000-12-06 Yuuichi Teranishi + * elmo.el: New file. + + * elmo2.el: Renamed to elmo.el. + + 2001-02-01 OKAZAKI Tetsurou * elmo-cache.el (elmo-cache-expire-by-size): Count diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index cd227b2..e6b768e 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -29,7 +29,6 @@ ;;; Commentary: ;; ;; TODO: -;; [¥Ü¥½] append-msgs() ¤¬Íߤ·¤¤¡Ê¤±¤É multi-refile ÉԲġˡ£ ;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£ ;;; Code: @@ -40,9 +39,6 @@ (require 'std11) (eval-when-compile (require 'elmo-localdir)) -;;; Const -(defconst elmo-archive-version "v0.18 [990729/alpha]") - ;;; User vars. (defvar elmo-archive-lha-dos-compatible (memq system-type '(OS/2 emx windows-nt)) @@ -75,6 +71,53 @@ (defvar elmo-archive-treat-file nil "*Treat archive folder as a file if non-nil.") +;;; User variables for elmo-archive. +(defvar elmo-archive-default-type 'zip + "*Default archiver type. The value must be a symbol.") + +(defvar elmo-archive-use-cache nil + "Use cache in archive folder.") + +;;; ELMO Local directory folder +(eval-and-compile + (luna-define-class elmo-archive-folder (elmo-folder) + (archive-name archive-type archive-prefix)) + (luna-define-internal-accessors 'elmo-archive-folder)) + +(luna-define-method elmo-folder-initialize ((folder + elmo-archive-folder) + name) + (when (string-match + "^\\([^;]*\\);?\\([^;]*\\);?\\([^;]*\\)$" + name) + ;; Drive letter is OK! + (or (elmo-archive-folder-set-archive-name-internal + folder (elmo-match-string 1 name)) + (elmo-archive-folder-set-archive-name-internal + folder "")) + (or (elmo-archive-folder-set-archive-type-internal + folder (intern-soft (elmo-match-string 2 name))) + (elmo-archive-folder-set-archive-type-internal + folder elmo-archive-default-type)) + (or (elmo-archive-folder-set-archive-prefix-internal + folder (elmo-match-string 3 name)) + (elmo-archive-folder-set-archive-prefix-internal + folder ""))) + folder) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-archive-folder)) + ;; For compatibility + (expand-file-name + (elmo-replace-string-as-filename + (elmo-folder-name-internal folder)) + (expand-file-name (concat (symbol-name (elmo-folder-type-internal folder)) + "/" + (symbol-name + (elmo-archive-folder-archive-type-internal + folder))) + elmo-msgdb-dir))) + ;;; MMDF parser -- info-zip agent w/ REXX (defvar elmo-mmdf-delimiter "^\01\01\01\01$" "*Regular expression of MMDF delimiter.") @@ -235,38 +278,35 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Scan Folder -(defsubst elmo-archive-list-folder-subr (spec &optional nonsort) +(defsubst elmo-archive-list-folder-subr (folder &optional nonsort) "*Returns list of number-file(int, not string) in archive FILE. TYPE specifies the archiver's symbol." - (let* ((type (nth 2 spec)) - (prefix (nth 3 spec)) - (file (elmo-archive-get-archive-name (nth 1 spec) type spec)) + (let* ((type (elmo-archive-folder-archive-type-internal folder)) + (prefix (elmo-archive-folder-archive-prefix-internal folder)) + (file (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'ls)) (args (list file)) (file-regexp (format (elmo-archive-get-regexp type) (elmo-concat-path (regexp-quote prefix) ""))) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) + (killed (elmo-folder-killed-list-internal folder)) numbers buf file-list header-end) - (when (file-exists-p file) - (save-excursion - (set-buffer (setq buf (get-buffer-create " *ELMO ARCHIVE ls*"))) - (unless (elmo-archive-call-method method args t) - (error "%s exited abnormally!" method)) - (goto-char (point-min)) - (when (re-search-forward elmo-archive-header-regexp nil t) - (forward-line 1) - (setq header-end (point)) + (if (file-exists-p file) + (with-temp-buffer + (unless (elmo-archive-call-method method args t) + (error "%s exited abnormally!" method)) + (goto-char (point-min)) (when (re-search-forward elmo-archive-header-regexp nil t) + (forward-line 1) + (setq header-end (point)) + (when (re-search-forward elmo-archive-header-regexp nil t) (beginning-of-line) (narrow-to-region header-end (point)) (goto-char (point-min)))) - (while (and (re-search-forward file-regexp nil t) - (not (eobp))) ; for GNU tar 981010 - (setq file-list (nconc file-list (list (string-to-int - (match-string 1)))))) - (kill-buffer buf))) + (while (and (re-search-forward file-regexp nil t) + (not (eobp))) ; for GNU tar 981010 + (setq file-list (nconc file-list (list (string-to-int + (match-string 1))))))) + (error "%s does not exist." file)) (if nonsort (cons (or (elmo-max-of-list file-list) 0) (if killed @@ -276,37 +316,46 @@ TYPE specifies the archiver's symbol." (setq numbers (sort file-list '<)) (elmo-living-messages numbers killed)))) -(defun elmo-archive-list-folder (spec &optional nohide) - (elmo-archive-list-folder-subr spec)) - -(defun elmo-archive-max-of-folder (spec) - (elmo-archive-list-folder-subr spec t)) +(luna-define-method elmo-folder-list-messages-internal ((folder + elmo-archive-folder) + &optional nohide) + (elmo-archive-list-folder-subr folder)) +(luna-define-method elmo-folder-status ((folder elmo-archive-folder)) + (elmo-archive-list-folder-subr folder t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Folder related functions -(defsubst elmo-archive-get-archive-directory (name) +(defsubst elmo-archive-get-archive-directory (folder) ;; allow fullpath. return format is "/foo/bar/". - (if (file-name-absolute-p name) - (if (find-file-name-handler name 'copy-file) - name - (expand-file-name name)) - (expand-file-name name elmo-archive-folder-path))) - -(defun elmo-archive-get-archive-name (folder type &optional spec) + (if (file-name-absolute-p (elmo-archive-folder-archive-name-internal folder)) + (if (find-file-name-handler + (elmo-archive-folder-archive-name-internal folder) + 'copy-file) + (elmo-archive-folder-archive-name-internal folder) + (expand-file-name (elmo-archive-folder-archive-name-internal folder))) + (expand-file-name (elmo-archive-folder-archive-name-internal folder) + elmo-archive-folder-path))) + +(defun elmo-archive-get-archive-name (folder) (let ((dir (elmo-archive-get-archive-directory folder)) - (suffix (elmo-archive-get-suffix type)) + (suffix (elmo-archive-get-suffix + (elmo-archive-folder-archive-type-internal + folder))) filename dbdir) (if elmo-archive-treat-file - (if (string-match (concat (regexp-quote suffix) "$") folder) - (expand-file-name - folder - elmo-archive-folder-path) - (expand-file-name - (concat folder suffix) - elmo-archive-folder-path)) - (if (and (let ((handler (find-file-name-handler dir 'copy-file))) ; dir is local. + (if (string-match (concat (regexp-quote suffix) "$") + (elmo-archive-folder-archive-name-internal folder)) + (expand-file-name (elmo-archive-folder-archive-name-internal + folder) + elmo-archive-folder-path) + (expand-file-name (concat (elmo-archive-folder-archive-name-internal + folder) + suffix) + elmo-archive-folder-path)) + (if (and (let ((handler + (find-file-name-handler dir 'copy-file))) ; dir is local. (or (not handler) (if (featurep 'xemacs) (eq handler 'dired-handler-fn)))) @@ -316,12 +365,12 @@ TYPE specifies the archiver's symbol." (concat elmo-archive-basename suffix) dir) ;; for full-path specification. - (if (and (find-file-name-handler dir 'copy-file) ; ange-ftp, efs - spec) + (if (find-file-name-handler dir 'copy-file) ; ange-ftp, efs (progn (setq filename (expand-file-name (concat elmo-archive-basename suffix) - (setq dbdir (elmo-msgdb-expand-path spec)))) + (setq dbdir + (elmo-folder-msgdb-path folder)))) (if (file-directory-p dbdir) (); ok. (if (file-exists-p dbdir) @@ -338,18 +387,17 @@ TYPE specifies the archiver's symbol." filename) dir))))) -(defun elmo-archive-folder-exists-p (spec) - (file-exists-p - (elmo-archive-get-archive-name (nth 1 spec) (nth 2 spec) spec))) +(luna-define-method elmo-folder-exists-p ((folder elmo-archive-folder)) + (file-exists-p (elmo-archive-get-archive-name folder))) -(defun elmo-archive-folder-creatable-p (spec) +(luna-define-method elmo-folder-creatable-p ((folder elmo-archive-folder)) t) -(defun elmo-archive-create-folder (spec) +(luna-define-method elmo-folder-create ((folder elmo-archive-folder)) (let* ((dir (directory-file-name ; remove tail slash. - (elmo-archive-get-archive-directory (nth 1 spec)))) - (type (nth 2 spec)) - (arc (elmo-archive-get-archive-name (nth 1 spec) type))) + (elmo-archive-get-archive-directory folder))) + (type (elmo-archive-folder-archive-type-internal folder)) + (arc (elmo-archive-get-archive-name folder))) (if elmo-archive-treat-file (setq dir (directory-file-name (file-name-directory dir)))) (cond ((and (file-exists-p dir) @@ -359,16 +407,16 @@ TYPE specifies the archiver's symbol." ((file-directory-p dir) (if (file-exists-p arc) t ; return value - (elmo-archive-create-file arc type spec))) + (elmo-archive-create-file arc type folder))) (t (elmo-make-directory dir) - (elmo-archive-create-file arc type spec) + (elmo-archive-create-file arc type folder) t)))) -(defun elmo-archive-create-file (archive type spec) +(defun elmo-archive-create-file (archive type folder) (save-excursion (let* ((tmp-dir (directory-file-name - (elmo-msgdb-expand-path spec))) + (elmo-folder-msgdb-path folder))) (dummy elmo-archive-dummy-file) (method (or (elmo-archive-get-method type 'create) (elmo-archive-get-method type 'mv))) @@ -393,20 +441,23 @@ TYPE specifies the archiver's symbol." (delete-file dummy))) )))) -(defun elmo-archive-delete-folder (spec) - (let* ((arc (elmo-archive-get-archive-name (nth 1 spec) (nth 2 spec)))) +(luna-define-method elmo-folder-delete ((folder elmo-archive-folder)) + (let ((arc (elmo-archive-get-archive-name folder))) (if (not (file-exists-p arc)) (error "No such file: %s" arc) (delete-file arc) t))) -(defun elmo-archive-rename-folder (old-spec new-spec) - (let* ((old-arc (elmo-archive-get-archive-name - (nth 1 old-spec) (nth 2 old-spec))) - (new-arc (elmo-archive-get-archive-name - (nth 1 new-spec) (nth 2 new-spec)))) - (unless (and (eq (nth 2 old-spec) (nth 2 new-spec)) - (equal (nth 3 old-spec) (nth 3 new-spec))) +(luna-define-method elmo-folder-rename-internal ((folder elmo-archive-folder) + new-folder) + (let* ((old-arc (elmo-archive-get-archive-name folder)) + (new-arc (elmo-archive-get-archive-name new-folder))) + (unless (and (eq (elmo-archive-folder-archive-type-internal folder) + (elmo-archive-folder-archive-type-internal new-folder)) + (equal (elmo-archive-folder-archive-prefix-internal + folder) + (elmo-archive-folder-archive-prefix-internal + new-folder))) (error "Not same archive type and prefix")) (if (not (file-exists-p old-arc)) (error "No such file: %s" old-arc) @@ -415,85 +466,106 @@ TYPE specifies the archiver's symbol." (rename-file old-arc new-arc) t)))) -(defun elmo-archive-list-folders (spec &optional hierarchy) - (let ((folder (concat "$" (nth 1 spec))) - (elmo-localdir-folder-path elmo-archive-folder-path)) - (if elmo-archive-treat-file - (let* ((path (elmo-localdir-get-folder-directory spec)) - (base-folder (or (nth 1 spec) "")) - (suffix (nth 2 spec)) - (prefix (if (string= (nth 3 spec) "") - "" (concat ";" (nth 3 spec)))) - (dir (if (file-directory-p path) - path (file-name-directory path))) - (name (if (file-directory-p path) - "" (file-name-nondirectory path))) - (flist (and (file-directory-p dir) - (directory-files dir nil name nil))) - (regexp (format "^\\(.*\\)\\(%s\\)$" - (mapconcat - '(lambda (x) (regexp-quote (cdr x))) - elmo-archive-suffix-alist - "\\|")))) - (if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'. - (setq base-folder (elmo-match-string 1 base-folder)) - (unless (file-directory-p path) - (setq base-folder (or (file-name-directory base-folder) - base-folder)))) - (delq - nil - (mapcar - '(lambda (x) - (when (and (string-match regexp x) - (eq suffix - (car - (rassoc (elmo-match-string 2 x) - elmo-archive-suffix-alist)))) - (format "$%s;%s%s" - (elmo-concat-path base-folder (elmo-match-string 1 x)) - suffix prefix))) - flist))) - (elmo-localdir-list-folders-subr folder hierarchy)))) - +(defun elmo-archive-folder-list-subfolders (folder one-level) + (if elmo-archive-treat-file + (let* ((path (elmo-archive-get-archive-directory folder)) + (base-folder (or (elmo-archive-folder-archive-name-internal + folder) + "")) + (suffix (elmo-archive-folder-archive-type-internal folder)) + (prefix (if (string= + (elmo-archive-folder-archive-prefix-internal folder) + "") + "" + (concat ";" + (elmo-archive-folder-archive-prefix-internal + folder)))) + (dir (if (file-directory-p path) + path (file-name-directory path))) + (name (if (file-directory-p path) + "" (file-name-nondirectory path))) + (flist (and (file-directory-p dir) + (directory-files dir nil + (concat "^" name "[^A-z][^A-z]") + nil))) + (regexp (format "^\\(.*\\)\\(%s\\)$" + (mapconcat + '(lambda (x) (regexp-quote (cdr x))) + elmo-archive-suffix-alist + "\\|")))) + (if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'. + (setq base-folder (elmo-match-string 1 base-folder)) + (unless (file-directory-p path) + (setq base-folder (or (file-name-directory base-folder) "")))) + (delq + nil + (mapcar + '(lambda (x) + (when (and (string-match regexp x) + (eq suffix + (car + (rassoc (elmo-match-string 2 x) + elmo-archive-suffix-alist)))) + (format "%s%s;%s%s" + (elmo-folder-prefix-internal folder) + (elmo-concat-path base-folder (elmo-match-string 1 x)) + suffix prefix))) + flist))) + (elmo-mapcar-list-of-list + (function (lambda (x) (concat (elmo-folder-prefix-internal folder) x))) + (elmo-list-subdirectories + (elmo-archive-get-archive-directory folder) + "" + one-level)))) + +(luna-define-method elmo-folder-list-subfolders ((folder elmo-archive-folder) + &optional one-level) + (elmo-archive-folder-list-subfolders folder one-level)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Article file related functions ;;; read(extract) / append(move) / delete(delete) / query(list) -(defun elmo-archive-read-msg (spec number outbuf &optional msgdb unread) - (save-excursion - (let* ((type (nth 2 spec)) - (arc (elmo-archive-get-archive-name (nth 1 spec) type spec)) - (prefix (nth 3 spec)) - (method (elmo-archive-get-method type 'cat)) - (args (list arc (elmo-concat-path - prefix (int-to-string number))))) - (set-buffer outbuf) - (erase-buffer) - (when (file-exists-p arc) - (and - (as-binary-process - (elmo-archive-call-method method args t)) - (elmo-delete-cr-get-content-type)))))) +(defsubst elmo-archive-message-fetch-internal (folder number) + (let* ((type (elmo-archive-folder-archive-type-internal folder)) + (arc (elmo-archive-get-archive-name folder)) + (prefix (elmo-archive-folder-archive-prefix-internal folder)) + (method (elmo-archive-get-method type 'cat)) + (args (list arc (elmo-concat-path + prefix (int-to-string number))))) + (when (file-exists-p arc) + (and + (as-binary-process + (elmo-archive-call-method method args t)) + (elmo-delete-cr-buffer))))) + +(luna-define-method elmo-message-fetch-internal ((folder elmo-archive-folder) + number strategy + &optional section unseen) + (elmo-archive-message-fetch-internal folder number)) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-archive-folder) + unread &optional number) + (elmo-archive-folder-append-buffer folder unread number)) ;; verrrrrry slow!! -(defun elmo-archive-append-msg (spec string &optional msg no-see) - (let* ((type (nth 2 spec)) - (prefix (nth 3 spec)) - (arc (elmo-archive-get-archive-name (nth 1 spec) type)) +(defun elmo-archive-folder-append-buffer (folder unread number) + (let* ((type (elmo-archive-folder-archive-type-internal folder)) + (prefix (elmo-archive-folder-archive-prefix-internal folder)) + (arc (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'mv)) - (tmp-buffer (get-buffer-create " *ELMO ARCHIVE mv*")) - (next-num (or msg + (next-num (or number (1+ (if (file-exists-p arc) - (car (elmo-archive-max-of-folder spec)) 0)))) - (tmp-dir (elmo-msgdb-expand-path spec)) + (car + (elmo-folder-status folder)) 0)))) + (tmp-dir (elmo-folder-msgdb-path folder)) + (src-buffer (current-buffer)) + dst-buffer newfile) (when (null method) (ding) (error "WARNING: read-only mode: %s (method undefined)" type)) - (save-excursion - (set-buffer tmp-buffer) - (erase-buffer) + (with-temp-buffer (let ((tmp-dir (expand-file-name prefix tmp-dir))) (when (not (file-directory-p tmp-dir)) (elmo-make-directory (directory-file-name tmp-dir)))) @@ -506,153 +578,178 @@ TYPE specifies the archiver's symbol." (if (and (or (functionp method) (car method)) (file-writable-p newfile)) (progn - (insert string) + (setq dst-buffer (current-buffer)) + (with-current-buffer src-buffer + (copy-to-buffer dst-buffer (point-min) (point-max))) (as-binary-output-file (write-region (point-min) (point-max) newfile nil 'no-msg)) (elmo-archive-call-method method (list arc newfile))) - nil)) - (kill-buffer tmp-buffer))))) - -;; (localdir, maildir, localnews, archive) -> archive -(defun elmo-archive-copy-msgs (dst-spec msgs src-spec - &optional loc-alist same-number) - (let* ((dst-type (nth 2 dst-spec)) - (arc (elmo-archive-get-archive-name (nth 1 dst-spec) dst-type)) - (prefix (nth 3 dst-spec)) - (p-method (elmo-archive-get-method dst-type 'mv-pipe)) - (n-method (elmo-archive-get-method dst-type 'mv)) - (new (unless same-number - (1+ (car (elmo-archive-max-of-folder dst-spec))))) - (src-dir (elmo-localdir-get-folder-directory src-spec)) - (tmp-dir - (file-name-as-directory (elmo-msgdb-expand-path dst-spec))) - (do-link t) - src tmp newfile tmp-msgs) - (when (not (elmo-archive-folder-exists-p dst-spec)) - (elmo-archive-create-folder dst-spec)) + nil)))))) + +(luna-define-method elmo-folder-append-messages :around + ((folder elmo-archive-folder) src-folder numbers unread-marks + &optional same-number) + (let ((prefix (elmo-archive-folder-archive-prefix-internal folder))) + (cond + ((and same-number + (null prefix) + (elmo-folder-message-file-p src-folder) + (elmo-folder-message-file-number-p src-folder)) + ;; same-number(localdir, localnews) -> archive + (elmo-archive-append-files folder + (elmo-folder-message-file-directory src-folder) + numbers) + numbers) + ((elmo-folder-message-make-temp-file-p src-folder) + ;; not-same-number (localdir, localnews), (archive maildir) -> archive + (let ((temp-dir (elmo-folder-message-make-temp-files + src-folder + numbers + (unless same-number + (1+ (if (file-exists-p (elmo-archive-get-archive-name + folder)) + (car (elmo-folder-status folder)) 0))))) + new-dir base-dir files) + (setq base-dir temp-dir) + (when (> (length prefix) 0) + (when (file-name-directory prefix) + (elmo-make-directory (file-name-directory prefix))) + (rename-file + temp-dir + (setq new-dir + (expand-file-name + prefix + ;; parent of temp-dir..(works in windows?) + (expand-file-name ".." temp-dir)))) + ;; now temp-dir has name prefix. + (setq temp-dir new-dir) + ;; parent of prefix becomes base-dir. + (setq base-dir (expand-file-name ".." temp-dir))) + (setq files + (mapcar + '(lambda (x) (elmo-concat-path prefix x)) + (directory-files temp-dir nil "^[^\\.]"))) + (if (elmo-archive-append-files folder + base-dir + files) + (elmo-delete-directory temp-dir))) + numbers) + (t (luna-call-next-method))))) + +(luna-define-method elmo-folder-message-make-temp-file-p + ((folder elmo-archive-folder)) + (let ((type (elmo-archive-folder-archive-type-internal folder))) + (or (elmo-archive-get-method type 'ext-pipe) + (elmo-archive-get-method type 'ext)))) + +(luna-define-method elmo-folder-message-make-temp-files + ((folder elmo-archive-folder) numbers + &optional start-number) + (elmo-archive-folder-message-make-temp-files folder numbers start-number)) + +(defun elmo-archive-folder-message-make-temp-files (folder + numbers + start-number) + (let* ((tmp-dir-src (elmo-folder-make-temp-dir folder)) + (tmp-dir-dst (elmo-folder-make-temp-dir folder)) + (arc (elmo-archive-get-archive-name folder)) + (type (elmo-archive-folder-archive-type-internal folder)) + (prefix (elmo-archive-folder-archive-prefix-internal folder)) + (p-method (elmo-archive-get-method type 'ext-pipe)) + (n-method (elmo-archive-get-method type 'ext)) + (tmp-msgs (mapcar (lambda (x) (elmo-concat-path + prefix + (int-to-string x))) numbers)) + number) + ;; Expand files in the tmp-dir-src. + (elmo-bind-directory + tmp-dir-src + (cond + ((functionp n-method) + (funcall n-method (cons arc tmp-msgs))) + (p-method + (let ((p-prog (car p-method)) + (p-prog-arg (cdr p-method))) + (elmo-archive-exec-msgs-subr1 + p-prog (append p-prog-arg (list arc)) tmp-msgs))) + (t + (let ((n-prog (car n-method)) + (n-prog-arg (cdr n-method))) + (elmo-archive-exec-msgs-subr2 + n-prog (append n-prog-arg (list arc)) tmp-msgs + (length arc)))))) + ;; Move files to the tmp-dir-dst. + (setq number start-number) + (dolist (tmp-file tmp-msgs) + (rename-file (expand-file-name + tmp-file + tmp-dir-src) + (expand-file-name + (if start-number + (int-to-string number) + (file-name-nondirectory tmp-file)) + tmp-dir-dst)) + (if start-number (incf number))) + ;; Remove tmp-dir-src. + (elmo-delete-directory tmp-dir-src) + ;; tmp-dir-dst is the return directory. + tmp-dir-dst)) + +(defun elmo-archive-append-files (folder dir &optional files) + (let* ((dst-type (elmo-archive-folder-archive-type-internal folder)) + (arc (elmo-archive-get-archive-name folder)) + (prefix (elmo-archive-folder-archive-prefix-internal folder)) + (p-method (elmo-archive-get-method dst-type 'cp-pipe)) + (n-method (elmo-archive-get-method dst-type 'cp)) + src tmp newfile) + (unless (elmo-folder-exists-p folder) (elmo-folder-create folder)) + (unless files (setq files (directory-files dir nil "^[^\\.]"))) (when (null (or p-method n-method)) (ding) (error "WARNING: read-only mode: %s (method undefined)" dst-type)) - (when (and same-number - (not (eq (car src-spec) 'maildir)) - (string-match (concat prefix "$") src-dir) - (or - (elmo-archive-get-method dst-type 'cp-pipe) - (elmo-archive-get-method dst-type 'cp))) - (setq tmp-dir (substring src-dir 0 (match-beginning 0))) - (setq p-method (elmo-archive-get-method dst-type 'cp-pipe) - n-method (elmo-archive-get-method dst-type 'cp)) - (setq tmp-msgs (mapcar '(lambda (x) - (elmo-concat-path prefix (int-to-string x))) - msgs)) - (setq do-link nil)) - (when do-link - (let ((tmp-dir (expand-file-name prefix tmp-dir))) - (when (not (file-directory-p tmp-dir)) - (elmo-make-directory (directory-file-name tmp-dir)))) - (while msgs - (setq newfile (elmo-concat-path prefix (int-to-string - (if same-number - (car msgs) - new)))) - (setq tmp-msgs (nconc tmp-msgs (list newfile))) - (elmo-copy-file - ;; src file - (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist) - ;; tmp file - (expand-file-name newfile tmp-dir)) - (setq msgs (cdr msgs)) - (unless same-number (setq new (1+ new))))) (save-excursion (elmo-bind-directory - tmp-dir + dir (cond ((functionp n-method) - (funcall n-method (cons arc tmp-msgs))) + (funcall n-method (cons arc files))) (p-method (let ((p-prog (car p-method)) (p-prog-arg (cdr p-method))) (elmo-archive-exec-msgs-subr1 - p-prog (append p-prog-arg (list arc)) tmp-msgs))) + p-prog (append p-prog-arg (list arc)) files))) (t (let ((n-prog (car n-method)) (n-prog-arg (cdr n-method))) (elmo-archive-exec-msgs-subr2 - n-prog (append n-prog-arg (list arc)) tmp-msgs (length arc))))))))) - -;;; archive -> (localdir, localnews, archive) -(defun elmo-archive-copy-msgs-froms (dst-spec msgs src-spec - &optional loc-alist same-number) - (let* ((src-type (nth 2 src-spec)) - (arc (elmo-archive-get-archive-name (nth 1 src-spec) src-type)) - (prefix (nth 3 src-spec)) - (p-method (elmo-archive-get-method src-type 'ext-pipe)) - (n-method (elmo-archive-get-method src-type 'ext)) - (tmp-dir - (file-name-as-directory (elmo-msgdb-expand-path src-spec))) - (tmp-msgs (mapcar '(lambda (x) (elmo-concat-path - prefix - (int-to-string x))) - msgs)) - result) - (unwind-protect - (setq result - (and - ;; extract messages - (save-excursion - (elmo-bind-directory - tmp-dir - (cond - ((functionp n-method) - (funcall n-method (cons arc tmp-msgs))) - (p-method - (let ((p-prog (car p-method)) - (p-prog-arg (cdr p-method))) - (elmo-archive-exec-msgs-subr1 - p-prog (append p-prog-arg (list arc)) tmp-msgs))) - (t - (let ((n-prog (car n-method)) - (n-prog-arg (cdr n-method))) - (elmo-archive-exec-msgs-subr2 - n-prog (append n-prog-arg (list arc)) tmp-msgs (length arc))))))) - ;; call elmo-*-copy-msgs of destination folder - (elmo-call-func dst-spec "copy-msgs" - msgs src-spec loc-alist same-number))) - ;; clean up tmp-dir - (elmo-bind-directory - tmp-dir - (while tmp-msgs - (if (file-exists-p (car tmp-msgs)) - (delete-file (car tmp-msgs))) - (setq tmp-msgs (cdr tmp-msgs)))) - result))) - -(defun elmo-archive-delete-msgs (spec msgs) - (save-excursion - (let* ((type (nth 2 spec)) - (prefix (nth 3 spec)) - (arc (elmo-archive-get-archive-name (nth 1 spec) type)) - (p-method (elmo-archive-get-method type 'rm-pipe)) - (n-method (elmo-archive-get-method type 'rm)) - (msgs (mapcar '(lambda (x) (elmo-concat-path - prefix - (int-to-string x))) - msgs))) - (cond ((functionp n-method) - (funcall n-method (cons arc msgs))) - (p-method - (let ((p-prog (car p-method)) - (p-prog-arg (cdr p-method))) - (elmo-archive-exec-msgs-subr1 - p-prog (append p-prog-arg (list arc)) msgs))) - (n-method - (let ((n-prog (car n-method)) - (n-prog-arg (cdr n-method))) - (elmo-archive-exec-msgs-subr2 - n-prog (append n-prog-arg (list arc)) msgs (length arc)))) - (t - (ding) - (error "WARNING: not delete: %s (method undefined)" type))) ))) + n-prog (append n-prog-arg (list arc)) files (length arc))))))))) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-archive-folder) + numbers) + (let* ((type (elmo-archive-folder-archive-type-internal folder)) + (prefix (elmo-archive-folder-archive-prefix-internal folder)) + (arc (elmo-archive-get-archive-name folder)) + (p-method (elmo-archive-get-method type 'rm-pipe)) + (n-method (elmo-archive-get-method type 'rm)) + (numbers (mapcar '(lambda (x) (elmo-concat-path + prefix + (int-to-string x))) + numbers))) + (cond ((functionp n-method) + (funcall n-method (cons arc numbers))) + (p-method + (let ((p-prog (car p-method)) + (p-prog-arg (cdr p-method))) + (elmo-archive-exec-msgs-subr1 + p-prog (append p-prog-arg (list arc)) numbers))) + (n-method + (let ((n-prog (car n-method)) + (n-prog-arg (cdr n-method))) + (elmo-archive-exec-msgs-subr2 + n-prog (append n-prog-arg (list arc)) numbers (length arc)))) + (t + (ding) + (error "WARNING: not delete: %s (method undefined)" type))))) (defun elmo-archive-exec-msgs-subr1 (prog args msgs) (let ((buf (get-buffer-create " *ELMO ARCHIVE exec*"))) @@ -785,35 +882,34 @@ TYPE specifies the archiver's symbol." (elmo-archive-call-method method arg-list t)) (elmo-archive-msgdb-create-entity-subr number)))) -(defun elmo-archive-msgdb-create-as-numlist (spec numlist new-mark - already-mark seen-mark - important-mark seen-list) - (when numlist +(luna-define-method elmo-folder-msgdb-create ((folder elmo-archive-folder) + numbers new-mark + already-mark seen-mark + important-mark seen-list) + (when numbers (save-excursion ;; 981005 (if (and elmo-archive-use-izip-agent - (elmo-archive-get-method (nth 2 spec) 'cat-headers)) + (elmo-archive-get-method + (elmo-archive-folder-archive-type-internal folder) + 'cat-headers)) (elmo-archive-msgdb-create-as-numlist-subr2 - spec numlist new-mark already-mark seen-mark important-mark + folder numbers new-mark already-mark seen-mark important-mark seen-list) (elmo-archive-msgdb-create-as-numlist-subr1 - spec numlist new-mark already-mark seen-mark important-mark + folder numbers new-mark already-mark seen-mark important-mark seen-list))))) -(defalias 'elmo-archive-msgdb-create 'elmo-archive-msgdb-create-as-numlist) - - -(defun elmo-archive-msgdb-create-as-numlist-subr1 (spec numlist new-mark - already-mark seen-mark - important-mark - seen-list) - (let* ((type (nth 2 spec)) - (file (elmo-archive-get-archive-name (nth 1 spec) type spec)) +(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder + numlist new-mark + already-mark seen-mark + important-mark + seen-list) + (let* ((type (elmo-archive-folder-archive-type-internal folder)) + (file (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'cat)) - (tmp-buf (get-buffer-create " *ELMO ARCHIVE msgdb*")) overview number-alist mark-alist entity i percent num message-id seen gmark) - (save-excursion - (set-buffer tmp-buf) + (with-temp-buffer (setq num (length numlist)) (setq i 0) (message "Creating msgdb...") @@ -821,7 +917,8 @@ TYPE specifies the archiver's symbol." (erase-buffer) (setq entity (elmo-archive-msgdb-create-entity - method file (car numlist) type (nth 3 spec))) + method file (car numlist) type + (elmo-archive-folder-archive-prefix-internal folder))) (when entity (setq overview (elmo-msgdb-append-element @@ -835,7 +932,8 @@ TYPE specifies the archiver's symbol." (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-cache-exists-p message-id) ; XXX + (if (elmo-file-cache-status + (elmo-file-cache-get message-id)) (if seen nil already-mark) @@ -854,70 +952,68 @@ TYPE specifies the archiver's symbol." 'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..." percent)) (setq numlist (cdr numlist))) - (kill-buffer tmp-buf) (message "Creating msgdb...done") - (list overview number-alist mark-alist)) )) + (list overview number-alist mark-alist)))) ;;; info-zip agent -(defun elmo-archive-msgdb-create-as-numlist-subr2 (spec numlist new-mark - already-mark seen-mark - important-mark - seen-list) - (let* ((buf (get-buffer-create " *ELMO ARCHIVE headers*")) - (delim1 elmo-mmdf-delimiter) ;; MMDF +(defun elmo-archive-msgdb-create-as-numlist-subr2 (folder + numlist new-mark + already-mark seen-mark + important-mark + seen-list) + (let* ((delim1 elmo-mmdf-delimiter) ;; MMDF (delim2 elmo-unixmail-delimiter) ;; UNIX Mail - (type (nth 2 spec)) - (prefix (nth 3 spec)) + (type (elmo-archive-folder-archive-type-internal folder)) + (prefix (elmo-archive-folder-archive-prefix-internal folder)) (method (elmo-archive-get-method type 'cat-headers)) (prog (car method)) (args (cdr method)) - (arc (elmo-archive-get-archive-name (nth 1 spec) type)) + (arc (elmo-archive-get-archive-name folder)) n i percent num result overview number-alist mark-alist msgs case-fold-search) - (set-buffer buf) - (setq num (length numlist)) - (setq i 0) - (message "Creating msgdb...") - (while numlist - (setq n (min (1- elmo-archive-fetch-headers-volume) - (1- (length numlist)))) - (setq msgs (reverse (memq (nth n numlist) (reverse numlist)))) - (setq numlist (nthcdr (1+ n) numlist)) - (erase-buffer) - (insert - (mapconcat - 'concat - (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs) - "\n")) - (message "Fetching headers...") - (as-binary-process (apply 'call-process-region - (point-min) (point-max) - prog t t nil (append args (list arc)))) - (goto-char (point-min)) - (cond - ((looking-at delim1) ;; MMDF - (setq result (elmo-archive-parse-mmdf msgs - new-mark - already-mark seen-mark - seen-list)) - (setq overview (append overview (nth 0 result))) - (setq number-alist (append number-alist (nth 1 result))) - (setq mark-alist (append mark-alist (nth 2 result)))) + (with-temp-buffer + (setq num (length numlist)) + (setq i 0) + (message "Creating msgdb...") + (while numlist + (setq n (min (1- elmo-archive-fetch-headers-volume) + (1- (length numlist)))) + (setq msgs (reverse (memq (nth n numlist) (reverse numlist)))) + (setq numlist (nthcdr (1+ n) numlist)) + (erase-buffer) + (insert + (mapconcat + 'concat + (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs) + "\n")) + (message "Fetching headers...") + (as-binary-process (apply 'call-process-region + (point-min) (point-max) + prog t t nil (append args (list arc)))) + (goto-char (point-min)) + (cond + ((looking-at delim1) ;; MMDF + (setq result (elmo-archive-parse-mmdf msgs + new-mark + already-mark seen-mark + seen-list)) + (setq overview (append overview (nth 0 result))) + (setq number-alist (append number-alist (nth 1 result))) + (setq mark-alist (append mark-alist (nth 2 result)))) ;;; ((looking-at delim2) ;; UNIX MAIL ;;; (setq result (elmo-archive-parse-unixmail msgs)) ;;; (setq overview (append overview (nth 0 result))) ;;; (setq number-alist (append number-alist (nth 1 result))) ;;; (setq mark-alist (append mark-alist (nth 2 result)))) - (t ;; unknown format - (error "Unknown format!"))) - (when (> num elmo-display-progress-threshold) - (setq i (+ n i)) - (setq percent (/ (* i 100) num)) - (elmo-display-progress - 'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..." - percent))) - (kill-buffer buf) - (list overview number-alist mark-alist)) ) + (t ;; unknown format + (error "Unknown format!"))) + (when (> num elmo-display-progress-threshold) + (setq i (+ n i)) + (setq percent (/ (* i 100) num)) + (elmo-display-progress + 'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..." + percent)))) + (list overview number-alist mark-alist))) (defun elmo-archive-parse-mmdf (msgs new-mark already-mark @@ -951,7 +1047,8 @@ TYPE specifies the archiver's symbol." (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-cache-exists-p message-id) ; XXX + (if (elmo-file-cache-status + (elmo-file-cache-get message-id)) (if seen nil already-mark) @@ -973,11 +1070,11 @@ TYPE specifies the archiver's symbol." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Search functions -(defsubst elmo-archive-field-condition-match (spec number number-list - condition prefix) +(defsubst elmo-archive-field-condition-match (folder number number-list + condition prefix) (save-excursion - (let* ((type (nth 2 spec)) - (arc (elmo-archive-get-archive-name (nth 1 spec) type spec)) + (let* ((type (elmo-archive-folder-archive-type-internal folder)) + (arc (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'cat)) (args (list arc (elmo-concat-path prefix (int-to-string number))))) (elmo-set-work-buf @@ -988,21 +1085,23 @@ TYPE specifies the archiver's symbol." (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset) (elmo-buffer-field-condition-match condition number number-list)))))) -(defun elmo-archive-search (spec condition &optional from-msgs) +(luna-define-method elmo-folder-search ((folder elmo-archive-folder) + condition &optional from-msgs) (let* (;;(args (elmo-string-to-list key)) ;; XXX: I don't know whether `elmo-archive-list-folder' ;; updates match-data. ;; (msgs (or from-msgs (elmo-archive-list-folder spec))) - (msgs (or from-msgs (elmo-archive-list-folder spec))) + (msgs (or from-msgs (elmo-folder-list-messages folder))) (num (length msgs)) (i 0) (case-fold-search nil) number-list ret-val) (setq number-list msgs) (while msgs - (if (elmo-archive-field-condition-match spec (car msgs) number-list - condition - (nth 3 spec)) + (if (elmo-archive-field-condition-match + folder (car msgs) number-list + condition + (elmo-archive-folder-archive-prefix-internal folder)) (setq ret-val (cons (car msgs) ret-val))) (when (> num elmo-display-progress-threshold) (setq i (1+ i)) @@ -1012,17 +1111,6 @@ TYPE specifies the archiver's symbol." (setq msgs (cdr msgs))) (nreverse ret-val))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Misc functions - -(defun elmo-archive-check-validity (spec validity-file) - t) ; ok. - -(defun elmo-archive-sync-validity (spec validity-file) - t) ; ok. - - ;;; method(alist) (if (null elmo-archive-method-alist) (let ((mlist elmo-archive-method-list) ; from mew-highlight.el @@ -1049,28 +1137,10 @@ TYPE specifies the archiver's symbol." (nconc elmo-archive-suffixes (list (cdr tmp)))) (setq slist (cdr slist))))) -(defun elmo-archive-use-cache-p (spec number) +(luna-define-method elmo-message-use-cache-p ((folder elmo-archive-folder) + number) elmo-archive-use-cache) -(defun elmo-archive-local-file-p (spec number) - nil) - -(defun elmo-archive-get-msg-filename (spec number &optional loc-alist) - (let ((tmp-dir (file-name-as-directory (elmo-msgdb-expand-path spec))) - (prefix (nth 3 spec))) - (expand-file-name - (elmo-concat-path prefix (int-to-string number)) - tmp-dir))) - -(defalias 'elmo-archive-sync-number-alist - 'elmo-generic-sync-number-alist) -(defalias 'elmo-archive-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-archive-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-archive-commit 'elmo-generic-commit) -(defalias 'elmo-archive-folder-diff 'elmo-generic-folder-diff) - ;;; End (run-hooks 'elmo-archive-load-hook) diff --git a/elmo/elmo-cache.el b/elmo/elmo-cache.el index 993b7d7..a046d83 100644 --- a/elmo/elmo-cache.el +++ b/elmo/elmo-cache.el @@ -32,721 +32,191 @@ ;; (require 'elmo-vars) (require 'elmo-util) - -(defun elmo-cache-delete (msgid folder number) - "Delete cache file associated with message-id 'MSGID', FOLDER, NUMBER." - (let ((path (elmo-cache-exists-p msgid folder number))) - (if path (delete-file path)))) - -(defsubst elmo-cache-to-msgid (filename) - (concat "<" (elmo-recover-msgid-from-filename filename) ">")) - -(defun elmo-cache-force-delete (path &optional locked) - "Delete cache file." - ;; for safety... - (unless (string-match elmo-cache-dirname path) - (error "%s is not cache file!" path)) - (let (message-id) - (if (or (elmo-msgdb-global-mark-get - (setq message-id - (elmo-cache-to-msgid (file-name-nondirectory path)))) - (member message-id locked)) - nil;; Don't delete caches with mark (or locked message). - (if (and path - (file-directory-p path)) - (progn - (mapcar 'delete-file (directory-files path t "^[^\\.]")) - (delete-directory path)) - (delete-file path)) - t))) - -(defun elmo-cache-delete-partial (msgid folder number) - "Delete cache file only if it is partial message." - (if msgid - (let ((path1 (elmo-cache-get-path msgid)) - path2) - (if (and path1 - (file-exists-p path1)) - (if (and folder - (file-directory-p path1)) - (when (file-exists-p (setq path2 - (expand-file-name - (format "%s@%s" - number - (elmo-safe-filename - folder)) - path1))) - (delete-file path2) - (unless (directory-files path1 t "^[^\\.]") - (delete-directory path1)))))))) - -(defun elmo-cache-read (msgid &optional folder number outbuf) - "Read cache contents to OUTBUF." - (save-excursion - (let ((path (elmo-cache-exists-p msgid folder number))) - (when path - (if outbuf (set-buffer outbuf)) - (erase-buffer) - (as-binary-input-file (insert-file-contents path)) - t)))) - -(defun elmo-cache-expire () - (interactive) - (let* ((completion-ignore-case t) - (method (completing-read (format "Expire by (%s): " - elmo-cache-expire-default-method) - '(("size" . "size") - ("age" . "age"))))) - (if (string= method "") - (setq method elmo-cache-expire-default-method)) - (funcall (intern (concat "elmo-cache-expire-by-" method))))) - -(defun elmo-read-float-value-from-minibuffer (prompt &optional initial) - (let ((str (read-from-minibuffer prompt initial))) - (cond - ((string-match "[0-9]*\\.[0-9]+" str) - (string-to-number str)) - ((string-match "[0-9]+" str) - (string-to-number (concat str ".0"))) - (t (error "%s is not number" str))))) - -(defun elmo-cache-expire-by-size (&optional kbytes) - "Expire cache file by size. -If KBYTES is kilo bytes (This value must be float)." - (interactive) - (let ((size (or kbytes - (and (interactive-p) - (elmo-read-float-value-from-minibuffer - "Enter cache disk size (Kbytes): " - (number-to-string - (if (integerp elmo-cache-expire-default-size) - (float elmo-cache-expire-default-size) - elmo-cache-expire-default-size)))) - (if (integerp elmo-cache-expire-default-size) - (float elmo-cache-expire-default-size)))) - (locked (elmo-dop-lock-list-load)) - (count 0) - (Kbytes 1024) - total beginning) - (message "Checking disk usage...") - (setq total (/ (elmo-disk-usage - (expand-file-name - elmo-cache-dirname elmo-msgdb-dir)) Kbytes)) - (setq beginning total) - (message "Checking disk usage...done") - (let ((cfl (elmo-cache-get-sorted-cache-file-list)) - (deleted 0) - oldest - cur-size cur-file) - (while (and (<= size total) - (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl))) - (setq cur-file (expand-file-name (car (cdr oldest)) (car oldest))) - (setq cur-size (/ (elmo-disk-usage cur-file) Kbytes)) - (when (elmo-cache-force-delete cur-file locked) - (setq count (+ count 1)) - (message "%d cache(s) are expired." count)) - (setq deleted (+ deleted cur-size)) - (setq total (- total cur-size))) - (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)." - count deleted beginning)))) - -(defun elmo-cache-make-file-entity (filename path) - (cons filename (elmo-get-last-accessed-time filename path))) - -(defun elmo-cache-get-oldest-cache-file-entity (cache-file-list) - (let ((cfl cache-file-list) - flist firsts oldest-entity wonlist) - (while cfl - (setq flist (cdr (car cfl))) - (setq firsts (append firsts (list - (cons (car (car cfl)) - (car flist))))) - (setq cfl (cdr cfl))) -;;; (prin1 firsts) - (while firsts - (if (and (not oldest-entity) - (cdr (cdr (car firsts)))) - (setq oldest-entity (car firsts))) - (if (and (cdr (cdr (car firsts))) - (cdr (cdr oldest-entity)) - (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts))))) - (setq oldest-entity (car firsts))) - (setq firsts (cdr firsts))) - (setq wonlist (assoc (car oldest-entity) cache-file-list)) - (and wonlist - (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist)))) - oldest-entity)) - -(defun elmo-cache-get-sorted-cache-file-list () - (let ((dirs (directory-files - (expand-file-name elmo-cache-dirname elmo-msgdb-dir) - t "^[^\\.]")) - (i 0) num - elist - ret-val) - (setq num (length dirs)) - (message "Collecting cache info...") - (while dirs - (setq elist (mapcar (lambda (x) - (elmo-cache-make-file-entity x (car dirs))) - (directory-files (car dirs) nil "^[^\\.]"))) - (setq ret-val (append ret-val - (list (cons - (car dirs) - (sort - elist - (lambda (x y) - (< (cdr x) - (cdr y)))))))) - (when (> num elmo-display-progress-threshold) - (setq i (+ i 1)) - (elmo-display-progress - 'elmo-cache-get-sorted-cache-file-list "Collecting cache info..." - (/ (* i 100) num))) - (setq dirs (cdr dirs))) - (message "Collecting cache info...done") - ret-val)) - -(defun elmo-cache-expire-by-age (&optional days) - (let ((age (or (and days (int-to-string days)) - (and (interactive-p) - (read-from-minibuffer - (format "Enter days (%s): " - elmo-cache-expire-default-age))) - (int-to-string elmo-cache-expire-default-age))) - (dirs (directory-files - (expand-file-name elmo-cache-dirname elmo-msgdb-dir) - t "^[^\\.]")) - (locked (elmo-dop-lock-list-load)) - (count 0) - curtime) - (if (string= age "") - (setq age elmo-cache-expire-default-age) - (setq age (string-to-int age))) - (setq curtime (current-time)) - (setq curtime (+ (* (nth 0 curtime) - (float 65536)) (nth 1 curtime))) - (while dirs - (let ((files (directory-files (car dirs) t "^[^\\.]")) - (limit-age (* age 86400))) - (while files - (when (> (- curtime (elmo-get-last-accessed-time (car files))) - limit-age) - (when (elmo-cache-force-delete (car files) locked) - (setq count (+ 1 count)) - (message "%d cache file(s) are expired." count))) - (setq files (cdr files)))) - (setq dirs (cdr dirs))))) - -(defun elmo-cache-save (msgid partial folder number &optional inbuf) - "If PARTIAL is non-nil, save current buffer (or INBUF) as partial cache." - (condition-case nil - (save-excursion - (let* ((path (if partial - (elmo-cache-get-path msgid folder number) - (elmo-cache-get-path msgid))) - dir tmp-buf) - (when path - (setq dir (directory-file-name (file-name-directory path))) - (if (not (file-exists-p dir)) - (elmo-make-directory dir)) - (if inbuf (set-buffer inbuf)) - (goto-char (point-min)) - (as-binary-output-file (write-region (point-min) (point-max) - path nil 'no-msg))))) - (error))) - -(defun elmo-cache-exists-p (msgid &optional folder number) - "Returns the path if the cache exists." - (save-match-data - (if msgid - (let ((path (elmo-cache-get-path msgid))) - (if (and path - (file-exists-p path)) - (if (and folder - (file-directory-p path)) - (if (file-exists-p (setq path (expand-file-name - (format "%s@%s" - (or number "") - (elmo-safe-filename - folder)) - path))) - path - ) - ;; not directory. - path)))))) - -(defun elmo-cache-search-all (folder condition from-msgs) - (let* ((number-alist (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder))) - (number-list (or from-msgs (mapcar 'car number-alist))) - (num (length number-alist)) - cache-file - ret-val - case-fold-search msg - percent i) - (setq i 0) - (while number-alist - (if (and (memq (car (car number-alist)) number-list) - (setq cache-file (elmo-cache-exists-p (cdr (car - number-alist)) - folder - (car (car - number-alist)))) - (elmo-file-field-condition-match cache-file condition - (car (car number-alist)) - number-list)) - (setq ret-val (append ret-val (list (caar number-alist))))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (setq percent (/ (* i 100) num)) - (elmo-display-progress - 'elmo-cache-search-all "Searching..." - percent)) - (setq number-alist (cdr number-alist))) - ret-val)) - -(defun elmo-cache-collect-sub-directories (init dir &optional recursively) - "Collect subdirectories under DIR." - (let ((dirs - (delete (expand-file-name elmo-cache-dirname - elmo-msgdb-dir) - (directory-files dir t "^[^\\.]"))) - ret-val) - (setq dirs (elmo-delete-if (lambda (x) (not (file-directory-p x))) dirs)) - (setq ret-val (append init dirs)) - (while (and recursively dirs) - (setq ret-val - (elmo-cache-collect-sub-directories - ret-val - (car dirs) recursively)) - (setq dirs (cdr dirs))) - ret-val)) - -(defun elmo-msgid-to-cache (msgid) - (when (and msgid - (string-match "<\\(.+\\)>$" msgid)) - (elmo-replace-msgid-as-filename (elmo-match-string 1 msgid)))) - -(defun elmo-cache-get-path (msgid &optional folder number) - "Get path for cache file associated with MSGID, FOLDER, and NUMBER." - (if (setq msgid (elmo-msgid-to-cache msgid)) - (expand-file-name - (expand-file-name - (if folder - (format "%s/%s/%s@%s" - (elmo-cache-get-path-subr msgid) - msgid - (or number "") - (elmo-safe-filename folder)) - (format "%s/%s" - (elmo-cache-get-path-subr msgid) - msgid)) - (expand-file-name elmo-cache-dirname - elmo-msgdb-dir))))) - -(defsubst elmo-cache-get-path-subr (msgid) - (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F)) - (clist (string-to-char-list msgid)) - (sum 0)) - (while clist - (setq sum (+ sum (car clist))) - (setq clist (cdr clist))) - (format "%c%c" - (nth (% (/ sum 16) 2) chars) - (nth (% sum 16) chars)))) - +(require 'elmo) +(require 'elmo-map) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; buffer cache module - -(defconst elmo-buffer-cache-name " *elmo cache*") - -(defvar elmo-buffer-cache nil - "Message cache. (old ... new) order alist. -With association ((\"folder\" message \"message-id\") . cache-buffer).") - -(defmacro elmo-buffer-cache-buffer-get (entry) - (` (cdr (, entry)))) - -(defmacro elmo-buffer-cache-folder-get (entry) - (` (car (car (, entry))))) - -(defmacro elmo-buffer-cache-message-get (entry) - (` (cdr (car (, entry))))) - -(defmacro elmo-buffer-cache-entry-make (fld-msg-id buf) - (` (cons (, fld-msg-id) (, buf)))) - -(defmacro elmo-buffer-cache-hit (fld-msg-id) - "Return value assosiated with key." - (` (elmo-buffer-cache-buffer-get - (assoc (, fld-msg-id) elmo-buffer-cache)))) - -(defun elmo-buffer-cache-sort (entry) - (let* ((pointer (cons nil elmo-buffer-cache)) - (top pointer)) - (while (cdr pointer) - (if (equal (car (cdr pointer)) entry) - (setcdr pointer (cdr (cdr pointer))) - (setq pointer (cdr pointer)))) - (setcdr pointer (list entry)) - (setq elmo-buffer-cache (cdr top)))) - -(defun elmo-buffer-cache-add (fld-msg-id) - "Adding (FLD-MSG-ID . buf) to the top of `elmo-buffer-cache'. -Returning its cache buffer." - (let ((len (length elmo-buffer-cache)) - (buf nil)) - (if (< len elmo-buffer-cache-size) - (setq buf (get-buffer-create (format "%s%d" elmo-buffer-cache-name len))) - (setq buf (elmo-buffer-cache-buffer-get (nth (1- len) elmo-buffer-cache))) - (setcdr (nthcdr (- len 2) elmo-buffer-cache) nil)) - (save-excursion - (set-buffer buf) - (elmo-set-buffer-multibyte nil)) - (setq elmo-buffer-cache - (cons (elmo-buffer-cache-entry-make fld-msg-id buf) - elmo-buffer-cache)) - buf)) - -(defun elmo-buffer-cache-delete () - "Delete the most recent cache entry." - (let ((buf (elmo-buffer-cache-buffer-get (car elmo-buffer-cache)))) - (setq elmo-buffer-cache - (nconc (cdr elmo-buffer-cache) - (list (elmo-buffer-cache-entry-make nil buf)))))) - -(defun elmo-buffer-cache-clean-up () - "A function to flush all decoded messages in cache list." - (interactive) - (let ((n 0) buf) - (while (< n elmo-buffer-cache-size) - (setq buf (concat elmo-buffer-cache-name (int-to-string n))) - (elmo-kill-buffer buf) - (setq n (1+ n)))) - (setq elmo-buffer-cache nil)) - -;; +;; ;; cache backend by Kenichi OKADA ;; +(eval-and-compile + (luna-define-class elmo-cache-folder (elmo-map-folder) (dir-name directory)) + (luna-define-internal-accessors 'elmo-cache-folder)) + +(luna-define-method elmo-folder-initialize ((folder elmo-cache-folder) + name) + (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name) + (elmo-cache-folder-set-dir-name-internal + folder + (elmo-match-string 2 name)) + (elmo-cache-folder-set-directory-internal + folder + (expand-file-name (elmo-match-string 2 name) + (expand-file-name elmo-cache-dirname elmo-msgdb-dir))) + folder)) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-cache-folder)) + (expand-file-name (elmo-cache-folder-dir-name-internal folder) + (expand-file-name "internal/cache" + elmo-msgdb-dir))) + +(luna-define-method elmo-map-folder-list-message-locations + ((folder elmo-cache-folder)) + (elmo-cache-folder-list-message-locations folder)) + +(defun elmo-cache-folder-list-message-locations (folder) + (mapcar 'file-name-nondirectory + (elmo-delete-if + 'file-directory-p + (directory-files (elmo-cache-folder-directory-internal folder) + t "^[^@]+@[^@]+$" t)))) + +(luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder) + &optional one-level) + (delq nil (mapcar + (lambda (f) (if (file-directory-p f) + (concat (elmo-folder-prefix-internal folder) + "cache/" + (file-name-nondirectory f)))) + (directory-files (elmo-cache-folder-directory-internal folder) + t "^[^.].*+")))) + +(luna-define-method elmo-folder-message-file-p ((folder elmo-cache-folder)) + t) -(defsubst elmo-cache-get-folder-directory (spec) - (if (file-name-absolute-p (nth 1 spec)) - (nth 1 spec) ; already full path. - (expand-file-name (nth 1 spec) - (expand-file-name elmo-cache-dirname elmo-msgdb-dir)))) - -(defun elmo-cache-msgdb-expand-path (spec) - (let ((fld-name (nth 1 spec))) - (expand-file-name fld-name - (expand-file-name "internal/cache" - elmo-msgdb-dir)))) - -(defun elmo-cache-number-to-filename (spec number) - (let ((number-alist - (elmo-cache-list-folder-subr spec nil t))) - (elmo-msgid-to-cache - (cdr (assq number number-alist))))) - -(if (boundp 'nemacs-version) - (defsubst elmo-cache-insert-header (file) - "Insert the header of the article (Does not work on nemacs)." - (as-binary-input-file - (insert-file-contents file))) - (defsubst elmo-cache-insert-header (file) - "Insert the header of the article." - (let ((beg 0) - insert-file-contents-pre-hook ; To avoid autoconv-xmas... - insert-file-contents-post-hook - format-alist) - (when (file-exists-p file) - ;; Read until header separator is found. - (while (and (eq elmo-localdir-header-chop-length - (nth 1 - (as-binary-input-file - (insert-file-contents - file nil beg - (incf beg elmo-localdir-header-chop-length))))) - (prog1 (not (search-forward "\n\n" nil t)) - (goto-char (point-max))))))))) - -(defsubst elmo-cache-msgdb-create-overview-entity-from-file (number file) - (save-excursion - (let ((tmp-buffer (get-buffer-create " *ELMO Cache Temp*")) - insert-file-contents-pre-hook ; To avoid autoconv-xmas... - insert-file-contents-post-hook header-end - (attrib (file-attributes file)) - ret-val size mtime) - (set-buffer tmp-buffer) - (erase-buffer) - (if (not (file-exists-p file)) +(luna-define-method elmo-message-file-name ((folder elmo-cache-folder) + number) + (expand-file-name + (elmo-map-message-location folder number) + (elmo-cache-folder-directory-internal folder))) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder) + numbers new-mark + already-mark seen-mark + important-mark + seen-list) + (let ((i 0) + (len (length numbers)) + overview number-alist mark-alist entity message-id + num mark) + (message "Creating msgdb...") + (while numbers + (setq entity + (elmo-msgdb-create-overview-entity-from-file + (car numbers) (elmo-message-file-name folder (car numbers)))) + (if (null entity) () - (setq size (nth 7 attrib)) - (setq mtime (timezone-make-date-arpa-standard - (current-time-string (nth 5 attrib)) (current-time-zone))) - ;; insert header from file. - (catch 'done - (condition-case nil - (elmo-cache-insert-header file) - (error (throw 'done nil))) - (goto-char (point-min)) - (setq header-end - (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t) - (point) - (point-max))) - (narrow-to-region (point-min) header-end) - (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime)) - (kill-buffer tmp-buffer)) - ret-val)))) - -(defun elmo-cache-msgdb-create-as-numlist (spec numlist new-mark - already-mark seen-mark - important-mark seen-list) - (when numlist - (let ((dir (elmo-cache-get-folder-directory spec)) - (nalist (elmo-cache-list-folder-subr spec nil t)) - overview number-alist mark-alist entity message-id - i percent len num seen gmark) - (setq len (length numlist)) - (setq i 0) - (message "Creating msgdb...") - (while numlist - (setq entity - (elmo-cache-msgdb-create-overview-entity-from-file - (car numlist) - (expand-file-name - (elmo-msgid-to-cache - (setq message-id (cdr (assq (car numlist) nalist)))) dir))) - (if (null entity) - () - (setq num (elmo-msgdb-overview-entity-get-number entity)) - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq number-alist - (elmo-msgdb-number-add number-alist num message-id)) - (setq seen (member message-id seen-list)) - (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if seen - nil - new-mark))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - num - gmark)))) + (setq num (elmo-msgdb-overview-entity-get-number entity)) + (setq overview + (elmo-msgdb-append-element + overview entity)) + (setq message-id (elmo-msgdb-overview-entity-get-id entity)) + (setq number-alist + (elmo-msgdb-number-add number-alist + num + message-id)) + (if (setq mark (or (elmo-msgdb-global-mark-get message-id) + (if (member message-id seen-list) nil new-mark))) + (setq mark-alist + (elmo-msgdb-mark-append + mark-alist + num mark))) (when (> len elmo-display-progress-threshold) (setq i (1+ i)) - (setq percent (/ (* i 100) len)) (elmo-display-progress - 'elmo-cache-msgdb-create-as-numlist "Creating msgdb..." - percent)) - (setq numlist (cdr numlist))) - (message "Creating msgdb...done") - (list overview number-alist mark-alist)))) - -(defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist) - -(defun elmo-cache-list-folders (spec &optional hierarchy) - (let ((folder (concat "'cache" (nth 1 spec)))) - (elmo-cache-list-folders-subr folder hierarchy))) - -(defun elmo-cache-list-folders-subr (folder &optional hierarchy) - (let ((case-fold-search t) - folders curdir dirent relpath abspath attr - subprefix subfolder) - (condition-case () - (progn - (setq curdir - (expand-file-name - (nth 1 (elmo-folder-get-spec folder)) - (expand-file-name elmo-cache-dirname elmo-msgdb-dir))) - (if (string-match "^[+=$!]$" folder) ; localdir, archive, localnews - (setq subprefix folder) - (setq subprefix (concat folder elmo-path-sep))) - ;; include parent - ;(setq folders (list folder))) - (setq dirent (directory-files curdir nil "^[01][0-9A-F]$")) - (catch 'done - (while dirent - (setq relpath (car dirent)) - (setq dirent (cdr dirent)) - (setq abspath (expand-file-name relpath curdir)) - (and - (eq (nth 0 (setq attr (file-attributes abspath))) t) - (setq subfolder (concat subprefix relpath)) - (setq folders (nconc folders (list subfolder)))))) - folders) - (file-error folders)))) - -(defsubst elmo-cache-list-folder-subr (spec &optional nonsort nonalist) - (let* ((dir (elmo-cache-get-folder-directory spec)) - (flist (mapcar 'file-name-nondirectory - (elmo-delete-if 'file-directory-p - (directory-files - dir t "^[^@]+@[^@]+$" t)))) - (folder (concat "'cache/" (nth 1 spec))) - (number-alist (or (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder)) - (list nil))) - nlist) - (setq nlist - (mapcar '(lambda (filename) - (elmo-cache-filename-to-number filename number-alist)) - flist)) - (if nonalist - number-alist - (if nonsort - (cons (or (elmo-max-of-list nlist) 0) (length nlist)) - (sort nlist '<))))) - -(defsubst elmo-cache-filename-to-number (filename number-alist) - (let* ((msgid (elmo-cache-to-msgid filename)) - number) - (or (car (rassoc msgid number-alist)) - (prog1 - (setq number (+ (or (caar (last number-alist)) - 0) 1)) - (if (car number-alist) - (nconc number-alist - (list (cons number msgid))) - (setcar number-alist (cons number msgid))))))) - -(defun elmo-cache-append-msg (spec string message-id &optional msg no-see) - (let ((dir (elmo-cache-get-folder-directory spec)) - (tmp-buffer (get-buffer-create " *ELMO Temp buffer*")) - filename) - (save-excursion - (set-buffer tmp-buffer) - (erase-buffer) - (setq filename (expand-file-name (elmo-msgid-to-cache message-id) dir)) - (unwind-protect - (if (file-writable-p filename) - (progn - (insert string) - (as-binary-output-file - (write-region (point-min) (point-max) filename nil 'no-msg)) - t) - nil) - (kill-buffer tmp-buffer))))) - -(defun elmo-cache-delete-msg (spec number locked) - (let* ((dir (elmo-cache-get-folder-directory spec)) - (file (expand-file-name - (elmo-cache-number-to-filename spec number) dir))) - ;; return nil if failed. - (elmo-cache-force-delete file locked))) - -(defun elmo-cache-read-msg (spec number outbuf &optional msgdb unread) - (save-excursion - (let* ((dir (elmo-cache-get-folder-directory spec)) - (file (expand-file-name - (elmo-cache-number-to-filename spec number) dir))) - (set-buffer outbuf) - (erase-buffer) - (when (file-exists-p file) - (as-binary-input-file (insert-file-contents file)) - (elmo-delete-cr-get-content-type))))) - -(defun elmo-cache-delete-msgs (spec msgs) - (let ((locked (elmo-dop-lock-list-load))) - (not (memq nil - (mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked)) - msgs))))) - -(defun elmo-cache-list-folder (spec) ; called by elmo-cache-search() - (let ((killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - numbers) - (setq numbers (elmo-cache-list-folder-subr spec)) - (elmo-living-messages numbers killed))) - -(defun elmo-cache-max-of-folder (spec) - (elmo-cache-list-folder-subr spec t)) - -(defun elmo-cache-check-validity (spec validity-file) + 'elmo-cache-folder-msgdb-create "Creating msgdb..." + (/ (* i 100) len)))) + (setq numbers (cdr numbers))) + (message "Creating msgdb...done") + (list overview number-alist mark-alist))) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder) + unread + &optional number) + ;; dir-name is changed according to msgid. + (unless (elmo-cache-folder-dir-name-internal folder) + (let* ((file (elmo-file-cache-get-path (std11-field-body "message-id"))) + (dir (directory-file-name (file-name-directory file)))) + (unless (file-exists-p dir) + (elmo-make-directory dir)) + (when (file-writable-p file) + (write-region-as-binary + (point-min) (point-max) file nil 'no-msg)))) t) -(defun elmo-cache-sync-validity (spec validity-file) - t) - -(defun elmo-cache-folder-exists-p (spec) - (file-directory-p (elmo-cache-get-folder-directory spec))) - -(defun elmo-cache-folder-creatable-p (spec) +(luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder) + locations) + (dolist (location locations) + (elmo-file-cache-delete + (expand-file-name location + (elmo-cache-folder-directory-internal folder))))) + +(luna-define-method elmo-message-fetch-with-cache-process + ((folder elmo-cache-folder) number strategy &optional section unseen) + ;; disbable cache process + (elmo-message-fetch-internal folder number strategy section unseen)) + +(luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder) + location strategy + &optional section unseen) + (let ((file (expand-file-name + location + (elmo-cache-folder-directory-internal folder)))) + (when (file-exists-p file) + (insert-file-contents-as-binary file)))) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-cache-folder)) nil) -(defun elmo-cache-create-folder (spec) - nil) +(luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder)) + t) -(defun elmo-cache-search (spec condition &optional from-msgs) - (let* ((number-alist (elmo-cache-list-folder-subr spec nil t)) - (msgs (or from-msgs (mapcar 'car number-alist))) +(luna-define-method elmo-folder-search ((folder elmo-cache-folder) + condition &optional from-msgs) + (let* ((msgs (or from-msgs (elmo-folder-list-messages folder))) + (number-list msgs) + (i 0) (num (length msgs)) - (i 0) case-fold-search ret-val) + file + matched + case-fold-search) (while msgs - (if (elmo-file-field-condition-match - (expand-file-name - (elmo-msgid-to-cache - (cdr (assq (car msgs) number-alist))) - (elmo-cache-get-folder-directory spec)) - condition - (car msgs) - msgs) - (setq ret-val (cons (car msgs) ret-val))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (elmo-display-progress - 'elmo-cache-search "Searching..." - (/ (* i 100) num))) + (if (and (setq file (elmo-message-file-name folder (car msgs))) + (file-exists-p file) + (elmo-file-field-condition-match file + condition + (car msgs) + number-list)) + (setq matched (nconc matched (list (car msgs))))) + (elmo-display-progress + 'elmo-internal-folder-search "Searching..." + (/ (* (setq i (1+ i)) 100) num)) (setq msgs (cdr msgs))) - (nreverse ret-val))) + matched)) -;;; (localdir, maildir, localnews) -> cache -(defun elmo-cache-copy-msgs (dst-spec msgs src-spec - &optional loc-alist same-number) - (let ((dst-dir - (elmo-cache-get-folder-directory dst-spec)) - (next-num (1+ (car (elmo-cache-list-folder-subr dst-spec t)))) - (number-alist - (elmo-msgdb-number-load - (elmo-msgdb-expand-path src-spec)))) - (if same-number (error "Not implemented")) - (while msgs - (elmo-copy-file - ;; src file - (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist) - ;; dst file - (expand-file-name - (elmo-msgid-to-cache - (cdr (assq (if same-number (car msgs) next-num) number-alist))) - dst-dir)) - (if (and (setq msgs (cdr msgs)) - (not same-number)) - (setq next-num (1+ next-num)))) - t)) +(luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number) + t) -(defun elmo-cache-use-cache-p (spec number) - nil) +;;; To override elmo-map-folder methods. +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-cache-folder) unread-marks &optional mark-alist) + t) -(defun elmo-cache-local-file-p (spec number) +(luna-define-method elmo-folder-unmark-important ((folder elmo-cache-folder) + numbers) t) -(defun elmo-cache-get-msg-filename (spec number &optional loc-alist) - (expand-file-name - (elmo-cache-number-to-filename spec number) - (elmo-cache-get-folder-directory spec))) +(luna-define-method elmo-folder-mark-as-important ((folder elmo-cache-folder) + numbers) + t) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-cache-folder) + numbers) + t) -(defalias 'elmo-cache-sync-number-alist - 'elmo-generic-sync-number-alist) -(defalias 'elmo-cache-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-cache-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-cache-commit 'elmo-generic-commit) -(defalias 'elmo-cache-folder-diff 'elmo-generic-folder-diff) +(luna-define-method elmo-folder-mark-as-read ((folder elmo-cache-folder) + numbers) + t) (require 'product) (product-provide (provide 'elmo-cache) (require 'elmo-version)) diff --git a/elmo/elmo-date.el b/elmo/elmo-date.el index 52e4c66..75fbb5c 100644 --- a/elmo/elmo-date.el +++ b/elmo/elmo-date.el @@ -31,10 +31,67 @@ (require 'path-util) -(if (module-installed-p 'timezone) - (require 'timezone)) +(require 'timezone) (require 'elmo-vars) +(defmacro elmo-match-substring (pos string from) + "Substring of POSth matched string of STRING." + (` (substring (, string) + (+ (match-beginning (, pos)) (, from)) + (match-end (, pos))))) + +(defmacro elmo-match-string (pos string) + "Substring POSth matched STRING." + (` (substring (, string) (match-beginning (, pos)) (match-end (, pos))))) + +(defmacro elmo-match-buffer (pos) + "Substring POSth matched from the current buffer." + (` (buffer-substring-no-properties + (match-beginning (, pos)) (match-end (, pos))))) + +;; from subr.el +(defun elmo-replace-in-string (str regexp newtext &optional literal) + "Replace all matches in STR for REGEXP with NEWTEXT string. +And returns the new string. +Optional LITERAL non-nil means do a literal replacement. +Otherwise treat \\ in NEWTEXT string as special: + \\& means substitute original matched text, + \\N means substitute match for \(...\) number N, + \\\\ means insert one \\." + (let ((rtn-str "") + (start 0) + (special) + match prev-start) + (while (setq match (string-match regexp str start)) + (setq prev-start start + start (match-end 0) + rtn-str + (concat + rtn-str + (substring str prev-start match) + (cond (literal newtext) + (t (mapconcat + (function + (lambda (c) + (if special + (progn + (setq special nil) + (cond ((eq c ?\\) "\\") + ((eq c ?&) + (elmo-match-string 0 str)) + ((and (>= c ?0) (<= c ?9)) + (if (> c (+ ?0 (length + (match-data)))) + ;; Invalid match num + (error "Invalid match num: %c" c) + (setq c (- c ?0)) + (elmo-match-string c str))) + (t (char-to-string c)))) + (if (eq c ?\\) (progn (setq special t) nil) + (char-to-string c))))) + newtext "")))))) + (concat rtn-str (substring str start)))) + (defvar elmo-date-descriptions '((yesterday . [0 0 1]) (lastweek . [0 0 7]) diff --git a/elmo/elmo-dop.el b/elmo/elmo-dop.el index 4c2f161..66b1aa5 100644 --- a/elmo/elmo-dop.el +++ b/elmo/elmo-dop.el @@ -29,40 +29,56 @@ ;;; Code: ;; +(require 'elmo) (require 'elmo-vars) (require 'elmo-msgdb) (require 'elmo-util) -(eval-when-compile - (require 'elmo-imap4) - (require 'elmo-localdir)) +(require 'elmo-localdir) ;; global variable. (defvar elmo-dop-queue nil "A list of (folder-name function-to-be-called argument-list). Automatically loaded/saved.") -(defun elmo-dop-queue-append (folder function argument) - (let ((operation (list (elmo-string folder) function argument))) - (elmo-dop-queue-load) - (unless (member operation elmo-dop-queue) ;; don't append same operation - (setq elmo-dop-queue - (append elmo-dop-queue - (list operation))) - (elmo-dop-queue-save)))) +(defmacro elmo-make-dop-queue (fname method arguments) + "Make a dop queue." + (` (vector (, fname) (, method) (, arguments)))) + +(defmacro elmo-dop-queue-fname (queue) + "Return the folder name string of the QUEUE." + (` (aref (, queue) 0))) + +(defmacro elmo-dop-queue-method (queue) + "Return the method symbol of the QUEUE." + (` (aref (, queue) 1))) + +(defmacro elmo-dop-queue-arguments (queue) + "Return the arguments of the QUEUE." + (` (aref (, queue) 2))) + +(defun elmo-dop-queue-append (folder method arguments) + "Append to disconnected operation queue." + (let ((queue (elmo-make-dop-queue (elmo-folder-name-internal folder) + method arguments))) + (setq elmo-dop-queue (nconc elmo-dop-queue (list queue))))) (defun elmo-dop-queue-flush (&optional force) - "Flush Disconnected operations. + "Flush disconnected operations. If optional argument FORCE is non-nil, try flushing all operation queues even an operation concerns the unplugged folder." - (elmo-dop-queue-load) ; load cache. (elmo-dop-queue-merge) (let ((queue elmo-dop-queue) (count 0) + folder len) - (while queue - (if (or force (elmo-folder-plugged-p (caar queue))) - (setq count (1+ count))) - (setq queue (cdr queue))) + ;; obsolete + (unless (or (null queue) + (vectorp (car queue))) + (when (y-or-n-p "Saved queue is old version(2.4). Clear all pending operations? ") + (setq elmo-dop-queue nil) + (message "All pending operations are cleared.") + (elmo-dop-queue-save))) + (setq count (length queue)) (when (> count 0) (if (elmo-y-or-n-p (format "%d pending operation(s) exists. Perform now? " count) @@ -81,502 +97,186 @@ even an operation concerns the unplugged folder." (setq i (+ 1 i)) (message "Flushing queue....%d/%d." i num) (condition-case err - (if (and (not force) - (not (elmo-folder-plugged-p (nth 0 (car queue))))) - (setq failure t) - (setq folder (nth 0 (car queue)) - func (nth 1 (car queue))) - (cond - ((string= func "prefetch-msgs") - (elmo-prefetch-msgs - folder - (nth 2 (car queue)))) ;argunemt - ((string= func "append-operations") - (elmo-dop-flush-pending-append-operations - folder nil t)) - (t - (elmo-call-func - folder - func - (nth 2 (car queue)) ;argunemt - )))) + (progn + (apply (elmo-dop-queue-method (car queue)) + (prog1 + (setq folder + (elmo-make-folder + (elmo-dop-queue-fname (car queue)))) + (elmo-folder-open folder)) + (elmo-dop-queue-arguments (car queue))) + (elmo-folder-close folder)) (quit (setq failure t)) (error (setq failure err))) (if failure - ;; create-folder was failed. - (when (and (string= func "create-folder-maybe") - (elmo-y-or-n-p - (format - "Create folder %s failed. Abort creating? " - folder) - (not elmo-dop-flush-confirm) t)) - (elmo-dop-save-pending-messages folder) - (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))) + (); (setq elmo-dop-queue (delq (car queue) elmo-dop-queue)) (setq performed (+ 1 performed))) (setq queue (cdr queue))) (message "%d/%d operation(s) are performed successfully." performed num) - (sit-for 1) ; + (sit-for 0) ; (elmo-dop-queue-save))) (if (elmo-y-or-n-p "Clear all pending operations? " (not elmo-dop-flush-confirm) t) - (let ((queue elmo-dop-queue)) - (while queue - (if (string= (nth 1 (car queue)) "append-operations") - (elmo-dop-append-list-save (nth 0 (car queue)) nil)) - (setq queue (cdr queue))) + (progn (setq elmo-dop-queue nil) (message "All pending operations are cleared.") (elmo-dop-queue-save)) (message ""))) count))) -(defconst elmo-dop-merge-funcs - '("delete-msgids" - "prefetch-msgs" - "unmark-important" - "mark-as-important" - "mark-as-read" - "mark-as-unread")) - +(defvar elmo-dop-merge-funcs nil) (defun elmo-dop-queue-merge () - (let ((queue elmo-dop-queue) - new-queue match-queue que) - (while (setq que (car queue)) - (if (and - (member (cadr que) elmo-dop-merge-funcs) - (setq match-queue - (car (delete nil - (mapcar '(lambda (new-queue) - (if (and - (string= (car que) (car new-queue)) - (string= (cadr que) (cadr new-queue))) - new-queue)) - new-queue))))) - (setcar (cddr match-queue) - (append (nth 2 match-queue) (nth 2 que))) - (setq new-queue (append new-queue (list que)))) - (setq queue (cdr queue))) - (setq elmo-dop-queue new-queue))) - -(defun elmo-dop-queue-load () - (save-excursion - (setq elmo-dop-queue - (elmo-object-load - (expand-file-name elmo-queue-filename - elmo-msgdb-dir))))) - -(defun elmo-dop-queue-save () - (save-excursion - (elmo-object-save - (expand-file-name elmo-queue-filename - elmo-msgdb-dir) - elmo-dop-queue))) - -(defun elmo-dop-lock-message (message-id &optional lock-list) - (let ((locked (or lock-list - (elmo-object-load - (expand-file-name - elmo-msgdb-lock-list-filename - elmo-msgdb-dir))))) - (setq locked (cons message-id locked)) - (elmo-object-save - (expand-file-name elmo-msgdb-lock-list-filename - elmo-msgdb-dir) - locked))) - -(defun elmo-dop-unlock-message (message-id &optional lock-list) - (let ((locked (or lock-list - (elmo-object-load - (expand-file-name elmo-msgdb-lock-list-filename - elmo-msgdb-dir))))) - (setq locked (delete message-id locked)) - (elmo-object-save - (expand-file-name elmo-msgdb-lock-list-filename - elmo-msgdb-dir) - locked))) - -(defun elmo-dop-lock-list-load () - (elmo-object-load - (expand-file-name elmo-msgdb-lock-list-filename - elmo-msgdb-dir))) - -(defun elmo-dop-lock-list-save (lock-list) - (elmo-object-save - (expand-file-name elmo-msgdb-lock-list-filename - elmo-msgdb-dir) - lock-list)) - -(defun elmo-dop-append-list-load (folder &optional resume) - (elmo-object-load - (expand-file-name (if resume - elmo-msgdb-resume-list-filename - elmo-msgdb-append-list-filename) - (elmo-msgdb-expand-path folder)))) - -(defun elmo-dop-append-list-save (folder append-list &optional resume) - (if append-list - (elmo-object-save - (expand-file-name (if resume - elmo-msgdb-resume-list-filename - elmo-msgdb-append-list-filename) - (elmo-msgdb-expand-path folder)) - append-list) - (condition-case () - (delete-file (expand-file-name (if resume - elmo-msgdb-resume-list-filename - elmo-msgdb-append-list-filename) - (elmo-msgdb-expand-path folder))) - (error)))) - -(defun elmo-dop-deleting-numbers-to-msgids (alist numbers appended) - "returns (new-appended . deleting-msgids)." - (let (msgid deleting-msgids) - (while numbers - (setq msgid (cdr (assq (car numbers) alist))) - (if (member msgid appended) - (setq appended (delete msgid appended)) - (setq deleting-msgids (append deleting-msgids (list msgid)))) - (setq numbers (cdr numbers))) - (cons appended deleting-msgids))) - -(defun elmo-dop-list-deleted (folder number-alist) - "List message numbers to be deleted on FOLDER from NUMBER-ALIST." - (elmo-dop-queue-load) - (let ((queue elmo-dop-queue) - numbers matches nalist) - (while queue - (if (and (string= (nth 0 (car queue)) folder) - (string= (nth 1 (car queue)) "delete-msgids")) - (setq numbers - (nconc numbers - (delq nil (mapcar - (lambda (x) - (mapcar 'car - (elmo-string-rassoc-all - x number-alist))) - (nth 2 (car queue))))))) - (setq queue (cdr queue))) - (elmo-uniq-list (elmo-flatten numbers)))) - -(defun elmo-dop-delete-msgs (folder msgs msgdb) - (save-match-data - (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs)) - appended-deleting) - (while folder-numbers - (if (eq (elmo-folder-get-type (car (car folder-numbers))) - 'imap4) - (if elmo-enable-disconnected-operation - (progn - (setq appended-deleting - (elmo-dop-deleting-numbers-to-msgids - (elmo-msgdb-get-number-alist msgdb) - msgs ; virtual number - (elmo-dop-append-list-load folder))) - (if (cdr appended-deleting) - (elmo-dop-queue-append - (car (car folder-numbers)) ; real folder - "delete-msgids" ;; for secure removal. - (cdr appended-deleting))) - (elmo-dop-append-list-save folder (car appended-deleting))) - (error "Unplugged")) - ;; not imap4 folder...delete now! - (elmo-call-func (car (car folder-numbers)) "delete-msgs" - (cdr (car folder-numbers)))) - (setq folder-numbers (cdr folder-numbers)))) - t)) - -(defun elmo-dop-prefetch-msgs (folder msgs) - (save-match-data - (elmo-dop-queue-append folder "prefetch-msgs" msgs))) - -(defun elmo-dop-list-folder (folder &optional nohide) - (if (or (memq (elmo-folder-get-type folder) - '(imap4 nntp pop3 filter pipe)) - (and (elmo-multi-p folder) (not (elmo-folder-local-p folder)))) - (if elmo-enable-disconnected-operation - (let* ((path (elmo-msgdb-expand-path folder)) - (number-alist (elmo-msgdb-number-load path)) - (number-list (mapcar 'car number-alist)) - (append-list (elmo-dop-append-list-load folder)) - (append-num (length append-list)) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load path))) - alreadies - max-num - (i 0)) - (setq killed (nconc (elmo-dop-list-deleted folder number-alist) - killed)) - (while append-list - (if (rassoc (car append-list) number-alist) - (setq alreadies (append alreadies - (list (car append-list))))) - (setq append-list (cdr append-list))) - (setq append-num (- append-num (length alreadies))) - (setq max-num - (or (nth (max (- (length number-list) 1) 0) - number-list) 0)) - (while (< i append-num) - (setq number-list - (append number-list - (list (+ max-num i 1)))) - (setq i (+ 1 i))) - (elmo-living-messages number-list killed)) - (error "Unplugged")) - ;; not imap4 folder...list folder - (elmo-call-func folder "list-folder"))) - -(defun elmo-dop-count-appended (folder) - (length (elmo-dop-append-list-load folder))) - -(defun elmo-dop-call-func-on-msgs (folder func-name msgs msgdb) - (let ((append-list (elmo-dop-append-list-load folder)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - matched) - (if (eq (elmo-folder-get-type folder) 'imap4) - (progn -;;; (while append-list -;;; (if (setq matched (car (rassoc (car append-list) number-alist))) -;;; (setq msgs (delete matched msgs))) -;;; (setq append-list (cdr append-list))) - (if msgs - (elmo-dop-queue-append folder func-name msgs))) - ;; maildir... XXX hard coding..... - (if (not (featurep 'elmo-maildir)) - (require 'maildir)) - (funcall (intern (format "elmo-maildir-%s" func-name)) - (elmo-folder-get-spec folder) - msgs msgdb)))) - -(defun elmo-dop-max-of-folder (folder) - (if (eq (elmo-folder-get-type folder) 'imap4) - (if elmo-enable-disconnected-operation - (let* ((number-alist (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder))) - (number-list (mapcar 'car number-alist)) - (append-list (elmo-dop-append-list-load folder)) - (append-num (length append-list)) - alreadies - (i 0) - max-num) - (while append-list - (if (rassoc (car append-list) number-alist) - (setq alreadies (append alreadies - (list (car append-list))))) - (setq append-list (cdr append-list))) - (setq max-num - (or (nth (max (- (length number-list) 1) 0) number-list) - 0)) - (cons (- (+ max-num append-num) (length alreadies)) - (- (+ (length number-list) append-num) (length alreadies)))) - (error "Unplugged")) - ;; not imap4 folder. - (elmo-call-func folder "max-of-folder"))) - -(defun elmo-dop-save-pending-messages (folder) - (message (format "Saving queued message in %s..." elmo-lost+found-folder)) - (let* ((append-list (elmo-dop-append-list-load folder)) - file-string) - (while append-list - (when (setq file-string (elmo-get-file-string ; message string - (elmo-cache-get-path - (car append-list)))) - (elmo-append-msg elmo-lost+found-folder file-string) - (elmo-dop-unlock-message (car append-list))) - (setq append-list (cdr append-list)) - (elmo-dop-append-list-save folder nil))) - (message (format "Saving queued message in %s...done" - elmo-lost+found-folder))) - -(defun elmo-dop-flush-pending-append-operations (folder &optional appends resume) - (message "Appending queued messages...") - (let* ((append-list (or appends - (elmo-dop-append-list-load folder))) - (appendings append-list) + ;; XXXX Not implemented yet. + ) + +;;; dop spool folder +(defmacro 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))))))) + +(defun elmo-dop-spool-folder-append-buffer (folder) + "Append current buffer content to the dop spool folder. +FOLDER is the folder structure. +Return a message number." + (setq folder (elmo-dop-spool-folder folder)) + (let ((new-number (1+ (car (elmo-folder-status folder))))) + (unless (elmo-folder-exists-p folder) + (elmo-folder-create folder)) + ;; dop folder is a localdir folder. + (write-region-as-binary (point-min) (point-max) + (expand-file-name + (int-to-string new-number) + (elmo-localdir-folder-directory-internal folder)) + nil 'no-msg) + new-number)) + + +(defun elmo-dop-spool-folder-list-messages (folder) + "List messages in the dop spool folder. +FOLDER is the folder structure." + (setq folder (elmo-dop-spool-folder folder)) + (if (elmo-folder-exists-p folder) + (elmo-folder-list-messages folder))) + +(defun elmo-dop-list-deleting-messages (folder) + "List messages which are on the deleting queue for the folder. +FOLDER is the folder structure." + (let (messages) + (dolist (queue elmo-dop-queue) + (if (and (string= (elmo-dop-queue-fname queue) + (elmo-folder-name-internal folder)) + (eq (elmo-dop-queue-method queue) + 'elmo-folder-delete-messages-dop-delayed)) + (setq messages (nconc messages + (mapcar + 'car + (car (elmo-dop-queue-arguments queue))))))))) + +;;; DOP operations. +(defsubst elmo-folder-append-buffer-dop (folder unread &optional number) + (elmo-dop-queue-append + folder 'elmo-folder-append-buffer-dop-delayed + (list unread + (elmo-dop-spool-folder-append-buffer + folder) + number))) + +(defsubst elmo-folder-delete-messages-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-delete-messages-dop-delayed + (list + (mapcar + (lambda (number) + (cons number (elmo-message-field + folder number 'message-id))) + numbers))) + t) + +(defsubst elmo-message-encache-dop (folder number) + (elmo-dop-queue-append folder 'elmo-message-encache (list number))) + +(defsubst elmo-create-folder-dop (folder) + (elmo-dop-queue-append folder 'elmo-folder-create nil)) + +(defsubst elmo-folder-mark-as-read-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-mark-as-read (list numbers))) + +(defsubst elmo-folder-unmark-read-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-unmark-read (list numbers))) + +(defsubst elmo-folder-mark-as-important-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-mark-as-important (list numbers))) + +(defsubst elmo-folder-unmark-important-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-unmark-important (list numbers))) + +;;; Execute as subsutitute for plugged operation. +(defun elmo-folder-status-dop (folder) + (let* ((number-alist (elmo-msgdb-number-load + (elmo-folder-msgdb-path folder))) + (number-list (mapcar 'car number-alist)) + (spool-folder (elmo-dop-spool-folder folder)) + spool-length (i 0) - (num (length append-list)) - failure file-string) - (when resume - ;; Resume msgdb changed by elmo-dop-msgdb-create. - (let* ((resumed-list (elmo-dop-append-list-load folder t)) - (number-alist (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder))) - (appendings append-list) - pair dels) - (while appendings - (if (setq pair (rassoc (car appendings) number-alist)) - (setq resumed-list (append resumed-list - (list (car appendings))))) - (setq appendings (cdr appendings))) - (elmo-dop-append-list-save folder resumed-list t))) - (while appendings - (let* ((seen-list (elmo-msgdb-seen-load - (elmo-msgdb-expand-path folder)))) - (setq failure nil) - (setq file-string (elmo-get-file-string ; message string - (elmo-cache-get-path - (car appendings)))) - (when file-string - (condition-case () - (elmo-append-msg folder file-string (car appendings) nil - (not (member (car appendings) seen-list))) - (quit (setq failure t)) - (error (setq failure t))) - (setq i (+ 1 i)) - (message (format "Appending queued messages...%d" i)) - (if failure - (elmo-append-msg elmo-lost+found-folder - file-string (car appendings) nil - (not (member (car appendings) seen-list))))) - (elmo-dop-unlock-message (car appendings)) - (setq appendings (cdr appendings)))) - ;; All pending append operation is flushed. - (elmo-dop-append-list-save folder nil) - (elmo-commit folder) - (unless resume - ;; delete '(folder "append-operations") in elmo-dop-queue. - (let (elmo-dop-queue) - (elmo-dop-queue-load) - (setq elmo-dop-queue (delete (list folder "append-operations" nil) - elmo-dop-queue)) - (elmo-dop-queue-save)))) - (message "Appending queued messages...done")) - -(defun elmo-dop-folder-exists-p (folder) - (or (file-exists-p (elmo-msgdb-expand-path folder)) - (if (and elmo-enable-disconnected-operation - (eq (elmo-folder-get-type folder) 'imap4)) - (file-exists-p (elmo-msgdb-expand-path folder)) - (elmo-call-func folder "folder-exists-p")))) - -(defun elmo-dop-create-folder (folder) - (if (eq (elmo-folder-get-type folder) 'imap4) - (if elmo-enable-disconnected-operation - (elmo-dop-queue-append folder "create-folder-maybe" nil) - (error "Unplugged")) - (elmo-call-func folder "create-folder"))) - -(defun elmo-dop-delete-folder (folder) - (error "Unplugged")) - -(defun elmo-dop-rename-folder (old-folder new-folder) - (error "Unplugged")) - -(defun elmo-dop-append-msg (folder string message-id &optional msg) - (if elmo-enable-disconnected-operation - (if message-id - (progn - (unless (elmo-cache-exists-p message-id) - (elmo-set-work-buf - (insert string) - (elmo-cache-save message-id nil folder msg (current-buffer)))) - (let ((append-list (elmo-dop-append-list-load folder)) - (number-alist (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder)))) - (when (and ; not in current folder. - (not (rassoc message-id number-alist)) - (not (member message-id append-list))) - (setq append-list - (append append-list (list message-id))) - (elmo-dop-lock-message message-id) - (elmo-dop-append-list-save folder append-list) - (elmo-dop-queue-append folder "append-operations" nil)) - t)) - nil) - (error "Unplugged"))) - -(defalias 'elmo-dop-msgdb-create 'elmo-dop-msgdb-create-as-numlist) - -(defun elmo-dop-msgdb-create-as-numlist (folder numlist new-mark already-mark - seen-mark important-mark - seen-list) - (if (or (eq (elmo-folder-get-type folder) 'imap4) - (eq (elmo-folder-get-type folder) 'nntp)) - (if elmo-enable-disconnected-operation - (let* ((num-alist (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder))) - (number-list (mapcar 'car num-alist)) - (ov (elmo-msgdb-overview-load - (elmo-msgdb-expand-path folder))) - (append-list (elmo-dop-append-list-load folder)) - (num (length numlist)) - (i 0) - overview number-alist mark-alist msgid ov-entity - max-num percent seen gmark) - (setq max-num - (or (nth (max (- (length number-list) 1) 0) number-list) - 0)) - (while numlist - (if (setq msgid - (nth (+ (length append-list) - (- (car numlist) max-num 1 num)) - append-list)) - (progn - (setq overview - (elmo-msgdb-append-element - overview - (elmo-localdir-msgdb-create-overview-entity-from-file - (car numlist) - (elmo-cache-get-path msgid)))) - (setq number-alist - (elmo-msgdb-number-add number-alist - (car numlist) msgid)) - (setq seen (member msgid seen-list)) - (if (setq gmark - (or (elmo-msgdb-global-mark-get msgid) - (if (elmo-cache-exists-p - msgid - folder - (car number-alist)) - (if seen - nil - already-mark) - (if seen - seen-mark) - new-mark))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist (car numlist) gmark)))) - - (when (setq ov-entity (assoc - (cdr (assq (car numlist) num-alist)) - ov)) - (setq overview - (elmo-msgdb-append-element - overview ov-entity)) - (setq number-alist - (elmo-msgdb-number-add number-alist - (car numlist) - (car ov-entity))) - (setq seen (member ov-entity seen-list)) - (if (setq gmark - (or (elmo-msgdb-global-mark-get (car ov-entity)) - (if (elmo-cache-exists-p - msgid - folder - (car ov-entity)) - (if seen - nil - already-mark) - (if seen - seen-mark) - new-mark))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist (car numlist) gmark))))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (setq percent (/ (* i 100) num)) - (elmo-display-progress - 'elmo-dop-msgdb-create-as-numlist "Creating msgdb..." - percent)) - (setq numlist (cdr numlist))) - (list overview number-alist mark-alist)) - (error "Unplugged")) - ;; not imap4 folder... - (elmo-call-func folder "msgdb-create" numlist new-mark already-mark - seen-mark important-mark seen-list))) + max-num) + (setq spool-length (length (car (if (elmo-folder-exists-p spool-folder) + (elmo-folder-status spool-folder))))) + (setq max-num + (or (nth (max (- (length number-list) 1) 0) number-list) + 0)) + (cons (+ max-num spool-length) (+ (length number-list) spool-length)))) + +;;; Delayed operation (executed at online status). +(defun elmo-folder-append-buffer-dop-delayed (folder unread number set-number) + (let ((spool-folder (elmo-dop-spool-folder folder))) + (with-temp-buffer + (elmo-message-fetch spool-folder number + (elmo-make-fetch-strategy 'entire) + nil (current-buffer) 'unread) + (condition-case nil + (elmo-folder-append-buffer folder unread set-number) + (error + ;; Append failed... + (elmo-folder-append-buffer (elmo-make-folder elmo-lost+found-folder) + unread set-number))) + (elmo-folder-delete-messages spool-folder (list number)) + t))) + +(defun elmo-folder-delete-messages-dop-delayed (folder number-alist) + (elmo-folder-delete-messages + folder + ;; messages are deleted only if message-id is not changed. + (mapcar 'car + (elmo-delete-if + (lambda (pair) + (not (string= + (cdr pair) + (elmo-message-fetch-field folder (car pair) + 'message-id)))) + number-alist)))) + +;;; Util +(defun elmo-dop-msgdb (msgdb) + (list (mapcar (function + (lambda (x) + (elmo-msgdb-overview-entity-set-number + x + (* -1 + (elmo-msgdb-overview-entity-get-number x))))) + (nth 0 msgdb)) + (mapcar (function + (lambda (x) (cons + (* -1 (car x)) + (cdr x)))) + (nth 1 msgdb)) + (mapcar (function + (lambda (x) (cons + (* -1 (car x)) + (cdr x)))) (nth 2 msgdb)))) (require 'product) (product-provide (provide 'elmo-dop) (require 'elmo-version)) diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index 4a3329d..ff4dc2b 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -28,110 +28,206 @@ ;;; Code: ;; -(require 'elmo-msgdb) - -(defun elmo-filter-msgdb-create (spec numlist new-mark already-mark - seen-mark important-mark seen-list) - (if (eq (nth 2 spec) 'partial) - (elmo-msgdb-create (nth 2 spec) - numlist - new-mark - already-mark - seen-mark important-mark seen-list) - (elmo-msgdb-create-as-numlist (nth 2 spec) - numlist - new-mark - already-mark - seen-mark important-mark seen-list))) - -(defun elmo-filter-msgdb-create-as-numlist (spec numlist new-mark already-mark - seen-mark important-mark - seen-list) - (elmo-msgdb-create-as-numlist (nth 2 spec) - numlist - new-mark - already-mark - seen-mark important-mark seen-list)) - -(defun elmo-filter-list-folders (spec &optional hierarchy) - nil) - -(defun elmo-filter-append-msg (spec string &optional msg no-see) - (elmo-call-func (nth 2 spec) "append" string)) - -(defun elmo-filter-read-msg (spec number outbuf &optional msgdb unread) - (elmo-call-func (nth 2 spec) "read-msg" number outbuf msgdb unread)) - -(defun elmo-filter-delete-msgs (spec msgs) - (elmo-call-func (nth 2 spec) "delete-msgs" msgs)) - -(defun elmo-filter-list-folder (spec &optional nohide) - (elmo-search (nth 2 spec) (nth 1 spec))) - -(defun elmo-filter-list-folder-unread (spec number-alist mark-alist - unread-marks) - (elmo-list-filter - (mapcar 'car number-alist) - (elmo-list-folder-unread - (nth 2 spec) number-alist mark-alist unread-marks))) - -(defun elmo-filter-list-folder-important (spec number-alist) - (elmo-list-filter - (mapcar 'car number-alist) - (elmo-list-folder-important (nth 2 spec) number-alist))) - -(defun elmo-filter-folder-diff (spec folder &optional number-list) - (if (or (elmo-multi-p folder) - (not (and (vectorp (nth 1 spec)) - (string-match "^last$" - (elmo-filter-key (nth 1 spec)))))) - (cons nil (cdr (elmo-folder-diff (nth 2 spec)))) - (elmo-generic-folder-diff spec folder number-list))) - -(defun elmo-filter-max-of-folder (spec) - (elmo-max-of-folder (nth 2 spec))) - -(defun elmo-filter-folder-exists-p (spec) - (elmo-folder-exists-p (nth 2 spec))) - -(defun elmo-filter-folder-creatable-p (spec) - (elmo-call-func (nth 2 spec) "folder-creatable-p")) - -(defun elmo-filter-create-folder (spec) - (elmo-create-folder (nth 2 spec))) - -(defun elmo-filter-search (spec condition &optional from-msgs) +(require 'elmo) + +;;; ELMO filter folder +(eval-and-compile + (luna-define-class elmo-filter-folder (elmo-folder) + (condition target)) + (luna-define-internal-accessors 'elmo-filter-folder)) + +(luna-define-method elmo-folder-initialize ((folder elmo-filter-folder) + name) + (let (pair) + (setq pair (elmo-parse-search-condition name)) + (elmo-filter-folder-set-condition-internal folder + (car pair)) + (if (string-match "^ */\\(.*\\)$" (cdr pair)) + (elmo-filter-folder-set-target-internal + folder + (elmo-make-folder (elmo-match-string 1 (cdr pair)))) + (error "Folder syntax error `%s'" (elmo-folder-name-internal folder))) + folder)) + +(luna-define-method elmo-folder-open-internal ((folder elmo-filter-folder)) + (elmo-folder-open-internal (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-check ((folder elmo-filter-folder)) + (elmo-folder-check (elmo-filter-folder-target-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-expand-msgdb-path ((folder + elmo-filter-folder)) + (expand-file-name + (elmo-replace-string-as-filename (elmo-folder-name-internal folder)) + (expand-file-name "filter" elmo-msgdb-dir))) + +(luna-define-method elmo-find-fetch-strategy + ((folder elmo-filter-folder) entity &optional ignore-cache) + (elmo-find-fetch-strategy + (elmo-filter-folder-target-internal folder) + entity ignore-cache)) + +(luna-define-method elmo-folder-get-primitive-list ((folder + elmo-filter-folder)) + (list (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-contains-type ((folder elmo-filter-folder) + type) + (elmo-folder-contains-type + (elmo-filter-folder-target-internal folder) + type)) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-filter-folder) + numlist new-mark already-mark + seen-mark important-mark + seen-list) + (elmo-folder-msgdb-create (elmo-filter-folder-target-internal folder) + numlist + new-mark + already-mark + seen-mark important-mark seen-list)) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-filter-folder) + unread &optional number) + (elmo-folder-append-buffer + (elmo-filter-folder-target-internal folder) + unread number)) + +(luna-define-method elmo-message-fetch ((folder elmo-filter-folder) + number strategy + &optional section outbuf unseen) + (elmo-message-fetch + (elmo-filter-folder-target-internal folder) + number strategy section outbuf unseen)) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-filter-folder) + numbers) + (elmo-folder-delete-messages + (elmo-filter-folder-target-internal folder) numbers)) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-filter-folder) &optional nohide) + (elmo-folder-search (elmo-filter-folder-target-internal folder) + (elmo-filter-folder-condition-internal folder))) + +(defsubst elmo-filter-folder-list-unreads-internal (folder unread-marks + mark-alist) + (let ((unreads (elmo-folder-list-unreads-internal + (elmo-filter-folder-target-internal folder) + unread-marks mark-alist))) + (unless (listp unreads) + (setq unreads + (delq nil + (mapcar + (function + (lambda (x) + (if (member (cadr x) unread-marks) + (car x)))) + (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))) + (elmo-list-filter + (mapcar 'car (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder))) + unreads))) + +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-filter-folder) + unread-marks &optional mark-alist) + (elmo-filter-folder-list-unreads-internal folder unread-marks mark-alist)) + +(defsubst elmo-filter-folder-list-importants-internal (folder important-mark) + (let ((importants (elmo-folder-list-importants-internal + (elmo-filter-folder-target-internal folder) + important-mark))) + (if (listp importants) + (elmo-list-filter + (mapcar 'car (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder))) + importants) + t))) + +(luna-define-method elmo-folder-list-importants-internal + ((folder elmo-filter-folder) + important-mark) + (elmo-filter-folder-list-importants-internal folder important-mark)) + +(luna-define-method elmo-folder-diff :around ((folder elmo-filter-folder) + &optional numbers) + (if (not (and (vectorp (elmo-filter-folder-condition-internal + folder)) + (string-match "^last$" + (elmo-filter-key + (elmo-filter-folder-condition-internal + folder))))) + (cons nil (cdr (elmo-folder-diff (elmo-filter-folder-target-internal + folder)))) + (luna-call-next-method))) + +(luna-define-method elmo-folder-status ((folder elmo-filter-folder)) + (elmo-folder-status + (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-filter-folder)) + (elmo-folder-exists-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-filter-folder)) + (elmo-folder-creatable-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-create ((folder elmo-filter-folder)) + (elmo-folder-create (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-search ((folder elmo-filter-folder) + condition &optional numbers) ;; search from messages in this folder (elmo-list-filter - from-msgs - (elmo-search (nth 2 spec) condition - (elmo-filter-list-folder spec)))) - -(defun elmo-filter-use-cache-p (spec number) - (elmo-call-func (nth 2 spec) "use-cache-p" number)) - -(defun elmo-filter-local-file-p (spec number) - (elmo-call-func (nth 2 spec) "local-file-p" number)) - -(defun elmo-filter-commit (spec) - (elmo-commit (nth 2 spec))) - -(defun elmo-filter-plugged-p (spec) - (elmo-folder-plugged-p (nth 2 spec))) - -(defun elmo-filter-set-plugged (spec plugged add) - (elmo-folder-set-plugged (nth 2 spec) plugged add)) - -(defun elmo-filter-get-msg-filename (spec number &optional loc-alist) - ;; This function may be called when elmo-filter-local-file-p() - ;; returns t. - (elmo-call-func (nth 2 spec) "get-msg-filename" number loc-alist)) - -(defun elmo-filter-sync-number-alist (spec number-alist) - (elmo-call-func (nth 2 spec) "sync-number-alist" number-alist)) + numbers + (elmo-folder-search (elmo-filter-folder-target-internal folder) + condition + (elmo-folder-list-messages folder)))) + +(luna-define-method elmo-message-use-cache-p ((folder elmo-filter-folder) + number) + (elmo-message-use-cache-p (elmo-filter-folder-target-internal folder) + number)) + +(luna-define-method elmo-folder-message-file-p ((folder elmo-filter-folder)) + (elmo-folder-message-file-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-plugged-p ((folder elmo-filter-folder)) + (elmo-folder-plugged-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-set-plugged ((folder elmo-filter-folder) + plugged &optional add) + (elmo-folder-set-plugged (elmo-filter-folder-target-internal folder) + plugged add)) + +(luna-define-method elmo-message-file-name ((folder elmo-filter-folder) + number) + (elmo-message-file-name (elmo-filter-folder-target-internal folder) + number)) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-filter-folder) + numbers) + (elmo-folder-mark-as-read (elmo-filter-folder-target-internal folder) + numbers)) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-filter-folder) + numbers) + (elmo-folder-unmark-read (elmo-filter-folder-target-internal folder) + numbers)) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-filter-folder) + numbers) + (elmo-folder-mark-as-important (elmo-filter-folder-target-internal folder) + numbers)) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-filter-folder) + numbers) + (elmo-folder-unmark-important (elmo-filter-folder-target-internal folder) + numbers)) -(defun elmo-filter-server-diff (spec) - (elmo-call-func (nth 2 spec) "server-diff")) (require 'product) (product-provide (provide 'elmo-filter) (require 'elmo-version)) diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 52e4996..d7339e6 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -40,17 +40,79 @@ (require 'elmo-vars) (require 'elmo-util) -(require 'elmo-msgdb) (require 'elmo-date) +(require 'elmo-msgdb) (require 'elmo-cache) +(require 'elmo) (require 'elmo-net) (require 'utf7) +(require 'elmo-mime) ;;; Code: (eval-when-compile (require 'cl)) -(defvar elmo-imap4-use-lock t - "USE IMAP4 with locking process.") +;;; User options. +(defcustom elmo-imap4-default-mailbox "inbox" + "*Default IMAP4 mailbox." + :type 'string + :group 'elmo) + +(defcustom elmo-imap4-default-server "localhost" + "*Default IMAP4 server." + :type 'string + :group 'elmo) + +(defcustom elmo-imap4-default-authenticate-type 'login + "*Default Authentication type for IMAP4." + :type 'symbol + :group 'elmo) + +(defcustom elmo-imap4-default-user (or (getenv "USER") + (getenv "LOGNAME") + (user-login-name)) + "*Default username for IMAP4." + :type 'string + :group 'elmo) + +(defcustom elmo-imap4-default-port 143 + "*Default Port number of IMAP." + :type 'integer + :group 'elmo) + +(defcustom elmo-imap4-default-stream-type nil + "*Default stream type for IMAP4. +Any symbol value of `elmo-network-stream-type-alist' or +`elmo-imap4-stream-type-alist'." + :type 'symbol + :group 'elmo) + +(defvar elmo-imap4-stream-type-alist nil + "*Stream bindings for IMAP4. +This is taken precedence over `elmo-network-stream-type-alist'.") + +(defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd + "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored. +(Except `\\Deleted' flag).") + +(defvar elmo-imap4-overview-fetch-chop-length 200 + "*Number of overviews to fetch in one request in imap4.") + +(defvar elmo-imap4-force-login nil + "*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.") + +(defvar elmo-imap4-use-select-to-update-status nil + "*Some imapd have to send select command to update status. +(ex. UW imapd 4.5-BETA?). For these imapd, you must set this variable t.") + +(defvar elmo-imap4-use-modified-utf7 nil + "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.") + +(defvar elmo-imap4-use-cache t + "Use cache in imap4 folder.") + +(defvar elmo-imap4-extra-namespace-alist + '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox... + "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).") ;; ;;; internal variables ;; @@ -64,10 +126,6 @@ (defvar elmo-imap4-reached-tag "elmo-imap40") ;;; buffer local variables - -(defvar elmo-imap4-extra-namespace-alist - '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox... - "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).") (defvar elmo-imap4-default-hierarchy-delimiter "/") (defvar elmo-imap4-server-capability nil) @@ -106,7 +164,6 @@ elmo-imap4-status-callback-data elmo-imap4-current-msgdb)) -(defvar elmo-imap4-display-literal-progress nil) ;;;; (defconst elmo-imap4-quoted-specials-list '(?\\ ?\")) @@ -131,36 +188,26 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") (defvar elmo-imap4-debug-inhibit-logging nil) -;;; +;;; ELMO IMAP4 folder +(eval-and-compile + (luna-define-class elmo-imap4-folder (elmo-net-folder) + (mailbox)) + (luna-define-internal-accessors 'elmo-imap4-folder)) +;;; Session (eval-and-compile (luna-define-class elmo-imap4-session (elmo-network-session) (capability current-mailbox read-only)) (luna-define-internal-accessors 'elmo-imap4-session)) -;;; imap4 spec - -(defsubst elmo-imap4-spec-mailbox (spec) - (nth 1 spec)) - -(defsubst elmo-imap4-spec-username (spec) - (nth 2 spec)) - -(defsubst elmo-imap4-spec-auth (spec) - (nth 3 spec)) - -(defsubst elmo-imap4-spec-hostname (spec) - (nth 4 spec)) - -(defsubst elmo-imap4-spec-port (spec) - (nth 5 spec)) - -(defsubst elmo-imap4-spec-stream-type (spec) - (nth 6 spec)) - +;;; MIME-ELMO-IMAP Location +(eval-and-compile + (luna-define-class mime-elmo-imap-location + (mime-imap-location) + (folder number rawbuf strategy)) + (luna-define-internal-accessors 'mime-elmo-imap-location)) ;;; Debug - (defsubst elmo-imap4-debug (message &rest args) (if elmo-imap4-debug (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*") @@ -169,6 +216,17 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") (insert "NO LOGGING\n") (insert (apply 'format message args) "\n"))))) + +(defsubst elmo-imap4-decode-folder-string (string) + (if elmo-imap4-use-modified-utf7 + (utf7-decode-string string 'imap) + string)) + +(defsubst elmo-imap4-encode-folder-string (string) + (if elmo-imap4-use-modified-utf7 + (utf7-encode-string string 'imap) + string)) + ;;; Response (defmacro elmo-imap4-response-continue-req-p (response) @@ -360,6 +418,42 @@ If response is not `OK' response, causes error with IMAP response text." (error "IMAP error: %s" (or (elmo-imap4-response-error-text response) "No `OK' response from server.")))))) + + + +;;; MIME-ELMO-IMAP Location +(luna-define-method mime-imap-location-section-body ((location + mime-elmo-imap-location) + section) + (if (and (stringp section) + (string= section "HEADER")) + ;; Even in the section mode, header fields should be saved to the + ;; raw buffer . + (with-current-buffer (mime-elmo-imap-location-rawbuf-internal location) + (erase-buffer) + (elmo-message-fetch + (mime-elmo-imap-location-folder-internal location) + (mime-elmo-imap-location-number-internal location) + (mime-elmo-imap-location-strategy-internal location) + section + (current-buffer) + 'unseen) + (buffer-string)) + (elmo-message-fetch + (mime-elmo-imap-location-folder-internal location) + (mime-elmo-imap-location-number-internal location) + (mime-elmo-imap-location-strategy-internal location) + section + nil 'unseen))) + + +(luna-define-method mime-imap-location-bodystructure + ((location mime-elmo-imap-location)) + (elmo-imap4-fetch-bodystructure + (mime-elmo-imap-location-folder-internal location) + (mime-elmo-imap-location-number-internal location) + (mime-elmo-imap-location-strategy-internal location))) + ;;; (defun elmo-imap4-session-check (session) @@ -503,193 +597,52 @@ BUFFER must be a single-byte buffer." (car (nth 1 entry)))) response))) -;;; Backend methods. -(defun elmo-imap4-list-folders (spec &optional hierarchy) - (let* ((root (elmo-imap4-spec-mailbox spec)) - (session (elmo-imap4-get-session spec)) - (delim (or - (cdr - (elmo-string-matched-assoc - root - (with-current-buffer (elmo-network-session-buffer session) - elmo-imap4-server-namespace))) - elmo-imap4-default-hierarchy-delimiter)) - result append-serv type) - ;; Append delimiter - (if (and root - (not (string= root "")) - (not (string-match (concat "\\(.*\\)" - (regexp-quote delim) - "\\'") - root))) - (setq root (concat root delim))) - (setq result (elmo-imap4-response-get-selectable-mailbox-list - (elmo-imap4-send-command-wait - session - (list "list " (elmo-imap4-mailbox root) " *")))) - (unless (string= (elmo-imap4-spec-username spec) - elmo-default-imap4-user) - (setq append-serv (concat ":" (elmo-imap4-spec-username spec)))) - (unless (eq (elmo-imap4-spec-auth spec) - (or elmo-default-imap4-authenticate-type 'clear)) - (setq append-serv - (concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec))))) - (unless (string= (elmo-imap4-spec-hostname spec) - elmo-default-imap4-server) - (setq append-serv (concat append-serv "@" (elmo-imap4-spec-hostname - spec)))) - (unless (eq (elmo-imap4-spec-port spec) - elmo-default-imap4-port) - (setq append-serv (concat append-serv ":" - (int-to-string - (elmo-imap4-spec-port spec))))) - (setq type (elmo-imap4-spec-stream-type spec)) - (unless (eq (elmo-network-stream-type-symbol type) - elmo-default-imap4-stream-type) - (if type - (setq append-serv (concat append-serv - (elmo-network-stream-type-spec-string - type))))) - (if hierarchy - (let (folder folders ret) - (while (setq folders (car result)) - (if (prog1 - (string-match - (concat "^\\(" root "[^" delim "]" "+\\)" delim) - folders) - (setq folder (match-string 1 folders))) - (progn - (setq ret - (append ret (list (list - (concat "%" (elmo-imap4-decode-folder-string folder) - (and append-serv - (eval append-serv))))))) - (setq result - (delq nil - (mapcar '(lambda (fld) - (unless - (string-match - (concat "^" (regexp-quote folder) delim) - fld) - fld)) - result)))) - (setq ret (append ret (list - (concat "%" (elmo-imap4-decode-folder-string folders) - (and append-serv - (eval append-serv)))))) - (setq result (cdr result)))) - ret) - (mapcar (lambda (fld) - (concat "%" (elmo-imap4-decode-folder-string fld) - (and append-serv - (eval append-serv)))) - result)))) - -(defun elmo-imap4-folder-exists-p (spec) - (let ((session (elmo-imap4-get-session spec))) - (if (string= - (elmo-imap4-session-current-mailbox-internal session) - (elmo-imap4-spec-mailbox spec)) - t +(defun elmo-imap4-fetch-bodystructure (folder number strategy) + "Fetch BODYSTRUCTURE for the message in the FOLDER with NUMBER using STRATEGY." + (if (elmo-fetch-strategy-use-cache strategy) + (elmo-object-load + (elmo-file-cache-expand-path + (elmo-fetch-strategy-cache-path strategy) + "bodystructure")) + (let ((session (elmo-imap4-get-session folder)) + bodystructure) (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec) - 'force 'no-error)))) - -(defun elmo-imap4-folder-creatable-p (spec) - t) - -(defun elmo-imap4-create-folder-maybe (spec dummy) - (unless (elmo-imap4-folder-exists-p spec) - (elmo-imap4-create-folder spec))) + (elmo-imap4-folder-mailbox-internal folder)) + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-fetch-callback nil) + (setq elmo-imap4-fetch-callback-data nil)) + (prog1 (setq bodystructure + (elmo-imap4-response-value + (elmo-imap4-response-value + (elmo-imap4-send-command-wait + session + (format + (if elmo-imap4-use-uid + "uid fetch %s bodystructure" + "fetch %s bodystructure") + number)) + 'fetch) + 'bodystructure)) + (when (elmo-fetch-strategy-save-cache strategy) + (elmo-file-cache-delete + (elmo-fetch-strategy-cache-path strategy)) + (elmo-object-save + (elmo-file-cache-expand-path + (elmo-fetch-strategy-cache-path strategy) + "bodystructure") + bodystructure)))))) -(defun elmo-imap4-create-folder (spec) +;;; Backend methods. +(luna-define-method elmo-create-folder-plugged ((folder elmo-imap4-folder)) (elmo-imap4-send-command-wait - (elmo-imap4-get-session spec) + (elmo-imap4-get-session folder) (list "create " (elmo-imap4-mailbox - (elmo-imap4-spec-mailbox spec))))) - -(defun elmo-imap4-delete-folder (spec) - (let ((session (elmo-imap4-get-session spec)) - msgs) - (when (elmo-imap4-spec-mailbox spec) - (when (setq msgs (elmo-imap4-list-folder spec)) - (elmo-imap4-delete-msgs spec msgs)) - (elmo-imap4-send-command-wait session "close") - (elmo-imap4-send-command-wait - session - (list "delete " - (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))))))) + (elmo-imap4-folder-mailbox-internal folder))))) -(defun elmo-imap4-rename-folder (old-spec new-spec) - (let ((session (elmo-imap4-get-session old-spec))) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox old-spec)) - (elmo-imap4-send-command-wait session "close") - (elmo-imap4-send-command-wait - session - (list "rename " - (elmo-imap4-mailbox - (elmo-imap4-spec-mailbox old-spec)) - " " - (elmo-imap4-mailbox - (elmo-imap4-spec-mailbox new-spec)))))) - -(defun elmo-imap4-max-of-folder (spec) - (let ((session (elmo-imap4-get-session spec)) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - status) - (with-current-buffer (elmo-network-session-buffer session) - (setq elmo-imap4-status-callback nil) - (setq elmo-imap4-status-callback-data nil)) - (setq status (elmo-imap4-response-value - (elmo-imap4-send-command-wait - session - (list "status " - (elmo-imap4-mailbox - (elmo-imap4-spec-mailbox spec)) - " (uidnext messages)")) - 'status)) - (cons - (- (elmo-imap4-response-value status 'uidnext) 1) - (if killed - (- - (elmo-imap4-response-value status 'messages) - (elmo-msgdb-killed-list-length killed)) - (elmo-imap4-response-value status 'messages))))) +(defun elmo-imap4-get-session (folder &optional if-exists) + (elmo-network-get-session 'elmo-imap4-session "IMAP" folder if-exists)) -(defun elmo-imap4-folder-diff (spec folder &optional number-list) - (if elmo-use-server-diff - (elmo-imap4-server-diff spec) - (elmo-generic-folder-diff spec folder number-list))) - -(defun elmo-imap4-get-session (spec &optional if-exists) - (elmo-network-get-session - 'elmo-imap4-session - "IMAP" - (elmo-imap4-spec-hostname spec) - (elmo-imap4-spec-port spec) - (elmo-imap4-spec-username spec) - (elmo-imap4-spec-auth spec) - (elmo-imap4-spec-stream-type spec) - if-exists)) - -(defun elmo-imap4-commit (spec) - (if (elmo-imap4-plugged-p spec) - (let ((session (elmo-imap4-get-session spec 'if-exists))) - (when session - (if (string= - (elmo-imap4-session-current-mailbox-internal session) - (elmo-imap4-spec-mailbox spec)) - (if elmo-imap4-use-select-to-update-status - (elmo-imap4-session-select-mailbox - session - (elmo-imap4-spec-mailbox spec) - 'force) - (elmo-imap4-session-check session))))))) - (defun elmo-imap4-session-select-mailbox (session mailbox &optional force no-error) "Select MAILBOX in SESSION. @@ -739,10 +692,11 @@ Returns response value if selecting folder succeed. " ;; Not used. ) -(defun elmo-imap4-list (spec flag) - (let ((session (elmo-imap4-get-session spec))) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) +(defun elmo-imap4-list (folder flag) + (let ((session (elmo-imap4-get-session folder))) + (elmo-imap4-session-select-mailbox + session + (elmo-imap4-folder-mailbox-internal folder)) (elmo-imap4-response-value (elmo-imap4-send-command-wait session @@ -750,154 +704,6 @@ Returns response value if selecting folder succeed. " "search %s") flag)) 'search))) -(defun elmo-imap4-list-folder (spec &optional nohide) - (let* ((killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - (max (elmo-msgdb-max-of-killed killed)) - numbers) - (setq numbers (elmo-imap4-list spec - (if (or nohide - (null (eq max 0))) - (format "uid %d:*" (1+ max)) - "all"))) - (elmo-living-messages numbers killed))) - -(defun elmo-imap4-list-folder-unread (spec number-alist mark-alist - unread-marks) - (if (and (elmo-imap4-plugged-p spec) - (elmo-imap4-use-flag-p spec)) - (elmo-imap4-list spec "unseen") - (elmo-generic-list-folder-unread spec number-alist mark-alist - unread-marks))) - -(defun elmo-imap4-list-folder-important (spec number-alist) - (if (and (elmo-imap4-plugged-p spec) - (elmo-imap4-use-flag-p spec)) - (elmo-imap4-list spec "flagged"))) - -(defmacro elmo-imap4-detect-search-charset (string) - (` (with-temp-buffer - (insert (, string)) - (detect-mime-charset-region (point-min) (point-max))))) - -(defun elmo-imap4-search-internal-primitive (spec session filter from-msgs) - (let ((search-key (elmo-filter-key filter)) - (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to")) - charset) - (cond - ((string= "last" search-key) - (let ((numbers (or from-msgs (elmo-imap4-list-folder spec)))) - (nthcdr (max (- (length numbers) - (string-to-int (elmo-filter-value filter))) - 0) - numbers))) - ((string= "first" search-key) - (let* ((numbers (or from-msgs (elmo-imap4-list-folder spec))) - (rest (nthcdr (string-to-int (elmo-filter-value filter) ) - numbers))) - (mapcar '(lambda (x) (delete x numbers)) rest) - numbers)) - ((or (string= "since" search-key) - (string= "before" search-key)) - (setq search-key (concat "sent" search-key)) - (elmo-imap4-response-value - (elmo-imap4-send-command-wait session - (format - (if elmo-imap4-use-uid - "uid search %s%s%s %s" - "search %s%s%s %s") - (if from-msgs - (concat - (if elmo-imap4-use-uid "uid ") - (cdr - (car - (elmo-imap4-make-number-set-list - from-msgs))) - " ") - "") - (if (eq (elmo-filter-type filter) - 'unmatch) - "not " "") - search-key - (elmo-date-get-description - (elmo-date-get-datevec - (elmo-filter-value filter))))) - 'search)) - (t - (setq charset - (if (eq (length (elmo-filter-value filter)) 0) - (setq charset 'us-ascii) - (elmo-imap4-detect-search-charset - (elmo-filter-value filter)))) - (elmo-imap4-response-value - (elmo-imap4-send-command-wait session - (list - (if elmo-imap4-use-uid "uid ") - "search " - "CHARSET " - (elmo-imap4-astring - (symbol-name charset)) - " " - (if from-msgs - (concat - (if elmo-imap4-use-uid "uid ") - (cdr - (car - (elmo-imap4-make-number-set-list - from-msgs))) - " ") - "") - (if (eq (elmo-filter-type filter) - 'unmatch) - "not " "") - (format "%s%s " - (if (member - (elmo-filter-key filter) - imap-search-keys) - "" - "header ") - (elmo-filter-key filter)) - (elmo-imap4-astring - (encode-mime-charset-string - (elmo-filter-value filter) charset)))) - 'search))))) - -(defun elmo-imap4-search-internal (spec session condition from-msgs) - (let (result) - (cond - ((vectorp condition) - (setq result (elmo-imap4-search-internal-primitive - spec session condition from-msgs))) - ((eq (car condition) 'and) - (setq result (elmo-imap4-search-internal spec session (nth 1 condition) - from-msgs) - result (elmo-list-filter result - (elmo-imap4-search-internal - spec session (nth 2 condition) - from-msgs)))) - ((eq (car condition) 'or) - (setq result (elmo-imap4-search-internal - spec session (nth 1 condition) from-msgs) - result (elmo-uniq-list - (nconc result - (elmo-imap4-search-internal - spec session (nth 2 condition) from-msgs))) - result (sort result '<)))))) - - -(defun elmo-imap4-search (spec condition &optional from-msgs) - (save-excursion - (let ((session (elmo-imap4-get-session spec))) - (elmo-imap4-session-select-mailbox - session - (elmo-imap4-spec-mailbox spec)) - (elmo-imap4-search-internal spec session condition from-msgs)))) - -(defun elmo-imap4-use-flag-p (spec) - (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp - (elmo-imap4-spec-mailbox spec)))) - (static-cond ((fboundp 'float) ;; Emacs can parse dot symbol. @@ -973,89 +779,12 @@ If CHOP-LENGTH is not specified, message set is not chopped." (nreverse set-list))) ;; -;; set mark -;; read-mark -> "\\Seen" -;; important -> "\\Flagged" -;; -;; (delete -> \\Deleted) -(defun elmo-imap4-mark-set-on-msgs (spec msgs mark &optional unmark no-expunge) - "SET flag of MSGS as MARK. -If optional argument UNMARK is non-nil, unmark." - (let ((session (elmo-imap4-get-session spec)) - set-list) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) - (setq set-list (elmo-imap4-make-number-set-list msgs)) - (when set-list - (with-current-buffer (elmo-network-session-buffer session) - (setq elmo-imap4-fetch-callback nil) - (setq elmo-imap4-fetch-callback-data nil)) - (elmo-imap4-send-command-wait - session - (format - (if elmo-imap4-use-uid - "uid store %s %sflags.silent (%s)" - "store %s %sflags.silent (%s)") - (cdr (car set-list)) - (if unmark "-" "+") - mark)) - (unless no-expunge - (elmo-imap4-send-command-wait session "expunge"))) - t)) - -(defun elmo-imap4-mark-as-important (spec msgs) - (and (elmo-imap4-use-flag-p spec) - (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" nil 'no-expunge))) - -(defun elmo-imap4-mark-as-read (spec msgs) - (and (elmo-imap4-use-flag-p spec) - (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" nil 'no-expunge))) - -(defun elmo-imap4-unmark-important (spec msgs) - (and (elmo-imap4-use-flag-p spec) - (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" 'unmark - 'no-expunge))) - -(defun elmo-imap4-mark-as-unread (spec msgs) - (and (elmo-imap4-use-flag-p spec) - (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" 'unmark 'no-expunge))) - -(defun elmo-imap4-delete-msgs (spec msgs) - (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted")) - -(defun elmo-imap4-delete-msgs-no-expunge (spec msgs) - (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted" nil 'no-expunge)) - -(defun elmo-imap4-msgdb-create-as-numlist (spec numlist new-mark already-mark - seen-mark important-mark - seen-list) - "Create msgdb for SPEC for NUMLIST." - (elmo-imap4-msgdb-create spec numlist new-mark already-mark - seen-mark important-mark seen-list t)) - -;; Current buffer is process buffer. -(defun elmo-imap4-fetch-callback (element app-data) - (funcall elmo-imap4-fetch-callback - (with-temp-buffer - (insert (or (elmo-imap4-response-bodydetail-text element) - "")) - ;; Delete CR. - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - (elmo-msgdb-create-overview-from-buffer - (elmo-imap4-response-value element 'uid) - (elmo-imap4-response-value element 'rfc822size))) - (elmo-imap4-response-value element 'flags) - app-data)) - -;; ;; app-data: ;; cons of list ;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark ;; 4: seen-list ;; and result of use-flag-p. -(defun elmo-imap4-fetch-callback-1 (entity flags app-data) +(defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data) "A msgdb entity callback function." (let* ((use-flag (cdr app-data)) (app-data (car app-data)) @@ -1064,7 +793,8 @@ If optional argument UNMARK is non-nil, unmark." (if (member "\\Flagged" flags) (elmo-msgdb-global-mark-set (car entity) (nth 3 app-data))) (setq mark (or (elmo-msgdb-global-mark-get (car entity)) - (if (elmo-cache-exists-p (car entity)) ;; XXX + (if (elmo-file-cache-status + (elmo-file-cache-get (car entity))) (if (or seen (and use-flag (member "\\Seen" flags))) @@ -1087,52 +817,21 @@ If optional argument UNMARK is non-nil, unmark." (list (elmo-msgdb-overview-entity-get-number entity) mark)))))))) -(defun elmo-imap4-msgdb-create (spec numlist &rest args) - "Create msgdb for SPEC." - (when numlist - (let ((session (elmo-imap4-get-session spec)) - (headers - (append - '("Subject" "From" "To" "Cc" "Date" - "Message-Id" "References" "In-Reply-To") - elmo-msgdb-extra-fields)) - (total 0) - (length (length numlist)) - rfc2060 set-list) - (setq rfc2060 (memq 'imap4rev1 - (elmo-imap4-session-capability-internal - session))) - (message "Getting overview...") - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) - (setq set-list (elmo-imap4-make-number-set-list - numlist - elmo-imap4-overview-fetch-chop-length)) - ;; Setup callback. - (with-current-buffer (elmo-network-session-buffer session) - (setq elmo-imap4-current-msgdb nil - elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1 - elmo-imap4-fetch-callback-data (cons args - (elmo-imap4-use-flag-p - spec))) - (while set-list - (elmo-imap4-send-command-wait - session - ;; get overview entity from IMAP4 - (format "%sfetch %s (%s rfc822.size flags)" - (if elmo-imap4-use-uid "uid " "") - (cdr (car set-list)) - (if rfc2060 - (format "body.peek[header.fields %s]" headers) - (format "%s" headers)))) - (when (> length elmo-display-progress-threshold) - (setq total (+ total (car (car set-list)))) - (elmo-display-progress - 'elmo-imap4-msgdb-create "Getting overview..." - (/ (* total 100) length))) - (setq set-list (cdr set-list))) - (message "Getting overview...done") - elmo-imap4-current-msgdb)))) +;; Current buffer is process buffer. +(defun elmo-imap4-fetch-callback-1 (element app-data) + (elmo-imap4-fetch-callback-1-subr + (with-temp-buffer + (insert (or (elmo-imap4-response-bodydetail-text element) + "")) + ;; Delete CR. + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n")) + (elmo-msgdb-create-overview-from-buffer + (elmo-imap4-response-value element 'uid) + (elmo-imap4-response-value element 'rfc822size))) + (elmo-imap4-response-value element 'flags) + app-data)) (defun elmo-imap4-parse-capability (string) (if (string-match "^\\*\\(.*\\)$" string) @@ -1262,7 +961,7 @@ If optional argument UNMARK is non-nil, unmark." mechanism (elmo-network-session-user-internal session) "imap" - (elmo-network-session-host-internal session))) + (elmo-network-session-server-internal session))) ;;; (if elmo-imap4-auth-user-realm ;;; (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm)) (setq name (sasl-mechanism-name mechanism) @@ -1327,14 +1026,18 @@ If optional argument UNMARK is non-nil, unmark." (elmo-imap4-send-command-wait session "namespace") 'namespace))))) -(defun elmo-imap4-setup-send-buffer (string) - (let ((tmp-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*"))) +(defun elmo-imap4-setup-send-buffer (&optional string) + (let ((send-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*")) + (source-buf (unless string (current-buffer)))) (save-excursion (save-match-data - (set-buffer tmp-buf) + (set-buffer send-buf) (erase-buffer) (elmo-set-buffer-multibyte nil) - (insert string) + (if string + (insert string) + (with-current-buffer source-buf + (copy-to-buffer send-buf (point-min) (point-max)))) (goto-char (point-min)) (if (eq (re-search-forward "^$" nil t) (point-max)) @@ -1342,72 +1045,7 @@ If optional argument UNMARK is non-nil, unmark." (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match "\r\n")))) - tmp-buf)) - -(defun elmo-imap4-read-part (folder msg part) - (let* ((spec (elmo-folder-get-spec folder)) - (session (elmo-imap4-get-session spec))) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) - (with-current-buffer (elmo-network-session-buffer session) - (setq elmo-imap4-fetch-callback nil) - (setq elmo-imap4-fetch-callback-data nil)) - (unless elmo-inhibit-display-retrieval-progress - (setq elmo-imap4-display-literal-progress t)) - (prog1 - (unwind-protect - (elmo-delete-cr - (elmo-imap4-response-bodydetail-text - (elmo-imap4-response-value-all - (elmo-imap4-send-command-wait session - (format - (if elmo-imap4-use-uid - "uid fetch %s body.peek[%s]" - "fetch %s body.peek[%s]") - msg part)) - 'fetch))) - (setq elmo-imap4-display-literal-progress nil)) - (unless elmo-inhibit-display-retrieval-progress - (elmo-display-progress 'elmo-imap4-display-literal-progress - "" 100) ; remove progress bar. - (message "Retrieving...done."))))) - -(defun elmo-imap4-prefetch-msg (spec msg outbuf) - (elmo-imap4-read-msg spec msg outbuf nil 'unseen)) - -(defun elmo-imap4-read-msg (spec msg outbuf - &optional msgdb leave-seen-flag-untouched) - (let ((session (elmo-imap4-get-session spec)) - response) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) - (with-current-buffer (elmo-network-session-buffer session) - (setq elmo-imap4-fetch-callback nil) - (setq elmo-imap4-fetch-callback-data nil)) - (unless elmo-inhibit-display-retrieval-progress - (setq elmo-imap4-display-literal-progress t)) - (unwind-protect - (setq response - (elmo-imap4-send-command-wait session - (format - (if elmo-imap4-use-uid - "uid fetch %s body%s[]" - "fetch %s body%s[]") - msg - (if leave-seen-flag-untouched - ".peek" "")))) - (setq elmo-imap4-display-literal-progress nil)) - (unless elmo-inhibit-display-retrieval-progress - (elmo-display-progress 'elmo-imap4-display-literal-progress - "" 100) ; remove progress bar. - (message "Retrieving...done.")) - (and (setq response (elmo-imap4-response-bodydetail-text - (elmo-imap4-response-value-all - response 'fetch ))) - (with-current-buffer outbuf - (erase-buffer) - (insert response) - (elmo-delete-cr-get-content-type))))) + send-buf)) (defun elmo-imap4-setup-send-buffer-from-file (file) (let ((tmp-buf (get-buffer-create @@ -1427,88 +1065,24 @@ If optional argument UNMARK is non-nil, unmark." (replace-match "\r\n")))) tmp-buf)) -(defun elmo-imap4-delete-msgids (spec msgids) - "If actual message-id is matched, then delete it." - (let ((message-ids msgids) - (i 0) - (num (length msgids))) - (while message-ids - (setq i (+ 1 i)) - (message "Deleting message...%d/%d" i num) - (elmo-imap4-delete-msg-by-id spec (car message-ids)) - (setq message-ids (cdr message-ids))) - (elmo-imap4-send-command-wait (elmo-imap4-get-session spec) "expunge"))) - -(defun elmo-imap4-delete-msg-by-id (spec msgid) - (let ((session (elmo-imap4-get-session spec))) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) - (elmo-imap4-delete-msgs-no-expunge - spec - (elmo-imap4-response-value - (elmo-imap4-send-command-wait session - (list - (if elmo-imap4-use-uid - "uid search header message-id " - "search header message-id ") - (elmo-imap4-field-body msgid))) - 'search)))) - -(defun elmo-imap4-append-msg-by-id (spec msgid) - (let ((session (elmo-imap4-get-session spec)) - send-buf) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) - (setq send-buf (elmo-imap4-setup-send-buffer-from-file - (elmo-cache-get-path msgid))) - (unwind-protect - (elmo-imap4-send-command-wait - session - (list - "append " - (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)) - " (\\Seen) " - (elmo-imap4-buffer-literal send-buf))) - (kill-buffer send-buf))) - t) - -(defun elmo-imap4-append-msg (spec string &optional msg no-see) - (let ((session (elmo-imap4-get-session spec)) - send-buf) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox spec)) - (setq send-buf (elmo-imap4-setup-send-buffer string)) - (unwind-protect - (elmo-imap4-send-command-wait - session - (list - "append " - (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)) - (if no-see " " " (\\Seen) ") - (elmo-imap4-buffer-literal send-buf))) - (kill-buffer send-buf))) - t) - -(defun elmo-imap4-copy-msgs (dst-spec - msgs src-spec &optional expunge-it same-number) - "Equivalence of hostname, username is assumed." - (let ((session (elmo-imap4-get-session src-spec))) - (elmo-imap4-session-select-mailbox session - (elmo-imap4-spec-mailbox src-spec)) - (while msgs - (elmo-imap4-send-command-wait session - (list - (format - (if elmo-imap4-use-uid - "uid copy %s " - "copy %s ") - (car msgs)) - (elmo-imap4-mailbox - (elmo-imap4-spec-mailbox dst-spec)))) - (setq msgs (cdr msgs))) - (when expunge-it - (elmo-imap4-send-command-wait session "expunge")) - t)) +(luna-define-method elmo-delete-message-safe ((folder elmo-imap4-folder) + number msgid) + (let ((session (elmo-imap4-get-session folder)) + candidates) + (elmo-imap4-session-select-mailbox + session + (elmo-imap4-folder-mailbox-internal folder)) + (setq candidates + (elmo-imap4-response-value + (elmo-imap4-send-command-wait session + (list + (if elmo-imap4-use-uid + "uid search header message-id " + "search header message-id ") + (elmo-imap4-field-body msgid))) + 'search)) + (if (memq number candidates) + (elmo-folder-delete-messages folder (list number))))) (defun elmo-imap4-server-diff-async-callback-1 (status data) (funcall elmo-imap4-server-diff-async-callback @@ -1516,10 +1090,11 @@ If optional argument UNMARK is non-nil, unmark." (elmo-imap4-response-value status 'messages)) data)) -(defun elmo-imap4-server-diff-async (spec) - (let ((session (elmo-imap4-get-session spec))) - ;; commit. - ;; (elmo-imap4-commit spec) +(defun elmo-imap4-server-diff-async (folder) + (let ((session (elmo-imap4-get-session folder))) + ;; We should `check' folder to obtain newest information here. + ;; But since there's no asynchronous check mechanism in elmo yet, + ;; checking is not done here. (with-current-buffer (elmo-network-session-buffer session) (setq elmo-imap4-status-callback 'elmo-imap4-server-diff-async-callback-1) @@ -1529,57 +1104,24 @@ If optional argument UNMARK is non-nil, unmark." (list "status " (elmo-imap4-mailbox - (elmo-imap4-spec-mailbox spec)) + (elmo-imap4-folder-mailbox-internal folder)) " (unseen messages)")))) -(defun elmo-imap4-server-diff (spec) - "Get server status" - (let ((session (elmo-imap4-get-session spec)) - response) +(luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder)) + (let ((session (elmo-imap4-get-session folder))) ;; commit. -;;; (elmo-imap4-commit spec) + ;; (elmo-imap4-commit spec) (with-current-buffer (elmo-network-session-buffer session) - (setq elmo-imap4-status-callback nil) - (setq elmo-imap4-status-callback-data nil)) - (setq response - (elmo-imap4-send-command-wait session - (list - "status " - (elmo-imap4-mailbox - (elmo-imap4-spec-mailbox spec)) - " (unseen messages)"))) - (setq response (elmo-imap4-response-value response 'status)) - (cons (elmo-imap4-response-value response 'unseen) - (elmo-imap4-response-value response 'messages)))) - -(defun elmo-imap4-use-cache-p (spec number) - elmo-imap4-use-cache) - -(defun elmo-imap4-local-file-p (spec number) - nil) - -(defun elmo-imap4-port-label (spec) - (concat "imap4" - (if (elmo-imap4-spec-stream-type spec) - (concat "!" (symbol-name - (elmo-network-stream-type-symbol - (elmo-imap4-spec-stream-type spec))))))) - - -(defsubst elmo-imap4-portinfo (spec) - (list (elmo-imap4-spec-hostname spec) (elmo-imap4-spec-port spec))) - -(defun elmo-imap4-plugged-p (spec) - (apply 'elmo-plugged-p - (append (elmo-imap4-portinfo spec) - (list nil (quote (elmo-imap4-port-label spec)))))) - -(defun elmo-imap4-set-plugged (spec plugged add) - (apply 'elmo-set-plugged plugged - (append (elmo-imap4-portinfo spec) - (list nil nil (quote (elmo-imap4-port-label spec)) add)))) - -(defalias 'elmo-imap4-sync-number-alist 'elmo-generic-sync-number-alist) + (setq elmo-imap4-status-callback + 'elmo-imap4-server-diff-async-callback-1) + (setq elmo-imap4-status-callback-data + elmo-imap4-server-diff-async-callback-data)) + (elmo-imap4-send-command session + (list + "status " + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal folder)) + " (unseen messages)")))) ;;; IMAP parser. @@ -1589,6 +1131,8 @@ If optional argument UNMARK is non-nil, unmark." (defvar elmo-imap4-client-eol "\r\n" "The EOL string we send to the server.") +(defvar elmo-imap4-display-literal-progress nil) + (defun elmo-imap4-find-next-line () "Return point at end of current line, taking into account literals. Return nil if no complete line has arrived." @@ -1950,7 +1494,8 @@ Return nil if no complete line has arrived." (list 'bodystructure (elmo-imap4-parse-body))))) (setq list (cons element list)))) (and elmo-imap4-fetch-callback - (elmo-imap4-fetch-callback list elmo-imap4-fetch-callback-data)) + (funcall elmo-imap4-fetch-callback + list elmo-imap4-fetch-callback-data)) (list 'fetch list)))) (defun elmo-imap4-parse-status () @@ -2202,6 +1747,778 @@ Return nil if no complete line has arrived." (elmo-imap4-forward) (nreverse body))))) +(luna-define-method elmo-folder-initialize :around ((folder + elmo-imap4-folder) + name) + (let ((default-user elmo-imap4-default-user) + (default-server elmo-imap4-default-server) + (default-port elmo-imap4-default-port) + (elmo-network-stream-type-alist + (if elmo-imap4-stream-type-alist + (append elmo-imap4-stream-type-alist + elmo-network-stream-type-alist) + elmo-network-stream-type-alist))) + (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)) + (when (string-match + "^\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?" + name) + (progn + (if (match-beginning 1) + (progn + (elmo-imap4-folder-set-mailbox-internal + folder + (elmo-match-string 1 name)) + (if (eq (length (elmo-imap4-folder-mailbox-internal folder)) + 0) + ;; No information is specified other than folder type. + (elmo-imap4-folder-set-mailbox-internal + folder + elmo-imap4-default-mailbox))) + (elmo-imap4-folder-set-mailbox-internal + folder + elmo-imap4-default-mailbox)) + ;; Setup slots for elmo-net-folder. + (elmo-net-folder-set-user-internal + folder + (if (match-beginning 2) + (elmo-match-substring 2 name 1) + default-user)) + (elmo-net-folder-set-auth-internal + folder + (if (match-beginning 3) + (intern (elmo-match-substring 3 name 1)) + (or elmo-imap4-default-authenticate-type 'clear))) + (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-imap4-default-stream-type)) + folder)))) + +;;; ELMO IMAP4 folder +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-imap4-folder)) + (convert-standard-filename + (let ((mailbox (elmo-imap4-folder-mailbox-internal folder))) + (if (string= "inbox" (downcase mailbox)) + (setq mailbox "inbox")) + (if (eq (string-to-char mailbox) ?/) + (setq mailbox (substring mailbox 1 (length mailbox)))) + (expand-file-name + mailbox + (expand-file-name + (or (elmo-net-folder-user-internal folder) "nobody") + (expand-file-name (or (elmo-net-folder-server-internal folder) + "nowhere") + (expand-file-name + "imap" + elmo-msgdb-dir))))))) + +(luna-define-method elmo-folder-status-plugged ((folder + elmo-imap4-folder)) + (elmo-imap4-folder-status-plugged folder)) + +(defun elmo-imap4-folder-status-plugged (folder) + (let ((session (elmo-imap4-get-session folder)) + (killed (elmo-msgdb-killed-list-load + (elmo-folder-msgdb-path folder))) + status) + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-status-callback nil) + (setq elmo-imap4-status-callback-data nil)) + (setq status (elmo-imap4-response-value + (elmo-imap4-send-command-wait + session + (list "status " + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal folder)) + " (uidnext messages)")) + 'status)) + (cons + (- (elmo-imap4-response-value status 'uidnext) 1) + (if killed + (- + (elmo-imap4-response-value status 'messages) + (elmo-msgdb-killed-list-length killed)) + (elmo-imap4-response-value status 'messages))))) + +(luna-define-method elmo-folder-list-messages-plugged ((folder + elmo-imap4-folder) + &optional nohide) + (elmo-imap4-list folder + (let ((max (elmo-msgdb-max-of-killed + (elmo-folder-killed-list-internal folder)))) + (if (or nohide + (null (eq max 0))) + (format "uid %d:*" (1+ max)) + "all")))) + +(luna-define-method elmo-folder-list-unreads-plugged + ((folder elmo-imap4-folder)) + (elmo-imap4-list folder "unseen")) + +(luna-define-method elmo-folder-list-importants-plugged + ((folder elmo-imap4-folder)) + (elmo-imap4-list folder "flagged")) + +(luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder)) + (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp + (elmo-imap4-folder-mailbox-internal folder)))) + +(luna-define-method elmo-folder-list-subfolders ((folder elmo-imap4-folder) + &optional one-level) + (let* ((root (elmo-imap4-folder-mailbox-internal folder)) + (session (elmo-imap4-get-session folder)) + (prefix (elmo-folder-prefix-internal folder)) + (delim (or + (cdr + (elmo-string-matched-assoc + root + (with-current-buffer (elmo-network-session-buffer session) + elmo-imap4-server-namespace))) + elmo-imap4-default-hierarchy-delimiter)) + result append-serv type) + ;; Append delimiter + (if (and root + (not (string= root "")) + (not (string-match (concat "\\(.*\\)" + (regexp-quote delim) + "\\'") + root))) + (setq root (concat root delim))) + (setq result (elmo-imap4-response-get-selectable-mailbox-list + (elmo-imap4-send-command-wait + session + (list "list " (elmo-imap4-mailbox root) " *")))) + (unless (string= (elmo-net-folder-user-internal folder) + elmo-imap4-default-user) + (setq append-serv (concat ":" (elmo-net-folder-user-internal folder)))) + (unless (eq (elmo-net-folder-auth-internal folder) + (or elmo-imap4-default-authenticate-type 'clear)) + (setq append-serv + (concat append-serv "/" + (symbol-name (elmo-net-folder-auth-internal folder))))) + (unless (string= (elmo-net-folder-server-internal folder) + elmo-imap4-default-server) + (setq append-serv (concat append-serv "@" + (elmo-net-folder-server-internal folder)))) + (unless (eq (elmo-net-folder-port-internal folder) elmo-imap4-default-port) + (setq append-serv (concat append-serv ":" + (int-to-string + (elmo-net-folder-port-internal folder))))) + (setq type (elmo-net-folder-stream-type-internal folder)) + (unless (eq (elmo-network-stream-type-symbol type) + elmo-imap4-default-stream-type) + (if type + (setq append-serv (concat append-serv + (elmo-network-stream-type-spec-string + type))))) + (if one-level + (let (folder folders ret) + (while (setq folders (car result)) + (if (prog1 + (string-match + (concat "^\\(" root "[^" delim "]" "+\\)" delim) + folders) + (setq folder (match-string 1 folders))) + (progn + (setq ret + (append ret + (list + (list + (concat + prefix + (elmo-imap4-decode-folder-string folder) + (and append-serv + (eval append-serv))))))) + (setq result + (delq + nil + (mapcar '(lambda (fld) + (unless + (string-match + (concat "^" (regexp-quote folder) delim) + fld) + fld)) + result)))) + (setq ret (append + ret + (list + (concat prefix + (elmo-imap4-decode-folder-string folders) + (and append-serv + (eval append-serv)))))) + (setq result (cdr result)))) + ret) + (mapcar (lambda (fld) + (concat prefix (elmo-imap4-decode-folder-string fld) + (and append-serv + (eval append-serv)))) + result)))) + +(luna-define-method elmo-folder-exists-p-plugged ((folder elmo-imap4-folder)) + (let ((session (elmo-imap4-get-session folder))) + (if (string= + (elmo-imap4-session-current-mailbox-internal session) + (elmo-imap4-folder-mailbox-internal folder)) + t + (elmo-imap4-session-select-mailbox + session + (elmo-imap4-folder-mailbox-internal folder) + 'force 'no-error)))) + +(luna-define-method elmo-folder-delete ((folder elmo-imap4-folder)) + (let ((session (elmo-imap4-get-session folder)) + msgs) + (when (elmo-imap4-folder-mailbox-internal folder) + (when (setq msgs (elmo-folder-list-messages folder)) + (elmo-folder-delete-messages folder msgs)) + (elmo-imap4-send-command-wait session "close") + (elmo-imap4-send-command-wait + session + (list "delete " + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal folder))))))) + +(luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder) + new-folder) + (let ((session (elmo-imap4-get-session folder))) + ;; make sure the folder is selected. + (elmo-imap4-session-select-mailbox session + (elmo-imap4-folder-mailbox-internal + folder)) + (elmo-imap4-send-command-wait session "close") + (elmo-imap4-send-command-wait + session + (list "rename " + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal folder)) + " " + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal new-folder)))))) + +(defun elmo-imap4-copy-messages (src-folder dst-folder numbers) + (let ((session (elmo-imap4-get-session src-folder)) + (set-list (elmo-imap4-make-number-set-list numbers))) + (elmo-imap4-session-select-mailbox session + (elmo-imap4-folder-mailbox-internal + src-folder)) + (when set-list + (if (elmo-imap4-send-command-wait session + (list + (format + (if elmo-imap4-use-uid + "uid copy %s " + "copy %s ") + (cdr (car set-list))) + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal + dst-folder)))) + numbers)))) + +(defun elmo-imap4-set-flag (folder numbers flag &optional remove) + "Set flag on messages. +FOLDER is the ELMO folder structure. +NUMBERS is the message numbers to be flagged. +FLAG is the flag name. +If optional argument REMOVE is non-nil, remove FLAG." + (let ((session (elmo-imap4-get-session folder)) + set-list) + (elmo-imap4-session-select-mailbox session + (elmo-imap4-folder-mailbox-internal + folder)) + (setq set-list (elmo-imap4-make-number-set-list numbers)) + (when set-list + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-fetch-callback nil) + (setq elmo-imap4-fetch-callback-data nil)) + (elmo-imap4-send-command-wait + session + (format + (if elmo-imap4-use-uid + "uid store %s %sflags.silent (%s)" + "store %s %sflags.silent (%s)") + (cdr (car set-list)) + (if remove "-" "+") + flag))))) + +(luna-define-method elmo-folder-delete-messages-plugged + ((folder elmo-imap4-folder) numbers) + (let ((session (elmo-imap4-get-session folder))) + (elmo-imap4-set-flag folder numbers "\\Deleted") + (elmo-imap4-send-command-wait session "expunge"))) + +(defmacro elmo-imap4-detect-search-charset (string) + (` (with-temp-buffer + (insert (, string)) + (detect-mime-charset-region (point-min) (point-max))))) + +(defun elmo-imap4-search-internal-primitive (folder session filter from-msgs) + (let ((search-key (elmo-filter-key filter)) + (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to")) + charset) + (cond + ((string= "last" search-key) + (let ((numbers (or from-msgs (elmo-folder-list-messages folder)))) + (nthcdr (max (- (length numbers) + (string-to-int (elmo-filter-value filter))) + 0) + numbers))) + ((string= "first" search-key) + (let* ((numbers (or from-msgs (elmo-folder-list-messages folder))) + (rest (nthcdr (string-to-int (elmo-filter-value filter) ) + numbers))) + (mapcar '(lambda (x) (delete x numbers)) rest) + numbers)) + ((or (string= "since" search-key) + (string= "before" search-key)) + (setq search-key (concat "sent" search-key)) + (elmo-imap4-response-value + (elmo-imap4-send-command-wait session + (format + (if elmo-imap4-use-uid + "uid search %s%s%s %s" + "search %s%s%s %s") + (if from-msgs + (concat + (if elmo-imap4-use-uid "uid ") + (cdr + (car + (elmo-imap4-make-number-set-list + from-msgs))) + " ") + "") + (if (eq (elmo-filter-type filter) + 'unmatch) + "not " "") + search-key + (elmo-date-get-description + (elmo-date-get-datevec + (elmo-filter-value filter))))) + 'search)) + (t + (setq charset + (if (eq (length (elmo-filter-value filter)) 0) + (setq charset 'us-ascii) + (elmo-imap4-detect-search-charset + (elmo-filter-value filter)))) + (elmo-imap4-response-value + (elmo-imap4-send-command-wait session + (list + (if elmo-imap4-use-uid "uid ") + "search " + "CHARSET " + (elmo-imap4-astring + (symbol-name charset)) + " " + (if from-msgs + (concat + (if elmo-imap4-use-uid "uid ") + (cdr + (car + (elmo-imap4-make-number-set-list + from-msgs))) + " ") + "") + (if (eq (elmo-filter-type filter) + 'unmatch) + "not " "") + (format "%s%s " + (if (member + (elmo-filter-key filter) + imap-search-keys) + "" + "header ") + (elmo-filter-key filter)) + (elmo-imap4-astring + (encode-mime-charset-string + (elmo-filter-value filter) charset)))) + 'search))))) + +(defun elmo-imap4-search-internal (folder session condition from-msgs) + (let (result) + (cond + ((vectorp condition) + (setq result (elmo-imap4-search-internal-primitive + folder session condition from-msgs))) + ((eq (car condition) 'and) + (setq result (elmo-imap4-search-internal folder session (nth 1 condition) + from-msgs) + result (elmo-list-filter result + (elmo-imap4-search-internal + folder session (nth 2 condition) + from-msgs)))) + ((eq (car condition) 'or) + (setq result (elmo-imap4-search-internal + folder session (nth 1 condition) from-msgs) + result (elmo-uniq-list + (nconc result + (elmo-imap4-search-internal + folder session (nth 2 condition) from-msgs))) + result (sort result '<)))))) + +(luna-define-method elmo-folder-search ((folder elmo-imap4-folder) + condition &optional numbers) + (save-excursion + (let ((session (elmo-imap4-get-session folder))) + (elmo-imap4-session-select-mailbox + session + (elmo-imap4-folder-mailbox-internal folder)) + (elmo-imap4-search-internal folder session condition numbers)))) + +(luna-define-method elmo-folder-msgdb-create-plugged + ((folder elmo-imap4-folder) numbers &rest args) + (when numbers + (let ((session (elmo-imap4-get-session folder)) + (headers + (append + '("Subject" "From" "To" "Cc" "Date" + "Message-Id" "References" "In-Reply-To") + elmo-msgdb-extra-fields)) + (total 0) + (length (length numbers)) + rfc2060 set-list) + (setq rfc2060 (memq 'imap4rev1 + (elmo-imap4-session-capability-internal + session))) + (message "Getting overview...") + (elmo-imap4-session-select-mailbox + session (elmo-imap4-folder-mailbox-internal folder)) + (setq set-list (elmo-imap4-make-number-set-list + numbers + elmo-imap4-overview-fetch-chop-length)) + ;; Setup callback. + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-current-msgdb nil + elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1 + elmo-imap4-fetch-callback-data (cons args + (elmo-folder-use-flag-p + folder))) + (while set-list + (elmo-imap4-send-command-wait + session + ;; get overview entity from IMAP4 + (format "%sfetch %s (%s rfc822.size flags)" + (if elmo-imap4-use-uid "uid " "") + (cdr (car set-list)) + (if rfc2060 + (format "body.peek[header.fields %s]" headers) + (format "%s" headers)))) + (when (> length elmo-display-progress-threshold) + (setq total (+ total (car (car set-list)))) + (elmo-display-progress + 'elmo-imap4-msgdb-create "Getting overview..." + (/ (* total 100) length))) + (setq set-list (cdr set-list))) + (message "Getting overview...done") + elmo-imap4-current-msgdb)))) + +(luna-define-method elmo-folder-unmark-important-plugged + ((folder elmo-imap4-folder) numbers) + (elmo-imap4-set-flag folder numbers "\\Flagged" 'remove)) + +(luna-define-method elmo-folder-mark-as-important-plugged + ((folder elmo-imap4-folder) numbers) + (elmo-imap4-set-flag folder numbers "\\Flagged")) + +(luna-define-method elmo-folder-unmark-read-plugged + ((folder elmo-imap4-folder) numbers) + (elmo-imap4-set-flag folder numbers "\\Seen" 'remove)) + +(luna-define-method elmo-folder-mark-as-read-plugged + ((folder elmo-imap4-folder) numbers) + (elmo-imap4-set-flag folder numbers "\\Seen")) + +(luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder) + number) + elmo-imap4-use-cache) + +(luna-define-method elmo-folder-message-appendable-p ((folder elmo-imap4-folder)) + (if (elmo-folder-plugged-p folder) + (not (elmo-imap4-session-read-only-internal + (elmo-imap4-get-session folder))) + elmo-enable-disconnected-operation)) ; offline refile. + +(luna-define-method elmo-folder-check-plugged ((folder elmo-imap4-folder)) + (let ((session (elmo-imap4-get-session folder 'if-exists))) + (when session + (if (string= + (elmo-imap4-session-current-mailbox-internal session) + (elmo-imap4-folder-mailbox-internal folder)) + (if elmo-imap4-use-select-to-update-status + (elmo-imap4-session-select-mailbox + session + (elmo-imap4-folder-mailbox-internal folder) + 'force) + (elmo-imap4-session-check session)))))) + +(defsubst elmo-imap4-folder-diff-plugged (folder) + (let ((session (elmo-imap4-get-session folder)) + messages + response killed) +;;; (elmo-imap4-commit spec) + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-status-callback nil) + (setq elmo-imap4-status-callback-data nil)) + (setq response + (elmo-imap4-send-command-wait session + (list + "status " + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal + folder)) + " (unseen messages)"))) + (setq response (elmo-imap4-response-value response 'status)) + (setq messages (elmo-imap4-response-value response 'messages)) + (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) + (if killed + (setq messages (- messages + (elmo-msgdb-killed-list-length + killed)))) + (cons (elmo-imap4-response-value response 'unseen) + messages))) + +(luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder)) + (elmo-imap4-folder-diff-plugged folder)) + +(luna-define-method elmo-folder-diff-async ((folder elmo-imap4-folder) + &optional number-alist) + (setq elmo-imap4-server-diff-async-callback + elmo-folder-diff-async-callback) + (setq elmo-imap4-server-diff-async-callback-data + elmo-folder-diff-async-callback-data) + (elmo-imap4-server-diff-async folder)) + +(luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder) + &optional load-msgdb) + (if (elmo-folder-plugged-p folder) + (let (session mailbox msgdb response tag) + (condition-case err + (progn + (setq session (elmo-imap4-get-session folder) + mailbox (elmo-imap4-folder-mailbox-internal folder) + tag (elmo-imap4-send-command session + (list "select " + (elmo-imap4-mailbox + mailbox)))) + (if load-msgdb + (setq msgdb (elmo-msgdb-load folder))) + (elmo-folder-set-killed-list-internal + folder + (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) + (setq response (elmo-imap4-read-response session tag))) + (quit + (if response + (elmo-imap4-session-set-current-mailbox-internal + session mailbox) + (and session + (elmo-imap4-session-set-current-mailbox-internal + session nil)))) + (error + (if response + (elmo-imap4-session-set-current-mailbox-internal + session mailbox) + (and session + (elmo-imap4-session-set-current-mailbox-internal + session nil))))) + (if load-msgdb + (elmo-folder-set-msgdb-internal + folder + (or msgdb (elmo-msgdb-load folder))))) + (luna-call-next-method))) + +;; elmo-folder-open-internal: do nothing. + +(luna-define-method elmo-find-fetch-strategy + ((folder elmo-imap4-folder) entity &optional ignore-cache) + (let ((number (elmo-msgdb-overview-entity-get-number entity)) + cache-file size message-id) + (setq size (elmo-msgdb-overview-entity-get-size entity)) + (setq message-id (elmo-msgdb-overview-entity-get-id entity)) + (setq cache-file (elmo-file-cache-get message-id)) + (if (or ignore-cache + (null (elmo-file-cache-status cache-file))) + (if (and elmo-message-fetch-threshold + (integerp size) + (>= size elmo-message-fetch-threshold) + (or (not elmo-message-fetch-confirm) + (not (prog1 (y-or-n-p + (format + "Fetch entire message at once? (%dbytes)" + size)) + (message ""))))) + ;; Fetch message as imap message. + (elmo-make-fetch-strategy 'section + nil + (elmo-message-use-cache-p + folder number) + (elmo-file-cache-path + cache-file)) + ;; Don't use existing cache and fetch entire message at once. + (elmo-make-fetch-strategy 'entire nil + (elmo-message-use-cache-p + folder number) + (elmo-file-cache-path cache-file))) + ;; Cache found and use it. + (if (not ignore-cache) + (if (eq (elmo-file-cache-status cache-file) 'section) + ;; Fetch message with imap message. + (elmo-make-fetch-strategy 'section + t + (elmo-message-use-cache-p + folder number) + (elmo-file-cache-path + cache-file)) + (elmo-make-fetch-strategy 'entire + t + (elmo-message-use-cache-p + folder number) + (elmo-file-cache-path + cache-file))))))) + +(luna-define-method elmo-folder-create ((folder elmo-imap4-folder)) + (elmo-imap4-send-command-wait + (elmo-imap4-get-session folder) + (list "create " + (elmo-imap4-mailbox + (elmo-imap4-folder-mailbox-internal folder))))) + +(luna-define-method elmo-folder-append-buffer + ((folder elmo-imap4-folder) unread &optional number) + (if (elmo-folder-plugged-p folder) + (let ((session (elmo-imap4-get-session folder)) + send-buffer result) + (elmo-imap4-session-select-mailbox session + (elmo-imap4-folder-mailbox-internal + folder)) + (setq send-buffer (elmo-imap4-setup-send-buffer)) + (unwind-protect + (setq result + (elmo-imap4-send-command-wait + session + (list + "append " + (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal + folder)) + (if unread " " " (\\Seen) ") + (elmo-imap4-buffer-literal send-buffer)))) + (kill-buffer send-buffer)) + result) + ;; Unplugged + (if elmo-enable-disconnected-operation + (elmo-folder-append-buffer-dop folder unread number) + (error "Unplugged")))) + +(eval-when-compile + (defmacro elmo-imap4-identical-system-p (folder1 folder2) + "Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system." + (` (and (string= (elmo-net-folder-server-internal (, folder1)) + (elmo-net-folder-server-internal (, folder2))) + (eq (elmo-net-folder-port-internal (, folder1)) + (elmo-net-folder-port-internal (, folder2))) + (string= (elmo-net-folder-user-internal (, folder1)) + (elmo-net-folder-user-internal (, folder2))))))) + +(luna-define-method elmo-folder-append-messages :around + ((folder elmo-imap4-folder) src-folder numbers unread-marks + &optional same-number) + (if (and (eq (elmo-folder-type-internal src-folder) 'imap4) + (elmo-imap4-identical-system-p folder src-folder) + (elmo-folder-plugged-p folder)) + ;; Plugged + (elmo-imap4-copy-messages src-folder folder numbers) + (luna-call-next-method))) + +(luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder) + number) + (if (elmo-folder-plugged-p folder) + (not (elmo-imap4-session-read-only-internal + (elmo-imap4-get-session folder))) + elmo-enable-disconnected-operation)) ; offline refile. + +;(luna-define-method elmo-message-fetch-unplugged +; ((folder elmo-imap4-folder) +; number strategy &optional section outbuf unseen) +; (error "%d%s is not cached." number (if section +; (format "(%s)" section) +; ""))) + +(defsubst elmo-imap4-message-fetch (folder number strategy + section outbuf unseen) + (let ((session (elmo-imap4-get-session folder)) + response) + (elmo-imap4-session-select-mailbox session + (elmo-imap4-folder-mailbox-internal + folder)) + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-fetch-callback nil) + (setq elmo-imap4-fetch-callback-data nil)) + (unless elmo-inhibit-display-retrieval-progress + (setq elmo-imap4-display-literal-progress t)) + (unwind-protect + (setq response + (elmo-imap4-send-command-wait session + (format + (if elmo-imap4-use-uid + "uid fetch %s body%s[%s]" + "fetch %s body%s[%s]") + number + (if unseen ".peek" "") + (or section "") + ))) + (setq elmo-imap4-display-literal-progress nil)) + (unless elmo-inhibit-display-retrieval-progress + (elmo-display-progress 'elmo-imap4-display-literal-progress + "" 100) ; remove progress bar. + (message "Retrieving...done.")) + (if (setq response (elmo-imap4-response-bodydetail-text + (elmo-imap4-response-value-all + response 'fetch))) + (with-current-buffer outbuf + (erase-buffer) + (insert response))))) + +(luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder) + number strategy + &optional section + outbuf unseen) + (elmo-imap4-message-fetch folder number strategy section outbuf unseen)) + +(luna-define-method elmo-message-fetch-field ((folder elmo-imap4-folder) + number field) + (let ((session (elmo-imap4-get-session folder))) + (elmo-imap4-session-select-mailbox session + (elmo-imap4-folder-mailbox-internal + folder)) + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-fetch-callback nil) + (setq elmo-imap4-fetch-callback-data nil)) + (with-temp-buffer + (insert + (elmo-imap4-response-bodydetail-text + (elmo-imap4-response-value + (elmo-imap4-send-command-wait session + (concat + (if elmo-imap4-use-uid + "uid ") + (format + "fetch %s (body.peek[header.fields (%s)])" + number field))) + 'fetch))) + (elmo-delete-cr-buffer) + (goto-char (point-min)) + (std11-field-body (symbol-name field))))) + + + (require 'product) (product-provide (provide 'elmo-imap4) (require 'elmo-version)) diff --git a/elmo/elmo-internal.el b/elmo/elmo-internal.el index 1c5b66b..75415fb 100644 --- a/elmo/elmo-internal.el +++ b/elmo/elmo-internal.el @@ -28,242 +28,53 @@ ;;; Code: ;; -(require 'elmo-localdir) - -(defsubst elmo-internal-list-folder-subr (spec &optional nonsort) - (let* ((directive (nth 1 spec)) - (arg (nth 2 spec)) - (flist (elmo-list-folder-by-location - spec - (elmo-internal-list-location directive arg))) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - numbers) - (if nonsort - (cons (or (elmo-max-of-list flist) 0) - (if killed - (- (length flist) - (elmo-msgdb-killed-list-length killed)) - (length flist))) - (setq numbers (sort flist '<)) - (elmo-living-messages numbers killed)))) - -(defun elmo-internal-list-folder (spec &optional nohide) - (elmo-internal-list-folder-subr spec)) - -(defun elmo-internal-list-folder-by-location (spec location &optional msgdb) - (let* ((path (elmo-msgdb-expand-path spec)) - (location-alist - (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load path))) - (i 0) - result pair - location-max modified) - (setq location-max - (or (elmo-max-of-list (mapcar 'car location-alist)) 0)) - (when location-max - (while location - (if (setq pair (rassoc (car location) location-alist)) - (setq result - (append result - (list (cons (car pair) (car location))))) - (setq i (1+ i)) - (setq result (append result - (list - (cons (+ location-max i) (car location)))))) - (setq location (cdr location)))) - (setq result (sort result '(lambda (x y) - (< (car x)(car y))))) - (if (not (equal result location-alist)) - (setq modified t)) - (if modified - (elmo-msgdb-location-save path result)) - (mapcar 'car result))) - -(defun elmo-internal-list-location (directive arg) - (let ((mark-alist - (or elmo-msgdb-global-mark-alist - (setq elmo-msgdb-global-mark-alist - (elmo-object-load (expand-file-name - elmo-msgdb-global-mark-filename - elmo-msgdb-dir))))) - result) - (mapcar (function (lambda (x) - (setq result (cons (car x) result)))) - mark-alist) - (nreverse result))) - -(defun elmo-internal-msgdb-create-entity (number loc-alist) - (elmo-localdir-msgdb-create-overview-entity-from-file - number - (elmo-cache-get-path (cdr (assq number loc-alist))))) - -(defun elmo-internal-msgdb-create (spec numlist new-mark - already-mark seen-mark - important-mark - seen-list - &optional msgdb) - (when numlist - (let* ((directive (nth 1 spec)) - (arg (nth 2 spec)) - (loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec)))) - (loc-list (elmo-internal-list-location directive arg)) - overview number-alist mark-alist entity - i percent num location pair) - (setq num (length numlist)) - (setq i 0) - (message "Creating msgdb...") - (while numlist - (setq entity - (elmo-internal-msgdb-create-entity - (car numlist) loc-alist)) - (if (null entity) - () - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq number-alist - (elmo-msgdb-number-add number-alist - (elmo-msgdb-overview-entity-get-number - entity) - (elmo-msgdb-overview-entity-get-id - entity))) - (setq location (cdr (assq (car numlist) loc-alist))) - (unless (memq location seen-list) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - (elmo-msgdb-overview-entity-get-number - entity) -;;; (nth 0 entity) - (or (elmo-msgdb-global-mark-get - (elmo-msgdb-overview-entity-get-id - entity)) - (if (elmo-cache-exists-p - (elmo-msgdb-overview-entity-get-id - entity)) - already-mark - new-mark)))))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (setq percent (/ (* i 100) num)) - (elmo-display-progress - 'elmo-internal-msgdb-create "Creating msgdb..." - percent)) - (setq numlist (cdr numlist))) - (message "Creating msgdb...done") - (list overview number-alist mark-alist loc-alist)))) - -(defalias 'elmo-internal-msgdb-create-as-numlist 'elmo-internal-msgdb-create) - -(defun elmo-internal-list-folders (spec &optional hierarchy) - ;; XXX hard cording. - (unless (nth 1 spec) ; toplevel. - (list (list "'cache") "'mark"))) - -(defvar elmo-internal-mark "$") - -(defun elmo-internal-append-msg (spec string &optional msg no-see) - (elmo-set-work-buf - (insert string) - (let* ((msgid (elmo-field-body "message-id")) - (path (elmo-cache-get-path msgid)) - dir) - (when path - (setq dir (directory-file-name (file-name-directory path))) - (if (not (file-exists-p dir)) - (elmo-make-directory dir)) - (as-binary-output-file (write-region (point-min) (point-max) - path nil 'no-msg))) - (elmo-msgdb-global-mark-set msgid elmo-internal-mark)))) - -(defun elmo-internal-delete-msgs (spec msgs &optional msgdb) - (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec))))) - (mapcar '(lambda (msg) (elmo-internal-delete-msg spec msg - loc-alist)) - msgs))) - -(defun elmo-internal-delete-msg (spec number loc-alist) - (let ((pair (assq number loc-alist))) - (elmo-msgdb-global-mark-delete (cdr pair)))) - -(defun elmo-internal-read-msg (spec number outbuf &optional msgdb unread) - (save-excursion - (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec)))) - (file (elmo-cache-get-path (cdr (assq number loc-alist))))) - (set-buffer outbuf) - (erase-buffer) - (when (file-exists-p file) - (as-binary-input-file (insert-file-contents file)) - (elmo-delete-cr-get-content-type))))) - -(defun elmo-internal-max-of-folder (spec) - (elmo-internal-list-folder-subr spec t)) - -(defun elmo-internal-check-validity (spec) - nil) - -(defun elmo-internal-sync-validity (spec) - nil) - -(defun elmo-internal-folder-exists-p (spec) - t) - -(defun elmo-internal-folder-creatable-p (spec) - nil) - -(defun elmo-internal-create-folder (spec) - nil) - -(defun elmo-internal-search (spec condition &optional from-msgs msgdb) - (let* ((msgs (or from-msgs (elmo-internal-list-folder spec))) - (loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec)))) - (number-list (mapcar 'car loc-alist)) - (i 0) - (num (length msgs)) - cache-file - matched - case-fold-search) - (setq num (length msgs)) - (while msgs - (if (and (setq cache-file (elmo-cache-get-path (cdr (assq (car msgs) - loc-alist)))) - (file-exists-p cache-file) - (elmo-file-field-condition-match cache-file - condition - (car msgs) - number-list)) - (setq matched (nconc matched (list (car msgs))))) - (elmo-display-progress - 'elmo-internal-search "Searching..." - (/ (* (setq i (1+ i)) 100) num)) - (setq msgs (cdr msgs))) - matched)) - -(defun elmo-internal-use-cache-p (spec number) - nil) - -(defun elmo-internal-local-file-p (spec number) - nil ;; XXXX - ) - -(defalias 'elmo-internal-sync-number-alist 'elmo-generic-sync-number-alist) -(defalias 'elmo-internal-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-internal-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-internal-commit 'elmo-generic-commit) -(defalias 'elmo-internal-folder-diff 'elmo-generic-folder-diff) +(require 'elmo) + +;;; ELMO internal folder +(luna-define-class elmo-internal-folder (elmo-folder) ()) + +(luna-define-method elmo-folder-initialize ((folder + elmo-internal-folder) + name) + (elmo-internal-folder-initialize folder name)) + +(defvar elmo-internal-folder-list '(mark cache)) + +(defun elmo-internal-folder-initialize (folder name) + (let ((fsyms elmo-internal-folder-list) + fname class sym) + (if (progn (while fsyms + (setq fname (symbol-name (car fsyms))) + (when (string-match (concat "^" fname) name) + (require (intern (concat "elmo-" fname))) + (setq class (intern (concat "elmo-" fname "-folder")) + sym (intern fname) + fsyms nil)) + (setq fsyms (cdr fsyms))) + class) + (elmo-folder-initialize + (luna-make-entity + class + :type sym + :prefix (elmo-folder-prefix-internal folder) + :name (elmo-folder-name-internal folder) + :persistent (elmo-folder-persistent-internal folder)) + name) + folder))) + +(luna-define-method elmo-folder-list-subfolders ((folder elmo-internal-folder) + &optional one-level) + (mapcar + (lambda (x) + (if (elmo-folder-have-subfolder-p + (elmo-make-folder + (concat (elmo-folder-prefix-internal folder) + (symbol-name x)))) + (list (concat (elmo-folder-prefix-internal folder) + (symbol-name x))) + (concat (elmo-folder-prefix-internal folder) + (symbol-name x)))) + elmo-internal-folder-list)) (require 'product) (product-provide (provide 'elmo-internal) (require 'elmo-version)) diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index 46b7ebe..9ccc48e 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -32,103 +32,130 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) -(require 'emu) -(require 'std11) - -(eval-when-compile - (require 'elmo-cache)) (require 'elmo-msgdb) +(require 'elmo) + +(defcustom elmo-localdir-folder-path "~/Mail" + "*Local mail directory (MH format) path." + :type 'directory + :group 'elmo) + +(defvar elmo-localdir-lockfile-list nil) + +;;; ELMO Local directory folder +(eval-and-compile + (luna-define-class elmo-localdir-folder (elmo-folder) + (dir-name directory)) + (luna-define-internal-accessors 'elmo-localdir-folder)) + +;;; elmo-localdir specific methods. +(luna-define-generic elmo-localdir-folder-path (folder) + "Return local directory path of the FOLDER.") + +(luna-define-generic elmo-localdir-folder-name (folder name) + "Return directory NAME for FOLDER.") + +(luna-define-method elmo-localdir-folder-path ((folder elmo-localdir-folder)) + elmo-localdir-folder-path) + +(luna-define-method elmo-localdir-folder-name ((folder elmo-localdir-folder) + name) + name) + +(luna-define-method elmo-folder-initialize ((folder + elmo-localdir-folder) + name) + (elmo-localdir-folder-set-dir-name-internal folder name) + (if (file-name-absolute-p name) + (elmo-localdir-folder-set-directory-internal + folder + (expand-file-name name)) + (elmo-localdir-folder-set-directory-internal + folder + (expand-file-name + (elmo-localdir-folder-name folder name) + (elmo-localdir-folder-path folder)))) + folder) + +;; open, check, commit, and close are generic. + +(luna-define-method elmo-folder-exists-p ((folder elmo-localdir-folder)) + (file-directory-p (elmo-localdir-folder-directory-internal folder))) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-localdir-folder)) + (expand-file-name + (mapconcat + 'identity + (mapcar + 'elmo-replace-string-as-filename + (split-string (elmo-localdir-folder-dir-name-internal folder) + "/")) + "/") + (expand-file-name ;;"localdir" + (symbol-name (elmo-folder-type-internal folder)) + elmo-msgdb-dir))) + +(luna-define-method elmo-message-file-name ((folder + elmo-localdir-folder) + number) + (expand-file-name (int-to-string number) + (elmo-localdir-folder-directory-internal folder))) + +(luna-define-method elmo-folder-message-file-number-p ((folder + elmo-localdir-folder)) + t) + +(luna-define-method elmo-folder-message-file-directory ((folder + elmo-localdir-folder)) + (elmo-localdir-folder-directory-internal folder)) -(defsubst elmo-localdir-get-folder-directory (spec) - (if (file-name-absolute-p (nth 1 spec)) - (nth 1 spec) ; already full path. - (expand-file-name (nth 1 spec) - (cond ((eq (car spec) 'localnews) - elmo-localnews-folder-path) - (t - elmo-localdir-folder-path))))) - -(defun elmo-localdir-msgdb-expand-path (spec) - (let ((fld-name (nth 1 spec))) - (expand-file-name fld-name - (expand-file-name "localdir" - elmo-msgdb-dir)))) - -(defun elmo-localdir-number-to-filename (spec dir number &optional loc-alist) - (expand-file-name (int-to-string number) dir)) - -(if (boundp 'nemacs-version) - (defsubst elmo-localdir-insert-header (file) - "Insert the header of the article (Does not work on nemacs)." - (as-binary-input-file - (insert-file-contents file))) - (defsubst elmo-localdir-insert-header (file) - "Insert the header of the article." - (let ((beg 0) - insert-file-contents-pre-hook ; To avoid autoconv-xmas... - insert-file-contents-post-hook - format-alist) - (when (file-exists-p file) - ;; Read until header separator is found. - (while (and (eq elmo-localdir-header-chop-length - (nth 1 - (as-binary-input-file - (insert-file-contents - file nil beg - (incf beg elmo-localdir-header-chop-length))))) - (prog1 (not (search-forward "\n\n" nil t)) - (goto-char (point-max))))))))) - - -(defsubst elmo-localdir-msgdb-create-overview-entity-from-file (number file) - (save-excursion - (let ((tmp-buffer (get-buffer-create " *ELMO LocalDir Temp*")) - insert-file-contents-pre-hook ; To avoid autoconv-xmas... - insert-file-contents-post-hook header-end - (attrib (file-attributes file)) - ret-val size mtime) - (set-buffer tmp-buffer) - (erase-buffer) - (if (not (file-exists-p file)) - () - (setq size (nth 7 attrib)) - (setq mtime (timezone-make-date-arpa-standard - (current-time-string (nth 5 attrib)) (current-time-zone))) - ;; insert header from file. - (catch 'done - (condition-case nil - (elmo-localdir-insert-header file) - (error (throw 'done nil))) - (goto-char (point-min)) - (setq header-end - (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t) - (point) - (point-max))) - (narrow-to-region (point-min) header-end) - (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime)) - (kill-buffer tmp-buffer)) - ret-val - )))) +(luna-define-method elmo-folder-message-make-temp-file-p + ((folder elmo-localdir-folder)) + t) + +(luna-define-method elmo-folder-message-make-temp-files ((folder + elmo-localdir-folder) + numbers + &optional + start-number) + (let ((temp-dir (elmo-folder-make-temp-dir folder)) + (cur-number (or start-number 0))) + (dolist (number numbers) + (elmo-add-name-to-file + (expand-file-name + (int-to-string number) + (elmo-localdir-folder-directory-internal folder)) + (expand-file-name + (int-to-string (if start-number cur-number number)) + temp-dir)) + (incf cur-number)) + temp-dir)) (defun elmo-localdir-msgdb-create-entity (dir number) - (elmo-localdir-msgdb-create-overview-entity-from-file + (elmo-msgdb-create-overview-entity-from-file number (expand-file-name (int-to-string number) dir))) -(defun elmo-localdir-msgdb-create-as-numlist (spec numlist new-mark - already-mark seen-mark - important-mark seen-list) - (when numlist - (let ((dir (elmo-localdir-get-folder-directory spec)) +(luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder) + numbers + new-mark + already-mark + seen-mark + important-mark + seen-list) + (when numbers + (let ((dir (elmo-localdir-folder-directory-internal folder)) overview number-alist mark-alist entity message-id num seen gmark (i 0) - (len (length numlist))) + (len (length numbers))) (message "Creating msgdb...") - (while numlist + (while numbers (setq entity (elmo-localdir-msgdb-create-entity - dir (car numlist))) + dir (car numbers))) (if (null entity) () (setq num (elmo-msgdb-overview-entity-get-number entity)) @@ -142,7 +169,7 @@ message-id)) (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-cache-exists-p message-id) ; XXX + (if (elmo-file-cache-exists-p message-id) ; XXX (if seen nil already-mark) @@ -157,197 +184,125 @@ (when (> len elmo-display-progress-threshold) (setq i (1+ i)) (elmo-display-progress - 'elmo-localdir-msgdb-create-as-numlist "Creating msgdb..." + 'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..." (/ (* i 100) len))) - (setq numlist (cdr numlist))) + (setq numbers (cdr numbers))) (message "Creating msgdb...done") (list overview number-alist mark-alist)))) -(defalias 'elmo-localdir-msgdb-create 'elmo-localdir-msgdb-create-as-numlist) - -(defvar elmo-localdir-list-folders-spec-string "+") -(defvar elmo-localdir-list-folders-filter-regexp "^\\(\\.\\.?\\|[0-9]+\\)$") - -(defun elmo-localdir-list-folders (spec &optional hierarchy) - (let ((folder (concat elmo-localdir-list-folders-spec-string (nth 1 spec)))) - (elmo-localdir-list-folders-subr folder hierarchy))) - -(defun elmo-localdir-list-folders-subr (folder &optional hierarchy) - (let ((case-fold-search t) - (w32-get-true-file-link-count t) ; for Meadow - folders curdir dirent relpath abspath attr - subprefix subfolder) - (condition-case () - (progn - (setq curdir - (expand-file-name (nth 1 (elmo-folder-get-spec folder)) - elmo-localdir-folder-path)) - (if (string-match "^[+=$.]$" folder) ; localdir, archive, localnews - (setq subprefix folder) - (setq subprefix (concat folder elmo-path-sep)) - ;; include parent - (setq folders (list folder))) - (setq dirent (directory-files curdir)) - (catch 'done - (while dirent - (setq relpath (car dirent)) - (setq dirent (cdr dirent)) - (setq abspath (expand-file-name relpath curdir)) - (and - (not (string-match - elmo-localdir-list-folders-filter-regexp - relpath)) - (eq (nth 0 (setq attr (file-attributes abspath))) t) - (if (eq hierarchy 'check) - (throw 'done (nconc folders t)) - t) - (setq subfolder (concat subprefix relpath)) - (setq folders (nconc folders - (if (and hierarchy - (if elmo-have-link-count - (< 2 (nth 1 attr)) - (cdr - (elmo-localdir-list-folders-subr - subfolder 'check)))) - (list (list subfolder)) - (list subfolder)))) - (or - hierarchy - (and elmo-have-link-count (>= 2 (nth 1 attr))) - (setq folders - (nconc folders (cdr (elmo-localdir-list-folders-subr - subfolder hierarchy)))))))) - folders) - (file-error folders)))) - -(defsubst elmo-localdir-list-folder-subr (spec &optional nonsort) - (let* ((dir (elmo-localdir-get-folder-directory spec)) - (flist (mapcar 'string-to-int - (directory-files dir nil "^[0-9]+$" t))) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - numbers) +(luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder) + &optional one-level) + (elmo-mapcar-list-of-list + (lambda (x) (concat (elmo-folder-prefix-internal folder) x)) + (elmo-list-subdirectories + (elmo-localdir-folder-path folder) + (or (elmo-localdir-folder-dir-name-internal folder) "") + one-level))) + +(defsubst elmo-localdir-list-subr (folder &optional nonsort) + (let ((flist (mapcar 'string-to-int + (directory-files + (elmo-localdir-folder-directory-internal folder) + nil "^[0-9]+$" t))) + (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))) (if nonsort (cons (or (elmo-max-of-list flist) 0) (if killed (- (length flist) (elmo-msgdb-killed-list-length killed)) (length flist))) - (setq numbers (sort flist '<)) - (elmo-living-messages numbers killed)))) - -(defun elmo-localdir-append-msg (spec string &optional msg no-see) - (let ((dir (elmo-localdir-get-folder-directory spec)) - (tmp-buffer (get-buffer-create " *ELMO Temp buffer*")) - (next-num (or msg - (1+ (car (elmo-localdir-max-of-folder spec))))) - filename) - (save-excursion - (set-buffer tmp-buffer) - (erase-buffer) - (setq filename (expand-file-name (int-to-string - next-num) - dir)) - (unwind-protect - (if (file-writable-p filename) - (progn - (insert string) - (as-binary-output-file - (write-region (point-min) (point-max) filename nil 'no-msg)) - t) - nil - ) - (kill-buffer tmp-buffer))))) - -(defun elmo-localdir-delete-msg (spec number) - (let (file - (dir (elmo-localdir-get-folder-directory spec)) - (number (int-to-string number))) - (setq file (expand-file-name number dir)) - (if (and (string-match "[0-9]+" number) ; for safety. - (file-exists-p file) - (file-writable-p file) - (not (file-directory-p file))) - (progn (delete-file file) - t)))) - -(defun elmo-localdir-read-msg (spec number outbuf &optional msgdb unread) - (save-excursion - (let* ((number (int-to-string number)) - (dir (elmo-localdir-get-folder-directory spec)) - (file (expand-file-name number dir))) - (set-buffer outbuf) - (erase-buffer) - (when (file-exists-p file) - (as-binary-input-file (insert-file-contents file)) - (elmo-delete-cr-get-content-type))))) - -(defun elmo-localdir-delete-msgs (spec msgs) - (mapcar '(lambda (msg) (elmo-localdir-delete-msg spec msg)) - msgs)) - -(defun elmo-localdir-list-folder (spec &optional nohide); called by elmo-localdir-search() - (elmo-localdir-list-folder-subr spec)) - -(defun elmo-localdir-max-of-folder (spec) - (elmo-localdir-list-folder-subr spec t)) - -(defun elmo-localdir-check-validity (spec validity-file) - (let* ((dir (elmo-localdir-get-folder-directory spec)) - (cur-val (nth 5 (file-attributes dir))) - (file-val (read - (or (elmo-get-file-string validity-file) - "nil")))) - (cond - ((or (null cur-val) (null file-val)) nil) - ((> (car cur-val) (car file-val)) nil) - ((= (car cur-val) (car file-val)) - (if (> (cadr cur-val) (cadr file-val)) nil t)) ; t if same - (t t)))) - -(defun elmo-localdir-sync-validity (spec validity-file) - (save-excursion - (let* ((dir (elmo-localdir-get-folder-directory spec)) - (tmp-buffer (get-buffer-create " *ELMO TMP*")) - (number-file (expand-file-name elmo-msgdb-number-filename dir))) - (set-buffer tmp-buffer) - (erase-buffer) - (prin1 (nth 5 (file-attributes dir)) tmp-buffer) - (princ "\n" tmp-buffer) - (if (file-writable-p validity-file) - (write-region (point-min) (point-max) - validity-file nil 'no-msg) - (message (format "%s is not writable." number-file))) - (kill-buffer tmp-buffer)))) - -(defun elmo-localdir-folder-exists-p (spec) - (file-directory-p (elmo-localdir-get-folder-directory spec))) - -(defun elmo-localdir-folder-creatable-p (spec) + (sort flist '<)))) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder) + unread + &optional number) + (let ((filename (elmo-message-file-name + folder + (or number + (1+ (car (elmo-folder-status folder))))))) + (if (file-writable-p filename) + (write-region-as-binary + (point-min) (point-max) filename nil 'no-msg)) + t)) + +(luna-define-method elmo-folder-append-messages :around ((folder elmo-localdir-folder) + src-folder numbers + unread-marks + &optional same-number) + (if (elmo-folder-message-file-p src-folder) + (let ((dir (elmo-localdir-folder-directory-internal folder)) + (succeeds numbers) + (next-num (1+ (car (elmo-folder-status folder))))) + (while numbers + (elmo-copy-file + (elmo-message-file-name src-folder (car numbers)) + (expand-file-name + (int-to-string + (if same-number (car numbers) next-num)) + dir)) + (if (and (setq numbers (cdr numbers)) + (not same-number)) + (setq next-num + (if (elmo-localdir-locked-p) + ;; MDA is running. + (1+ (car (elmo-folder-status folder))) + (1+ next-num))))) + succeeds) + (luna-call-next-method))) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-localdir-folder) + numbers) + (dolist (number numbers) + (elmo-localdir-delete-message folder number)) + t) + +(defun elmo-localdir-delete-message (folder number) + "Delete message in the FOLDER with NUMBER." + (let ((filename (elmo-message-file-name folder number))) + (when (and (string-match "[0-9]+" filename) ; for safety. + (file-exists-p filename) + (file-writable-p filename) + (not (file-directory-p filename))) + (delete-file filename) + t))) + +(luna-define-method elmo-message-fetch-internal ((folder elmo-localdir-folder) + number strategy + &optional section unread) + (when (file-exists-p (elmo-message-file-name folder number)) + (insert-file-contents-as-binary + (elmo-message-file-name folder number)))) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-localdir-folder) &optional nohide) + (elmo-localdir-list-subr folder)) + +(luna-define-method elmo-folder-status ((folder elmo-localdir-folder)) + (elmo-localdir-list-subr folder t)) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder)) t) -(defun elmo-localdir-create-folder (spec) - (save-excursion - (let ((dir (elmo-localdir-get-folder-directory spec))) - (if (file-directory-p dir) - () - (if (file-exists-p dir) - (error "Create folder failed") - (elmo-make-directory dir)) - t - )))) - -(defun elmo-localdir-delete-folder (spec) - (let* ((dir (elmo-localdir-get-folder-directory spec))) +(luna-define-method elmo-folder-create ((folder elmo-localdir-folder)) + (let ((dir (elmo-localdir-folder-directory-internal folder))) + (if (file-directory-p dir) + () + (if (file-exists-p dir) + (error "Create folder failed") + (elmo-make-directory dir)) + t))) + +(luna-define-method elmo-folder-delete ((folder elmo-localdir-folder)) + (let ((dir (elmo-localdir-folder-directory-internal folder))) (if (not (file-directory-p dir)) (error "No such directory: %s" dir) (elmo-delete-directory dir t) t))) -(defun elmo-localdir-rename-folder (old-spec new-spec) - (let* ((old (elmo-localdir-get-folder-directory old-spec)) - (new (elmo-localdir-get-folder-directory new-spec)) +(luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder) + new-folder) + (let* ((old (elmo-localdir-folder-directory-internal folder)) + (new (elmo-localdir-folder-directory-internal folder)) (new-dir (directory-file-name (file-name-directory new)))) (if (not (file-directory-p old)) (error "No such directory: %s" old) @@ -358,54 +313,16 @@ (rename-file old new) t)))) -(defsubst elmo-localdir-field-primitive-condition-match (spec - 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))))) - (t - (elmo-set-work-buf - (as-binary-input-file (insert-file-contents - (expand-file-name - (int-to-string number) - (elmo-localdir-get-folder-directory spec)))) - (elmo-set-buffer-multibyte default-enable-multibyte-characters) - ;; Should consider charset? - (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset) - (setq result - (elmo-buffer-field-primitive-condition-match - condition number number-list))))) - (if (eq (elmo-filter-type condition) 'unmatch) - (setq result (not result))) - result)) - -(defun elmo-localdir-field-condition-match (spec condition number number-list) - (cond - ((vectorp condition) - (elmo-localdir-field-primitive-condition-match - spec condition number number-list)) - ((eq (car condition) 'and) - (and (elmo-localdir-field-condition-match - spec (nth 1 condition) number number-list) - (elmo-localdir-field-condition-match - spec (nth 2 condition) number number-list))) - ((eq (car condition) 'or) - (or (elmo-localdir-field-condition-match - spec (nth 1 condition) number number-list) - (elmo-localdir-field-condition-match - spec (nth 2 condition) number number-list))))) - -(defun elmo-localdir-search (spec condition &optional from-msgs) - (let* ((msgs (or from-msgs (elmo-localdir-list-folder spec))) +(defsubst elmo-localdir-field-condition-match (folder condition + number number-list) + (elmo-file-field-condition-match + (expand-file-name (int-to-string number) + (elmo-localdir-folder-directory-internal folder)) + condition number number-list)) + +(luna-define-method elmo-folder-search ((folder elmo-localdir-folder) + condition &optional numbers) + (let* ((msgs (or numbers (elmo-folder-list-messages folder))) (num (length msgs)) (i 0) last cur number-list case-fold-search ret-val) @@ -427,7 +344,7 @@ (t (setq number-list msgs) (while msgs - (if (elmo-localdir-field-condition-match spec condition + (if (elmo-localdir-field-condition-match folder condition (car msgs) number-list) (setq ret-val (cons (car msgs) ret-val))) (when (> num elmo-display-progress-threshold) @@ -441,45 +358,22 @@ (setq msgs (cdr msgs))) (nreverse ret-val))))) -;;; (localdir, maildir, localnews) -> localdir -(defun elmo-localdir-copy-msgs (dst-spec msgs src-spec - &optional loc-alist same-number) - (let ((dst-dir - (elmo-localdir-get-folder-directory dst-spec)) - (next-num (1+ (car (elmo-localdir-max-of-folder dst-spec))))) - (while msgs - (elmo-copy-file - ;; src file - (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist) - ;; dst file - (expand-file-name (int-to-string - (if same-number (car msgs) next-num)) - dst-dir)) - (if (and (setq msgs (cdr msgs)) - (not same-number)) - (setq next-num - (if (and (eq (car dst-spec) 'localdir) - (elmo-localdir-locked-p)) - ;; MDA is running. - (1+ (car (elmo-localdir-max-of-folder dst-spec))) - (1+ next-num))))) - t)) - -(defun elmo-localdir-pack-number (spec msgdb arg) - (let ((dir (elmo-localdir-get-folder-directory spec)) - (onum-alist (elmo-msgdb-get-number-alist msgdb)) - (omark-alist (elmo-msgdb-get-mark-alist msgdb)) - (new-number 1) ; first ordinal position in localdir - flist onum mark new-mark-alist total) +(luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder)) + (let* ((dir (elmo-localdir-folder-directory-internal folder)) + (msgdb (elmo-folder-msgdb folder)) + (onum-alist (elmo-msgdb-get-number-alist msgdb)) + (omark-alist (elmo-msgdb-get-mark-alist msgdb)) + (new-number 1) ; first ordinal position in localdir + flist onum mark new-mark-alist total) (setq flist (if elmo-pack-number-check-strict - (elmo-call-func spec "list-folder") ; allow localnews + (elmo-folder-list-messages folder) ; allow localnews (mapcar 'car onum-alist))) (setq total (length flist)) (while flist (when (> total elmo-display-progress-threshold) (elmo-display-progress - 'elmo-localdir-pack-number "Packing..." + 'elmo-folder-pack-numbers "Packing..." (/ (* new-number 100) total))) (setq onum (car flist)) (when (not (eq onum new-number)) ; why \=() is wrong.. @@ -502,23 +396,23 @@ (setq new-number (1+ new-number)) (setq flist (cdr flist))) (message "Packing...done") - (list (elmo-msgdb-get-overview msgdb) - onum-alist - new-mark-alist - (elmo-msgdb-get-location msgdb) - ;; remake hash table - (elmo-msgdb-make-overview-hashtb (elmo-msgdb-get-overview msgdb))))) - -(defun elmo-localdir-use-cache-p (spec number) - nil) - -(defun elmo-localdir-local-file-p (spec number) + (elmo-folder-set-msgdb-internal + folder + (list (elmo-msgdb-get-overview msgdb) + onum-alist + new-mark-alist + ;; remake hash table + (elmo-msgdb-make-overview-hashtb + (elmo-msgdb-get-overview msgdb)))))) + +(luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder)) t) -(defun elmo-localdir-get-msg-filename (spec number &optional loc-alist) +(luna-define-method elmo-message-file-name ((folder elmo-localdir-folder) + number) (expand-file-name (int-to-string number) - (elmo-localdir-get-folder-directory spec))) + (elmo-localdir-folder-directory-internal folder))) (defun elmo-localdir-locked-p () (if elmo-localdir-lockfile-list @@ -529,15 +423,6 @@ (throw 'found t)) (setq lock (cdr lock))))))) -(defalias 'elmo-localdir-sync-number-alist - 'elmo-generic-sync-number-alist) -(defalias 'elmo-localdir-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-localdir-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-localdir-commit 'elmo-generic-commit) -(defalias 'elmo-localdir-folder-diff 'elmo-generic-folder-diff) - (require 'product) (product-provide (provide 'elmo-localdir) (require 'elmo-version)) diff --git a/elmo/elmo-localnews.el b/elmo/elmo-localnews.el index 5b4e670..0193664 100644 --- a/elmo/elmo-localnews.el +++ b/elmo/elmo-localnews.el @@ -31,104 +31,14 @@ ;;; Code: ;; (require 'elmo-localdir) +(luna-define-class elmo-localnews-folder (elmo-localdir-folder) ()) -(defmacro elmo-localnews-as-newsdir (&rest body) - (` (let ((elmo-localdir-folder-path elmo-localnews-folder-path)) - (,@ body)))) +(luna-define-method elmo-localdir-folder-path ((folder elmo-localnews-folder)) + elmo-localnews-folder-path) -(defun elmo-localnews-msgdb-create-as-numlist (spec numlist new-mark - already-mark seen-mark - important-mark seen-list) - (when numlist - (elmo-localnews-as-newsdir - (elmo-localdir-msgdb-create-as-numlist spec numlist new-mark - already-mark seen-mark - important-mark seen-list)))) - -(defalias 'elmo-localnews-msgdb-create 'elmo-localnews-msgdb-create-as-numlist) - -(defun elmo-localnews-list-folders (spec &optional hierarchy) - (let ((folder (concat "=" (nth 1 spec)))) - (elmo-localnews-as-newsdir - (elmo-localdir-list-folders-subr folder hierarchy)))) - -(defun elmo-localnews-append-msg (spec string &optional msg no-see) - (elmo-localnews-as-newsdir - (elmo-localdir-append-msg spec string))) - -(defun elmo-localnews-delete-msgs (dir number) - (elmo-localnews-as-newsdir - (elmo-localdir-delete-msgs dir number))) - -(defun elmo-localnews-read-msg (spec number outbuf &optional msgdb unread) - (elmo-localnews-as-newsdir - (elmo-localdir-read-msg spec number outbuf))) - -(defun elmo-localnews-list-folder (spec &optional nohide) - (elmo-localnews-as-newsdir - (elmo-localdir-list-folder-subr spec))) - -(defun elmo-localnews-max-of-folder (spec) - (elmo-localnews-as-newsdir - (elmo-localdir-list-folder-subr spec t))) - -(defun elmo-localnews-check-validity (spec validity-file) - (elmo-localnews-as-newsdir - (elmo-localdir-check-validity spec validity-file))) - -(defun elmo-localnews-sync-validity (spec validity-file) - (elmo-localnews-as-newsdir - (elmo-localdir-sync-validity spec validity-file))) - -(defun elmo-localnews-folder-exists-p (spec) - (elmo-localnews-as-newsdir - (elmo-localdir-folder-exists-p spec))) - -(defun elmo-localnews-folder-creatable-p (spec) - t) - -(defun elmo-localnews-create-folder (spec) - (elmo-localnews-as-newsdir - (elmo-localdir-create-folder spec))) - -(defun elmo-localnews-delete-folder (spec) - (elmo-localnews-as-newsdir - (elmo-localdir-delete-folder spec))) - -(defun elmo-localnews-rename-folder (old-spec new-spec) - (elmo-localnews-as-newsdir - (elmo-localdir-rename-folder old-spec new-spec))) - -(defun elmo-localnews-search (spec condition &optional from-msgs) - (elmo-localnews-as-newsdir - (elmo-localdir-search spec condition from-msgs))) - -(defun elmo-localnews-copy-msgs (dst-spec msgs src-spec - &optional loc-alist same-number) - (elmo-localdir-copy-msgs - dst-spec msgs src-spec loc-alist same-number)) - -(defun elmo-localnews-pack-number (spec msgdb arg) - (elmo-localnews-as-newsdir - (elmo-localdir-pack-number spec msgdb arg))) - -(defun elmo-localnews-use-cache-p (spec number) - nil) - -(defun elmo-localnews-local-file-p (spec number) - t) - -(defun elmo-localnews-get-msg-filename (spec number &optional loc-alist) - (elmo-localnews-as-newsdir - (elmo-localdir-get-msg-filename spec number loc-alist))) - -(defalias 'elmo-localnews-sync-number-alist 'elmo-generic-sync-number-alist) -(defalias 'elmo-localnews-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-localnews-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-localnews-commit 'elmo-generic-commit) -(defalias 'elmo-localnews-folder-diff 'elmo-generic-folder-diff) +(luna-define-method elmo-localdir-folder-name ((folder elmo-localnews-folder) + name) + (elmo-replace-in-string name "\\." "/")) (require 'product) (product-provide (provide 'elmo-localnews) (require 'elmo-version)) diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el index 311318d..4bd8a08 100644 --- a/elmo/elmo-maildir.el +++ b/elmo/elmo-maildir.el @@ -30,59 +30,151 @@ ;; (eval-when-compile (require 'cl)) + (require 'elmo-util) -(require 'elmo-localdir) - -(defvar elmo-maildir-sequence-number-internal 0 - "Sequence number for the pid part of unique filename. -This variable should not be used in elsewhere.") - -(defsubst elmo-maildir-get-folder-directory (spec) - (if (file-name-absolute-p (nth 1 spec)) - (nth 1 spec) ; already full path. - (expand-file-name (nth 1 spec) - elmo-maildir-folder-path))) - -(defun elmo-maildir-number-to-filename (dir number loc-alist) - (let ((location (cdr (assq number loc-alist)))) - (and location (elmo-maildir-get-filename location dir)))) - -(defun elmo-maildir-get-filename (location dir) - "Get a filename that is corresponded to LOCATION in DIR." - (expand-file-name - (let ((file (file-name-completion (symbol-name location) - (expand-file-name "cur" dir)))) - (if (eq file t) (symbol-name location) file)) - (expand-file-name "cur" dir))) +(require 'elmo) +(require 'elmo-map) + +;;; ELMO Maildir folder +(eval-and-compile + (luna-define-class elmo-maildir-folder + (elmo-map-folder) + (directory unread-locations flagged-locations)) + (luna-define-internal-accessors 'elmo-maildir-folder)) + +(luna-define-method elmo-folder-initialize ((folder + elmo-maildir-folder) + name) + (if (file-name-absolute-p name) + (elmo-maildir-folder-set-directory-internal + folder + (expand-file-name name)) + (elmo-maildir-folder-set-directory-internal + folder + (expand-file-name + name + elmo-maildir-folder-path))) + folder) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-maildir-folder)) + (expand-file-name + (elmo-replace-string-as-filename + (elmo-maildir-folder-directory-internal folder)) + (expand-file-name + "maildir" + elmo-msgdb-dir))) + +(defun elmo-maildir-message-file-name (folder location) + "Get a file name of the message from FOLDER which corresponded to +LOCATION." + (let ((file (file-name-completion + location + (expand-file-name + "cur" + (elmo-maildir-folder-directory-internal folder))))) + (if file + (expand-file-name + (if (eq file t) location file) + (expand-file-name + "cur" + (elmo-maildir-folder-directory-internal folder)))))) (defsubst elmo-maildir-list-location (dir &optional child-dir) (let* ((cur-dir (expand-file-name (or child-dir "cur") dir)) (cur (directory-files cur-dir nil "^[^.].*$" t)) - seen-list seen sym list) - (setq list + unread-locations flagged-locations seen flagged sym + locations) + (setq locations (mapcar (lambda (x) (if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x) (progn (setq seen nil) (save-match-data - (if (string-match - "S" - (elmo-match-string 2 x)) - (setq seen t))) - (setq sym (intern (elmo-match-string 1 x))) - (if seen - (setq seen-list (cons sym seen-list))) + (cond + ((string-match "S" (elmo-match-string 2 x)) + (setq seen t)) + ((string-match "F" (elmo-match-string 2 x)) + (setq flagged t)))) + (setq sym (elmo-match-string 1 x)) + (unless seen (setq unread-locations + (cons sym unread-locations))) + (if flagged (setq flagged-locations + (cons sym flagged-locations))) sym) - (intern x))) + x)) cur)) - (cons list seen-list))) - -(defun elmo-maildir-msgdb-create-entity (dir number loc-alist) - (elmo-localdir-msgdb-create-overview-entity-from-file - number - (elmo-maildir-number-to-filename dir number loc-alist))) + (list locations unread-locations flagged-locations))) + +(luna-define-method elmo-map-folder-list-message-locations + ((folder elmo-maildir-folder)) + (elmo-maildir-update-current folder) + (let ((locs (elmo-maildir-list-location + (elmo-maildir-folder-directory-internal folder)))) + ;; 0: locations, 1: unread-locations, 2: flagged-locations + (elmo-maildir-folder-set-unread-locations-internal folder (nth 1 locs)) + (elmo-maildir-folder-set-flagged-locations-internal folder (nth 2 locs)) + (nth 0 locs))) + +(luna-define-method elmo-map-folder-list-unreads + ((folder elmo-maildir-folder)) + (elmo-maildir-folder-unread-locations-internal folder)) + +(luna-define-method elmo-map-folder-list-importants + ((folder elmo-maildir-folder)) + (elmo-maildir-folder-flagged-locations-internal folder)) + +(luna-define-method elmo-folder-msgdb-create + ((folder elmo-maildir-folder) + numbers new-mark already-mark seen-mark important-mark seen-list) + (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder)) + (flagged-list (elmo-maildir-folder-flagged-locations-internal folder)) + (len (length numbers)) + (i 0) + overview number-alist mark-alist entity + location pair mark) + (message "Creating msgdb...") + (dolist + (number numbers) + (setq location (elmo-map-message-location folder number)) + (setq entity + (elmo-msgdb-create-overview-entity-from-file + number + (elmo-maildir-message-file-name folder location))) + (when entity + (setq overview + (elmo-msgdb-append-element overview entity)) + (setq number-alist + (elmo-msgdb-number-add number-alist + (elmo-msgdb-overview-entity-get-number + entity) + (elmo-msgdb-overview-entity-get-id + entity))) + (cond + ((member location unread-list) + (setq mark new-mark)) ; unread! + ((member location flagged-list) + (setq mark important-mark))) + (if (setq mark (or (elmo-msgdb-global-mark-get + (elmo-msgdb-overview-entity-get-id + entity)) + mark)) + (setq mark-alist + (elmo-msgdb-mark-append + mark-alist + (elmo-msgdb-overview-entity-get-number + entity) + mark))) + (when (> len elmo-display-progress-threshold) + (setq i (1+ i)) + (elmo-display-progress + 'elmo-maildir-msgdb-create "Creating msgdb..." + (/ (* i 100) len))))) + (message "Creating msgdb...done") + (elmo-msgdb-sort-by-date + (list overview number-alist mark-alist)))) (defun elmo-maildir-cleanup-temporal (dir) ;; Delete files in the tmp dir which are not accessed @@ -104,9 +196,9 @@ This variable should not be used in elsewhere.") t ; full "^[^.].*$" t)))) -(defun elmo-maildir-update-current (spec) +(defun elmo-maildir-update-current (folder) "Move all new msgs to cur in the maildir." - (let* ((maildir (elmo-maildir-get-folder-directory spec)) + (let* ((maildir (elmo-maildir-folder-directory-internal folder)) (news (directory-files (expand-file-name "new" maildir) nil @@ -133,7 +225,8 @@ This variable should not be used in elsewhere.") (char-list-to-string flaglist))))) ;; Rescue no info file in maildir. (rename-file filename - (concat filename ":2," (char-to-string mark))))) + (concat filename ":2," (char-to-string mark)))) + t) (defun elmo-maildir-delete-mark (filename mark) "Mark the FILENAME file in the maildir. MARK is a character." @@ -147,113 +240,55 @@ This variable should not be used in elsewhere.") (if flaglist (char-list-to-string flaglist)))))))) -(defsubst elmo-maildir-set-mark-msgs (spec mark msgs msgdb) - (let ((dir (elmo-maildir-get-folder-directory spec)) - (locs (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path spec)))) - file) - (while msgs - (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs)) - (elmo-maildir-set-mark file mark)) - (setq msgs (cdr msgs))))) - -(defsubst elmo-maildir-delete-mark-msgs (spec mark msgs msgdb) - (let ((dir (elmo-maildir-get-folder-directory spec)) - (locs (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path spec)))) - file) - (while msgs - (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs)) - (elmo-maildir-delete-mark file mark)) - (setq msgs (cdr msgs))))) - -(defun elmo-maildir-mark-as-important (spec msgs &optional msgdb) - (elmo-maildir-set-mark-msgs spec ?F msgs msgdb)) +(defsubst elmo-maildir-set-mark-msgs (folder locs mark) + (dolist (loc locs) + (elmo-maildir-set-mark + (elmo-maildir-message-file-name folder loc) + mark)) + t) + +(defsubst elmo-maildir-delete-mark-msgs (folder locs mark) + (dolist (loc locs) + (elmo-maildir-delete-mark + (elmo-maildir-message-file-name folder loc) + mark)) + t) + +(luna-define-method elmo-map-folder-mark-as-important ((folder elmo-maildir-folder) + locs) + (elmo-maildir-set-mark-msgs folder locs ?F)) -(defun elmo-maildir-unmark-important (spec msgs &optional msgdb) - (elmo-maildir-delete-mark-msgs spec ?F msgs msgdb)) - -(defun elmo-maildir-mark-as-read (spec msgs &optional msgdb) - (elmo-maildir-set-mark-msgs spec ?S msgs msgdb)) - -(defun elmo-maildir-mark-as-unread (spec msgs &optional msgdb) - (elmo-maildir-delete-mark-msgs spec ?S msgs msgdb)) - -(defun elmo-maildir-msgdb-create (spec numlist new-mark - already-mark seen-mark - important-mark - seen-list - &optional msgdb) - (when numlist - (let* ((dir (elmo-maildir-get-folder-directory spec)) - (loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec)))) - (loc-seen (elmo-maildir-list-location dir)) - (loc-list (car loc-seen)) - (seen-list (cdr loc-seen)) - overview number-alist mark-alist entity - i percent num location pair) - (setq num (length numlist)) - (setq i 0) - (message "Creating msgdb...") - (while numlist - (setq entity - (elmo-maildir-msgdb-create-entity - dir (car numlist) loc-alist)) - (if (null entity) - () - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq number-alist - (elmo-msgdb-number-add number-alist - (elmo-msgdb-overview-entity-get-number - entity) - (elmo-msgdb-overview-entity-get-id - entity))) - (setq location (cdr (assq (car numlist) loc-alist))) - (unless (member location seen-list) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - (elmo-msgdb-overview-entity-get-number - entity) - (or (elmo-msgdb-global-mark-get - (elmo-msgdb-overview-entity-get-id - entity)) - new-mark))))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (setq percent (/ (* i 100) num)) - (elmo-display-progress - 'elmo-maildir-msgdb-create "Creating msgdb..." - percent)) - (setq numlist (cdr numlist))) - (message "Creating msgdb...done") - (elmo-msgdb-sort-by-date - (list overview number-alist mark-alist loc-alist))))) - -(defalias 'elmo-maildir-msgdb-create-as-numlist 'elmo-maildir-msgdb-create) - -(defun elmo-maildir-list-folders (spec &optional hierarchy) - (let ((elmo-localdir-folder-path elmo-maildir-folder-path) - (elmo-localdir-list-folders-spec-string ".") - (elmo-localdir-list-folders-filter-regexp +(luna-define-method elmo-map-folder-unmark-important ((folder elmo-maildir-folder) + locs) + (elmo-maildir-delete-mark-msgs folder locs ?F)) + +(luna-define-method elmo-map-folder-mark-as-read ((folder elmo-maildir-folder) + locs) + (elmo-maildir-set-mark-msgs folder locs ?S)) + +(luna-define-method elmo-map-folder-unmark-read ((folder elmo-maildir-folder) + locs) + (elmo-maildir-delete-mark-msgs folder locs ?S)) + +(luna-define-method elmo-folder-list-subfolders + ((folder elmo-maildir-folder) &optional one-level) + (let ((prefix (concat (elmo-folder-name-internal folder) + (unless (string= (elmo-folder-prefix-internal folder) + (elmo-folder-name-internal folder)) + elmo-path-sep))) + (elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$") - elmo-have-link-count folders) - (setq folders (elmo-localdir-list-folders spec hierarchy)) - (if (eq (length (nth 1 spec)) 0) ; top - (setq folders (append - (list (concat elmo-localdir-list-folders-spec-string - (nth 1 spec))) - folders))) - (elmo-delete-if - (function (lambda (folder) - (not (or (listp folder) (elmo-folder-exists-p folder))))) - folders))) + elmo-have-link-count) + (append + (list (elmo-folder-name-internal folder)) + (elmo-mapcar-list-of-list + (function (lambda (x) (concat prefix x))) + (elmo-list-subdirectories + (elmo-maildir-folder-directory-internal folder) + "" + one-level))))) + +(defvar elmo-maildir-sequence-number-internal 0) (static-cond ((>= emacs-major-version 19) @@ -301,13 +336,17 @@ file name for maildir directories." basedir))) filename)) -(defun elmo-maildir-append-msg (spec string &optional msg no-see) - (let ((basedir (elmo-maildir-get-folder-directory spec)) - filename) +(luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder) + unread &optional number) + (let ((basedir (elmo-maildir-folder-directory-internal folder)) + (src-buf (current-buffer)) + dst-buf filename) (condition-case nil (with-temp-buffer (setq filename (elmo-maildir-temporal-filename basedir)) - (insert string) + (setq dst-buf (current-buffer)) + (with-current-buffer src-buf + (copy-to-buffer dst-buf (point-min) (point-max))) (as-binary-output-file (write-region (point-min) (point-max) filename nil 'no-msg)) ;; add link from new. @@ -320,207 +359,137 @@ file name for maildir directories." ;; If an error occured, return nil. (error)))) -(defun elmo-maildir-delete-msg (spec number loc-alist) - (let ((dir (elmo-maildir-get-folder-directory spec)) - file) - (setq file (elmo-maildir-number-to-filename dir number loc-alist)) - (if (and (file-writable-p file) - (not (file-directory-p file))) - (progn (delete-file file) - t)))) +(luna-define-method elmo-folder-message-file-p ((folder elmo-maildir-folder)) + t) -(defun elmo-maildir-read-msg (spec number outbuf &optional msgdb unread) - (save-excursion - (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec)))) - (dir (elmo-maildir-get-folder-directory spec)) - (file (elmo-maildir-number-to-filename dir number loc-alist))) - (set-buffer outbuf) - (erase-buffer) - (when (file-exists-p file) - (as-binary-input-file (insert-file-contents file)) - (elmo-delete-cr-get-content-type))))) - -(defun elmo-maildir-delete-msgs (spec msgs &optional msgdb) - (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec))))) - (mapcar '(lambda (msg) (elmo-maildir-delete-msg spec msg - loc-alist)) - msgs))) - -(defsubst elmo-maildir-list-folder-subr (spec &optional nonsort) - (let* ((dir (elmo-maildir-get-folder-directory spec)) - (flist (elmo-list-folder-by-location - spec - (car (elmo-maildir-list-location dir)))) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - (news (car (elmo-maildir-list-location dir "new"))) - numbers) - (if nonsort - (cons (+ (or (elmo-max-of-list flist) 0) (length news)) - (+ (length news) - (if killed - (- (length flist) - (elmo-msgdb-killed-list-length killed)) - (length flist)))) - (setq numbers (sort flist '<)) - (elmo-living-messages numbers killed)))) - -(defun elmo-maildir-list-folder (spec &optional nohide) - (elmo-maildir-update-current spec) - (elmo-maildir-list-folder-subr spec)) - -(defun elmo-maildir-max-of-folder (spec) - (elmo-maildir-list-folder-subr spec t)) - -(defalias 'elmo-maildir-check-validity 'elmo-localdir-check-validity) - -(defalias 'elmo-maildir-sync-validity 'elmo-localdir-sync-validity) - -(defun elmo-maildir-folder-exists-p (spec) - (let ((basedir (elmo-maildir-get-folder-directory spec))) +(luna-define-method elmo-message-file-name ((folder elmo-maildir-folder) + number) + (elmo-maildir-message-file-name + folder + (elmo-map-message-location folder number))) + +(luna-define-method elmo-folder-message-make-temp-file-p + ((folder elmo-maildir-folder)) + t) + +(luna-define-method elmo-folder-message-make-temp-files ((folder + elmo-maildir-folder) + numbers + &optional + start-number) + (let ((temp-dir (elmo-folder-make-temp-dir 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-folder-append-messages :around + ((folder elmo-maildir-folder) + src-folder numbers unread-marks &optional same-number) + (if (elmo-folder-message-file-p src-folder) + (let ((dir (elmo-maildir-folder-directory-internal folder)) + (succeeds numbers) + filename) + (setq filename (elmo-maildir-temporal-filename dir)) + (dolist (number numbers) + (elmo-copy-file + (elmo-message-file-name src-folder number) + filename) + (elmo-add-name-to-file + filename + (expand-file-name + (concat "new/" (file-name-nondirectory filename)) + dir))) + succeeds) + (luna-call-next-method))) + +(luna-define-method elmo-map-folder-delete-messages + ((folder elmo-maildir-folder) locations) + (let (file) + (dolist (location locations) + (setq file (elmo-maildir-message-file-name folder location)) + (if (and file + (file-writable-p file) + (not (file-directory-p file))) + (delete-file file))))) + +(luna-define-method elmo-map-message-fetch ((folder elmo-maildir-folder) + location strategy + &optional section unseen) + (let ((file (elmo-maildir-message-file-name folder location))) + (when (file-exists-p file) + (insert-file-contents-as-binary file)))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-maildir-folder)) + (let ((basedir (elmo-maildir-folder-directory-internal folder))) (and (file-directory-p (expand-file-name "new" basedir)) (file-directory-p (expand-file-name "cur" basedir)) (file-directory-p (expand-file-name "tmp" basedir))))) -(defun elmo-maildir-folder-creatable-p (spec) +(luna-define-method elmo-folder-diff ((folder elmo-maildir-folder) + &optional numbers) + (let* ((dir (elmo-maildir-folder-directory-internal folder)) + (new-len (length (car (elmo-maildir-list-location dir "new")))) + (cur-len (length (car (elmo-maildir-list-location dir "cur"))))) + (cons new-len (+ new-len cur-len)))) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-maildir-folder)) t) -(defun elmo-maildir-create-folder (spec) - (let ((basedir (elmo-maildir-get-folder-directory spec))) +(luna-define-method elmo-folder-create ((folder elmo-maildir-folder)) + (let ((basedir (elmo-maildir-folder-directory-internal folder))) (condition-case nil (progn - (mapcar (function (lambda (dir) - (setq dir (expand-file-name dir basedir)) - (or (file-directory-p dir) - (progn - (elmo-make-directory dir) - (set-file-modes dir 448))))) - '("." "new" "cur" "tmp")) + (dolist (dir '("." "new" "cur" "tmp")) + (setq dir (expand-file-name dir basedir)) + (or (file-directory-p dir) + (progn + (elmo-make-directory dir) + (set-file-modes dir 448)))) t) (error)))) -(defun elmo-maildir-delete-folder (spec) - (let ((basedir (elmo-maildir-get-folder-directory spec))) +(luna-define-method elmo-folder-delete ((folder elmo-maildir-folder)) + (let ((basedir (elmo-maildir-folder-directory-internal folder))) (condition-case nil (let ((tmp-files (directory-files (expand-file-name "tmp" basedir) t "[^.].*"))) ;; Delete files in tmp. - (and tmp-files (mapcar 'delete-file tmp-files)) - (mapcar - (function - (lambda (dir) - (setq dir (expand-file-name dir basedir)) - (if (not (file-directory-p dir)) - (error nil) - (elmo-delete-directory dir t)))) - '("new" "cur" "tmp" ".")) + (dolist (file tmp-files) + (delete-file file)) + (dolist (dir '("new" "cur" "tmp" ".")) + (setq dir (expand-file-name dir basedir)) + (if (not (file-directory-p dir)) + (error nil) + (elmo-delete-directory dir t))) t) (error nil)))) -(defun elmo-maildir-search (spec condition &optional from-msgs msgdb) +(luna-define-method elmo-folder-search ((folder elmo-maildir-folder) + condition &optional numbers) (save-excursion - (let* ((msgs (or from-msgs (elmo-maildir-list-folder spec))) - (loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load (elmo-msgdb-expand-path - spec)))) - (dir (elmo-maildir-get-folder-directory spec)) + (let* ((msgs (or numbers (elmo-folder-list-messages folder))) (i 0) - case-fold-search ret-val + case-fold-search matches percent num - (num (length msgs)) + (len (length msgs)) number-list msg-num) (setq number-list msgs) - (while msgs - (setq msg-num (car msgs)) + (dolist (number numbers) (if (elmo-file-field-condition-match - (elmo-maildir-number-to-filename - dir (car msgs) loc-alist) - condition (car msgs) number-list) - (setq ret-val (append ret-val (list msg-num)))) + (elmo-message-file-name folder number) + condition number number-list) + (setq matches (cons number matches))) (setq i (1+ i)) - (setq percent (/ (* i 100) num)) (elmo-display-progress 'elmo-maildir-search "Searching..." - percent) - (setq msgs (cdr msgs))) - ret-val))) - -;;; (maildir) -> maildir -(defun elmo-maildir-copy-msgs (dst-spec msgs src-spec - &optional loc-alist same-number) - (let (srcfile) - (while msgs - (setq srcfile - (elmo-maildir-get-msg-filename src-spec (car msgs) loc-alist)) - (elmo-copy-file - ;; src file - srcfile - ;; dst file - (expand-file-name - (file-name-nondirectory srcfile) - (concat (elmo-maildir-get-folder-directory dst-spec) "/cur"))) - (setq msgs (cdr msgs)))) - t) - -(defun elmo-maildir-use-cache-p (spec number) - nil) - -(defun elmo-maildir-local-file-p (spec number) - t) - -(defun elmo-maildir-get-msg-filename (spec number &optional loc-alist) - (elmo-maildir-number-to-filename - (elmo-maildir-get-folder-directory spec) - number (or loc-alist (elmo-msgdb-location-load - (elmo-msgdb-expand-path - spec))))) - -(defun elmo-maildir-pack-number (spec msgdb arg) - (let ((old-number-alist (elmo-msgdb-get-number-alist msgdb)) - (old-overview (elmo-msgdb-get-overview msgdb)) - (old-mark-alist (elmo-msgdb-get-mark-alist msgdb)) - (old-location (elmo-msgdb-get-location msgdb)) - old-number overview number-alist mark-alist location - mark (number 1)) - (setq overview old-overview) - (while old-overview - (setq old-number - (elmo-msgdb-overview-entity-get-number (car old-overview))) - (elmo-msgdb-overview-entity-set-number (car old-overview) number) - (setq number-alist - (cons (cons number (cdr (assq old-number old-number-alist))) - number-alist)) - (when (setq mark (cadr (assq old-number old-mark-alist))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist number mark))) - (setq location - (cons (cons number (cdr (assq old-number old-location))) - location)) - (setq number (1+ number)) - (setq old-overview (cdr old-overview))) - ;; XXX Should consider when folder is not persistent. - (elmo-msgdb-location-save (elmo-msgdb-expand-path spec) location) - (list overview - (nreverse number-alist) - (nreverse mark-alist) - (nreverse location) - (elmo-msgdb-make-overview-hashtb overview)))) - -(defalias 'elmo-maildir-sync-number-alist - 'elmo-generic-sync-number-alist) -(defalias 'elmo-maildir-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-maildir-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-maildir-commit 'elmo-generic-commit) -(defalias 'elmo-maildir-folder-diff 'elmo-generic-folder-diff) + (/ (* i 100) len))) + (nreverse matches)))) (require 'product) (product-provide (provide 'elmo-maildir) (require 'elmo-version)) diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el new file mode 100644 index 0000000..b3e4612 --- /dev/null +++ b/elmo/elmo-map.el @@ -0,0 +1,314 @@ +;;; elmo-map.el -- A ELMO folder class with message number mapping. + +;; Copyright (C) 2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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: +;; Folders which do not have unique message numbers but unique message names +;; should inherit this folder. + +;;; Code: +;; +(require 'elmo) +(require 'elmo-msgdb) + +(eval-when-compile (require 'cl)) + +(eval-and-compile + ;; location-hash: location->number mapping + ;; number-hash: number->location mapping + (luna-define-class elmo-map-folder (elmo-folder) + (location-alist number-max location-hash)) + (luna-define-internal-accessors 'elmo-map-folder)) + +(defun elmo-map-folder-numbers-to-locations (folder numbers) + (let (locations pair) + (dolist (number numbers) + (if (setq pair (elmo-get-hash-val + (concat "#" (int-to-string number)) + (elmo-map-folder-location-hash-internal folder))) + (setq locations (cons (cdr pair) locations)))) + (nreverse locations))) + +(defun elmo-map-folder-locations-to-numbers (folder locations) + (let (numbers pair) + (dolist (location locations) + (if (setq pair (elmo-get-hash-val + location + (elmo-map-folder-location-hash-internal folder))) + (setq numbers (cons (car pair) numbers)))) + (nreverse numbers))) + +(luna-define-generic elmo-map-folder-list-message-locations (folder) + "Return a location list of the FOLDER.") + +(luna-define-generic elmo-map-folder-unmark-important (folder locations) + "") + +(luna-define-generic elmo-map-folder-mark-as-important (folder locations) + "") + +(luna-define-generic elmo-map-folder-unmark-read (folder locations) + "") + +(luna-define-generic elmo-map-folder-mark-as-read (folder locations) + "") + +(luna-define-generic elmo-map-message-fetch (folder location + strategy + &optional + section + unseen) + "") + +(luna-define-generic elmo-map-folder-list-unreads (folder) + "") + +(luna-define-generic elmo-map-folder-list-importants (folder) + "") + +(luna-define-method elmo-map-folder-list-importants ((folder elmo-map-folder)) + t) + +(luna-define-generic elmo-map-folder-delete-messages (folder locations) + "") + +(luna-define-method elmo-folder-status ((folder elmo-map-folder)) + (elmo-folder-open-internal folder) + (prog1 + (let ((numbers (mapcar + 'car + (elmo-map-folder-location-alist-internal folder)))) + (cons (elmo-max-of-list numbers) + (length numbers))) + ;; Don't close after status. + (unless (elmo-folder-reserve-status-p folder) + (elmo-folder-close-internal folder)))) + +(defun elmo-map-message-number (folder location) + "Return number of the message in the FOLDER with LOCATION." + (car (elmo-get-hash-val + location + (elmo-map-folder-location-hash-internal folder)))) + +(defun elmo-map-message-location (folder number) + "Return location of the message in the FOLDER with NUMBER." + (cdr (elmo-get-hash-val + (concat "#" (int-to-string number)) + (elmo-map-folder-location-hash-internal folder)))) + +(luna-define-method elmo-folder-pack-number ((folder elmo-map-folder)) + (let* ((msgdb (elmo-folder-msgdb folder)) + (old-number-alist (elmo-msgdb-get-number-alist msgdb)) + (old-overview (elmo-msgdb-get-overview msgdb)) + (old-mark-alist (elmo-msgdb-get-mark-alist msgdb)) + (old-location (elmo-map-folder-location-alist-internal folder)) + old-number overview number-alist mark-alist location + mark (number 1)) + (setq overview old-overview) + (while old-overview + (setq old-number + (elmo-msgdb-overview-entity-get-number (car old-overview))) + (elmo-msgdb-overview-entity-set-number (car old-overview) number) + (setq number-alist + (cons (cons number (cdr (assq old-number old-number-alist))) + number-alist)) + (when (setq mark (cadr (assq old-number old-mark-alist))) + (setq mark-alist + (elmo-msgdb-mark-append + mark-alist number mark))) + (setq location + (cons (cons number + (elmo-map-message-location folder old-number)) + location)) + (setq number (1+ number)) + (setq old-overview (cdr old-overview))) + (elmo-map-folder-location-setup folder (nreverse location)) + (elmo-folder-set-msgdb-internal + folder + (list overview + (nreverse number-alist) + (nreverse mark-alist) + (elmo-msgdb-make-overview-hashtb overview))))) + +(defun elmo-map-folder-location-setup (folder locations) + (elmo-map-folder-set-location-alist-internal + folder + locations) + (elmo-map-folder-set-location-hash-internal + folder (elmo-make-hash + (* 2 (length locations)))) + (elmo-map-folder-set-number-max-internal folder 0) + ;; Set number-max and hashtables. + (dolist (location-cons locations) + (if (< (elmo-map-folder-number-max-internal folder) + (car location-cons)) + (elmo-map-folder-set-number-max-internal folder (car location-cons))) + (elmo-set-hash-val (cdr location-cons) + location-cons + (elmo-map-folder-location-hash-internal folder)) + (elmo-set-hash-val (concat "#" (int-to-string (car location-cons))) + location-cons + (elmo-map-folder-location-hash-internal folder)))) + +(defun elmo-map-folder-update-locations (folder locations) + ;; A subroutine to make location-alist. + ;; location-alist is existing location-alist. + ;; locations is the newest locations. + (let* ((location-alist (elmo-map-folder-location-alist-internal folder)) + (locations-in-db (mapcar 'cdr location-alist)) + new-locs new-alist deleted-locs pair i) + (setq new-locs + (elmo-delete-if (function + (lambda (x) (member x locations-in-db))) + locations)) + (setq deleted-locs + (elmo-delete-if (function + (lambda (x) (member x locations))) + locations-in-db)) + (dolist (location deleted-locs) + (setq location-alist + (delq (setq pair + (elmo-get-hash-val + location + (elmo-map-folder-location-hash-internal + folder))) + location-alist)) + (when pair + (elmo-clear-hash-val (concat "#" (int-to-string (car pair))) + (elmo-map-folder-location-hash-internal + folder)) + (elmo-clear-hash-val location + (elmo-map-folder-location-hash-internal + folder)))) + (setq i (elmo-map-folder-number-max-internal folder)) + (dolist (location new-locs) + (setq i (1+ i)) + (elmo-map-folder-set-number-max-internal folder i) + (setq new-alist (cons (setq pair (cons i location)) new-alist)) + (setq new-alist (nreverse new-alist)) + (elmo-set-hash-val (concat "#" (int-to-string i)) + pair + (elmo-map-folder-location-hash-internal + folder)) + (elmo-set-hash-val location + pair + (elmo-map-folder-location-hash-internal + folder))) + (setq location-alist + (sort (nconc location-alist new-alist) + (lambda (x y) (< (car x) (car y))))) + (elmo-map-folder-set-location-alist-internal folder location-alist))) + +(luna-define-method elmo-folder-open-internal ((folder elmo-map-folder)) + (elmo-map-folder-location-setup + folder + (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))) + (if (elmo-folder-plugged-p folder) + (elmo-map-folder-update-locations + folder + (elmo-map-folder-list-message-locations folder)))) + +(luna-define-method elmo-folder-commit :after ((folder elmo-map-folder)) + (when (elmo-folder-persistent-p folder) + (elmo-msgdb-location-save (elmo-folder-msgdb-path folder) + (elmo-map-folder-location-alist-internal + folder)))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-map-folder)) + (elmo-map-folder-set-location-alist-internal folder nil) + (elmo-map-folder-set-location-hash-internal folder nil)) + +(luna-define-method elmo-folder-check ((folder elmo-map-folder)) + (elmo-map-folder-update-locations + folder + (elmo-map-folder-list-message-locations folder))) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-map-folder) &optional nohide) + (mapcar 'car (elmo-map-folder-location-alist-internal folder))) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-map-folder) + numbers) + (elmo-map-folder-unmark-important + folder + (elmo-map-folder-numbers-to-locations folder numbers))) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-map-folder) + numbers) + (elmo-map-folder-mark-as-important + folder + (elmo-map-folder-numbers-to-locations folder numbers))) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-map-folder) + numbers) + (elmo-map-folder-unmark-read + folder + (elmo-map-folder-numbers-to-locations folder numbers))) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-map-folder) numbers) + (elmo-map-folder-mark-as-read + folder + (elmo-map-folder-numbers-to-locations folder numbers))) + +(luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder) + number strategy + &optional section unread) + (elmo-map-message-fetch + folder + (elmo-map-message-location folder number) + strategy section unread)) + +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-map-folder) unread-marks &optional mark-alist) + (elmo-map-folder-locations-to-numbers + folder + (elmo-map-folder-list-unreads folder))) + +(luna-define-method elmo-folder-list-importants-internal + ((folder elmo-map-folder) important-mark) + (let ((locations (elmo-map-folder-list-importants folder))) + (if (listp locations) + (elmo-map-folder-locations-to-numbers folder locations) + t))) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder) + numbers) + (elmo-map-folder-delete-messages + folder + (elmo-map-folder-numbers-to-locations folder numbers)) + (dolist (number numbers) + (elmo-map-folder-set-location-alist-internal + folder + (delq (elmo-get-hash-val + (concat "#" (int-to-string number)) + (elmo-map-folder-location-hash-internal + folder)) + (elmo-map-folder-location-alist-internal folder)))) + t) ; success + + +(require 'product) +(product-provide (provide 'elmo-map) (require 'elmo-version)) + +;;; elmo-map.el ends here diff --git a/elmo/elmo-mark.el b/elmo/elmo-mark.el new file mode 100644 index 0000000..b531e83 --- /dev/null +++ b/elmo/elmo-mark.el @@ -0,0 +1,209 @@ +;;; elmo-mark.el -- Global mark folder for ELMO. + +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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: +;; +(require 'elmo) +(require 'elmo-map) + +(defcustom elmo-mark-default-mark "$" + "*Default global-mark for mark-folder." + :type 'string + :group 'elmo) + +;;; ELMO mark folder +(eval-and-compile + (luna-define-class elmo-mark-folder (elmo-map-folder) (mark)) + (luna-define-internal-accessors 'elmo-mark-folder)) + +(luna-define-method elmo-folder-initialize ((folder + elmo-mark-folder) + name) + (elmo-mark-folder-set-mark-internal + folder + elmo-mark-default-mark) + folder) + +(luna-define-method elmo-folder-have-subfolder-p ((folder elmo-mark-folder)) + nil) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-mark-folder)) + (expand-file-name "mark" + (expand-file-name "internal" + elmo-msgdb-dir))) + +(luna-define-method elmo-map-folder-list-message-locations + ((folder elmo-mark-folder)) + (elmo-mark-folder-list-message-locations folder)) + +(defun elmo-mark-folder-list-message-locations (folder) + (let (result) + (dolist (pair (or elmo-msgdb-global-mark-alist + (setq elmo-msgdb-global-mark-alist + (elmo-object-load + (expand-file-name + elmo-msgdb-global-mark-filename + elmo-msgdb-dir))))) + (if (string= (elmo-mark-folder-mark-internal folder) + (cdr pair)) + (setq result (cons (car pair) result)))) + (nreverse result))) + +(luna-define-method elmo-folder-message-file-p ((folder elmo-mark-folder)) + t) + +(luna-define-method elmo-message-file-name ((folder elmo-mark-folder) + number) + (elmo-file-cache-get-path + (elmo-map-message-location folder number))) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-mark-folder) + numbers new-mark + already-mark seen-mark + important-mark + seen-list) + (elmo-mark-folder-msgdb-create folder numbers new-mark already-mark + seen-mark important-mark)) + +(defun elmo-mark-folder-msgdb-create (folder numbers new-mark already-mark + seen-mark important-mark) + (let ((i 0) + (len (length numbers)) + overview number-alist mark-alist entity message-id + num) + (message "Creating msgdb...") + (while numbers + (setq entity + (elmo-msgdb-create-overview-entity-from-file + (car numbers) (elmo-message-file-name folder (car numbers)))) + (if (null entity) + () + (setq num (elmo-msgdb-overview-entity-get-number entity)) + (setq overview + (elmo-msgdb-append-element + overview entity)) + (setq message-id (elmo-msgdb-overview-entity-get-id entity)) + (setq number-alist + (elmo-msgdb-number-add number-alist + num + message-id)) + (setq mark-alist + (elmo-msgdb-mark-append + mark-alist + num (elmo-mark-folder-mark-internal folder)))) + (when (> len elmo-display-progress-threshold) + (setq i (1+ i)) + (elmo-display-progress + 'elmo-mark-folder-msgdb-create "Creating msgdb..." + (/ (* i 100) len))) + (setq numbers (cdr numbers))) + (message "Creating msgdb...done") + (list overview number-alist mark-alist))) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-mark-folder) + unread &optional number) + (let* ((msgid (elmo-field-body "message-id")) + (path (elmo-file-cache-get-path msgid)) + dir) + (when path + (setq dir (directory-file-name (file-name-directory path))) + (unless (file-exists-p dir) + (elmo-make-directory dir)) + (when (file-writable-p path) + (write-region-as-binary (point-min) (point-max) + path nil 'no-msg))) + (elmo-msgdb-global-mark-set msgid + (elmo-mark-folder-mark-internal folder)))) + +(luna-define-method elmo-map-folder-delete-messages ((folder elmo-mark-folder) + locations) + (dolist (location locations) + (elmo-msgdb-global-mark-delete location))) + +(luna-define-method elmo-message-fetch-with-cache-process + ((folder elmo-mark-folder) number strategy &optional section unseen) + ;; disbable cache process + (elmo-message-fetch-internal folder number strategy section unseen)) + +(luna-define-method elmo-map-message-fetch ((folder elmo-mark-folder) + location strategy + &optional section unseen) + (let ((file (elmo-file-cache-get-path location))) + (when (file-exists-p file) + (insert-file-contents-as-binary file)))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-mark-folder)) + t) + +(luna-define-method elmo-folder-search ((folder elmo-mark-folder) + condition &optional from-msgs) + (let* ((msgs (or from-msgs (elmo-folder-list-messages folder))) + (number-list msgs) + (i 0) + (num (length msgs)) + file + matched + case-fold-search) + (while msgs + (if (and (setq file (elmo-message-file-name folder (car msgs))) + (file-exists-p file) + (elmo-file-field-condition-match file + condition + (car msgs) + number-list)) + (setq matched (nconc matched (list (car msgs))))) + (elmo-display-progress + 'elmo-internal-folder-search "Searching..." + (/ (* (setq i (1+ i)) 100) num)) + (setq msgs (cdr msgs))) + matched)) + +;;; To override elmo-map-folder methods. +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-mark-folder) unread-marks &optional mark-alist) + t) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-mark-folder) + numbers) + t) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-mark-folder) + numbers) + t) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-mark-folder) numbers) + t) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-mark-folder) numbers) + t) + +(require 'product) +(product-provide (provide 'elmo-mark) (require 'elmo-version)) + +;;; elmo-mark.el ends here diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el new file mode 100644 index 0000000..30d0dc4 --- /dev/null +++ b/elmo/elmo-mime.el @@ -0,0 +1,322 @@ +;;; elmo-mime.el -- MIME module for ELMO. + +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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: +;; +(require 'elmo-vars) +(require 'mmbuffer) +(require 'mmimap) +(require 'mime-view) + +(eval-and-compile + (luna-define-class mime-elmo-buffer-entity (mime-buffer-entity) ()) + (luna-define-class mime-elmo-imap-entity (mime-imap-entity) ())) + +;; Provide backend +(provide 'mmelmo-imap) +(provide 'mmelmo-buffer) + +(defvar elmo-message-ignored-field-list mime-view-ignored-field-list) +(defvar elmo-message-visible-field-list mime-view-visible-field-list) +(defvar elmo-message-sorted-field-list nil) + +(defcustom elmo-mime-header-max-column fill-column + "*Header max column number. Default is `fill-colmn'. +If a symbol of function is specified, the function is called and its return +value is used." + :type '(choice (integer :tag "Column Number") + (function :tag "Function")) + :group 'elmo) + +(luna-define-method initialize-instance :after ((entity mime-elmo-buffer-entity) + &rest init-args) + entity) + +(luna-define-method initialize-instance :around ((entity mime-elmo-imap-entity) + &rest init-args) + (luna-call-next-method)) + +;;; Insert sorted header. +(defsubst elmo-mime-insert-header-from-buffer (buffer + start end + &optional invisible-fields + visible-fields + sort-fields) + (let ((the-buf (current-buffer)) + (mode-obj (mime-find-field-presentation-method 'wide)) + field-decoder + f-b p f-e field-name field field-body + vf-alist (sl sort-fields)) + (save-excursion + (set-buffer buffer) + (save-restriction + (narrow-to-region start end) + (goto-char start) + (while (re-search-forward std11-field-head-regexp nil t) + (setq f-b (match-beginning 0) + p (match-end 0) + field-name (buffer-substring f-b p) + f-e (std11-field-end)) + (when (mime-visible-field-p field-name + visible-fields invisible-fields) + (setq field (intern + (capitalize (buffer-substring f-b (1- p)))) + field-body (buffer-substring p f-e) + field-decoder (inline (mime-find-field-decoder-internal + field mode-obj))) + (setq vf-alist (append (list + (cons field-name + (list field-body field-decoder))) + vf-alist)))) + (and vf-alist + (setq vf-alist + (sort vf-alist + (function (lambda (s d) + (let ((n 0) re + (sf (car s)) + (df (car d))) + (catch 'done + (while (setq re (nth n sl)) + (setq n (1+ n)) + (and (string-match re sf) + (throw 'done t)) + (and (string-match re df) + (throw 'done nil))) + t))))))) + (with-current-buffer the-buf + (while vf-alist + (let* ((vf (car vf-alist)) + (field-name (car vf)) + (field-body (car (cdr vf))) + (field-decoder (car (cdr (cdr vf))))) + (insert field-name) + (insert (if field-decoder + (funcall field-decoder field-body + (string-width field-name) + (if (functionp elmo-mime-header-max-column) + (funcall elmo-mime-header-max-column) + elmo-mime-header-max-column)) + ;; Don't decode + field-body)) + (insert "\n")) + (setq vf-alist (cdr vf-alist))) + (run-hooks 'mmelmo-header-inserted-hook)))))) + +(luna-define-generic elmo-mime-insert-sorted-header (entity + &optional invisible-fields + visible-fields + sorted-fields) + "Insert sorted header fields of the ENTITY.") + +(luna-define-method elmo-mime-insert-sorted-header ((entity + mime-elmo-buffer-entity) + &optional invisible-fields + visible-fields + sorted-fields) + (elmo-mime-insert-header-from-buffer + (mime-buffer-entity-buffer-internal entity) + (mime-buffer-entity-header-start-internal entity) + (mime-buffer-entity-header-end-internal entity) + invisible-fields visible-fields sorted-fields)) + +(luna-define-method elmo-mime-insert-sorted-header ((entity + mime-elmo-imap-entity) + &optional invisible-fields + visible-fields + sorted-fields) + (let ((the-buf (current-buffer)) + buf p-min p-max) + (with-temp-buffer + (insert (mime-imap-entity-header-string entity)) + (setq buf (current-buffer) + p-min (point-min) + p-max (point-max)) + (set-buffer the-buf) + (elmo-mime-insert-header-from-buffer buf p-min p-max + invisible-fields visible-fields)))) + +(luna-define-method mime-insert-text-content :around + ((entity mime-elmo-buffer-entity)) + (luna-call-next-method) + (run-hooks 'elmo-message-text-content-inserted-hook)) + +(luna-define-method mime-insert-text-content :around + ((entity mime-elmo-imap-entity)) + (luna-call-next-method) + (run-hooks 'elmo-message-text-content-inserted-hook)) + +(defun elmo-mime-insert-header (entity situation) + (elmo-mime-insert-sorted-header + entity + elmo-message-ignored-field-list + elmo-message-visible-field-list + elmo-message-sorted-field-list) + (run-hooks 'elmo-message-header-inserted-hook)) + +(defun elmo-make-mime-message-location (folder number strategy rawbuf unread) +;; Return the MIME message location structure. +;; FOLDER is the ELMO folder structure. +;; NUMBER is the number of the message in the FOLDER. +;; STRATEGY is the message fetching strategy. +;; RAWBUF is the output buffer for original message. +;; If second optional argument UNREAD is non-nil, message is not marked +;; as read. + (if (and strategy + (eq (elmo-fetch-strategy-entireness strategy) 'section)) + (luna-make-entity + 'mime-elmo-imap-location + :folder folder + :number number + :rawbuf rawbuf + :strategy strategy) + (with-current-buffer rawbuf + (let (buffer-read-only) + (erase-buffer) + (if strategy + (elmo-message-fetch folder number strategy + nil (current-buffer) + unread)))) + rawbuf)) + +(defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode + &optional ignore-cache unread) + "Display MIME message. +A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF. +VIEWBUF is a view buffer and RAWBUF is a raw buffer. +ORIGINAL is the major mode of RAWBUF. +If optional argument IGNORE-CACHE is specified, existing cache is ignored. +If second optional argument UNREAD is specified, message is displayed but +keep it as unread. +Return non-nil if not entire message was fetched." + (let (mime-display-header-hook ; Do nothing. + entity strategy) + (setq entity (elmo-msgdb-overview-get-entity number + (elmo-folder-msgdb + folder))) + (setq strategy (elmo-find-fetch-strategy folder entity + ignore-cache)) + (mime-display-message + (mime-open-entity + (if (and strategy + (eq (elmo-fetch-strategy-entireness strategy) 'section)) + 'elmo-imap + 'elmo-buffer) + (elmo-make-mime-message-location + folder number strategy rawbuf unread)) + viewbuf nil nil original-mode) + (if strategy + (or (elmo-fetch-strategy-use-cache strategy) + (eq (elmo-fetch-strategy-entireness strategy) + 'section))))) + +(defun elmo-mime-display-as-is (folder number viewbuf rawbuf original-mode + &optional ignore-cache unread) + "Display MIME message. +A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF. +VIEWBUF is a view buffer and RAWBUF is a raw buffer. +ORIGINAL is the major mode of RAWBUF. +If optional argument IGNORE-CACHE is specified, existing cache is ignored. +If second optional argument UNREAD is specified, message is displayed but +keep it as unread. +Return non-nil if cache is used." + (let ((entity (elmo-msgdb-overview-get-entity number + (elmo-folder-msgdb folder))) + mime-display-header-hook ; Do nothing. + cache-file strategy use-cache) + (setq cache-file (elmo-file-cache-get + (elmo-msgdb-overview-entity-get-id entity))) + (setq use-cache (eq (elmo-file-cache-status cache-file) 'entire)) + (setq strategy (elmo-make-fetch-strategy + 'entire use-cache (elmo-message-use-cache-p folder number) + (elmo-file-cache-path + cache-file))) + (elmo-mime-display-as-is-internal + (mime-open-entity + 'elmo-buffer + (elmo-make-mime-message-location + folder number strategy rawbuf unread)) + viewbuf nil nil original-mode) + (elmo-fetch-strategy-use-cache strategy))) + +;; Replacement of mime-display-message. +(defun elmo-mime-display-as-is-internal (message + &optional preview-buffer + mother default-keymap-or-function + original-major-mode keymap) + (mime-maybe-hide-echo-buffer) + (let ((win-conf (current-window-configuration))) + (or preview-buffer + (setq preview-buffer + (concat "*Preview-" (mime-entity-name message) "*"))) + (or original-major-mode + (setq original-major-mode major-mode)) + (let ((inhibit-read-only t)) + (set-buffer (get-buffer-create preview-buffer)) + (widen) + (erase-buffer) + (if mother + (setq mime-mother-buffer mother)) + (setq mime-preview-original-window-configuration win-conf) + (setq major-mode 'mime-view-mode) + (setq mode-name "MIME-View") + + (mime-insert-entity message) + ;(insert (mime-entity-body message)) + ;(insert (mime-entity-body message)) + + (decode-coding-region (point-min) (point-max) 'undecided) + + (save-restriction + (std11-narrow-to-header) + (run-hooks 'elmo-message-header-inserted-hook)) +; (mime-display-entity message nil +; `((entity-button . invisible) +; (header . visible) +; (major-mode . ,original-major-mode)) +; preview-buffer) + + (use-local-map + (or keymap + (if default-keymap-or-function + (mime-view-define-keymap default-keymap-or-function) + mime-view-mode-default-map))) + (let ((point + (next-single-property-change (point-min) 'mime-view-entity))) + (if point + (goto-char point) + (goto-char (point-min)) + (search-forward "\n\n" nil t))) + (run-hooks 'mime-view-mode-hook) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + preview-buffer))) + +(require 'product) +(product-provide (provide 'elmo-mime) (require 'elmo-version)) + +;; elmo-mime.el ends here \ No newline at end of file diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 47dcd3d..1504237 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -36,101 +36,6 @@ (require 'elmo-util) (require 'emu) (require 'std11) -(require 'elmo-cache) - -(defun elmo-msgdb-expand-path (folder) - "Expand msgdb path for FOLDER. -FOLDER should be a sring of folder name or folder spec." - (convert-standard-filename - (let* ((spec (if (stringp folder) - (elmo-folder-get-spec folder) - folder)) - (type (car spec)) - fld) - (cond - ((eq type 'imap4) - (setq fld (elmo-imap4-spec-mailbox spec)) - (if (string= "inbox" (downcase fld)) - (setq fld "inbox")) - (if (eq (string-to-char fld) ?/) - (setq fld (substring fld 1 (length fld)))) - (expand-file-name - fld - (expand-file-name (or (elmo-imap4-spec-username spec) "nobody") - (expand-file-name (or - (elmo-imap4-spec-hostname spec) - "nowhere") - (expand-file-name - "imap" - elmo-msgdb-dir))))) - ((eq type 'nntp) - (expand-file-name - (elmo-nntp-spec-group spec) - (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere") - (expand-file-name "nntp" - elmo-msgdb-dir)))) - ((eq type 'maildir) - (expand-file-name (elmo-safe-filename (nth 1 spec)) - (expand-file-name "maildir" - elmo-msgdb-dir))) - ((eq type 'folder) - (expand-file-name (elmo-safe-filename (nth 1 spec)) - (expand-file-name "folder" - elmo-msgdb-dir))) - ((eq type 'multi) - (setq fld (concat "*" (mapconcat 'identity (cdr spec) ","))) - (expand-file-name (elmo-safe-filename fld) - (expand-file-name "multi" - elmo-msgdb-dir))) - ((eq type 'filter) - (expand-file-name - (elmo-replace-msgid-as-filename folder) - (expand-file-name "filter" - elmo-msgdb-dir))) - ((eq type 'archive) - (expand-file-name - (directory-file-name - (concat - (elmo-replace-in-string - (elmo-replace-in-string - (elmo-replace-in-string - (nth 1 spec) - "/" "_") - ":" "__") - "~" "___") - "/" (nth 3 spec))) - (expand-file-name (concat (symbol-name type) "/" - (symbol-name (nth 2 spec))) - elmo-msgdb-dir))) - ((eq type 'pop3) - (expand-file-name - (elmo-safe-filename (elmo-pop3-spec-username spec)) - (expand-file-name (elmo-pop3-spec-hostname spec) - (expand-file-name - "pop" - elmo-msgdb-dir)))) - ((eq type 'localnews) - (expand-file-name - (elmo-replace-in-string (nth 1 spec) "/" ".") - (expand-file-name "localnews" - elmo-msgdb-dir))) - ((eq type 'internal) - (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec)) - (nth 2 spec))) - (expand-file-name "internal" - elmo-msgdb-dir))) - ((eq type 'cache) - (expand-file-name (elmo-safe-filename (nth 1 spec)) - (expand-file-name "internal/cache" - elmo-msgdb-dir))) - (t ; local dir or undefined type - ;; absolute path - (setq fld (nth 1 spec)) - (if (file-name-absolute-p fld) - (setq fld (elmo-safe-filename fld))) - (expand-file-name fld - (expand-file-name (symbol-name type) - elmo-msgdb-dir))))))) (defsubst elmo-msgdb-append-element (list element) (if list @@ -145,10 +50,10 @@ FOLDER should be a sring of folder name or folder spec." (cadr msgdb)) (defsubst elmo-msgdb-get-mark-alist (msgdb) (caddr msgdb)) -(defsubst elmo-msgdb-get-location (msgdb) - (cadddr msgdb)) +;(defsubst elmo-msgdb-get-location (msgdb) +; (cadddr msgdb)) (defsubst elmo-msgdb-get-overviewht (msgdb) - (nth 4 msgdb)) + (nth 3 msgdb)) ;; ;; number <-> Message-ID handling @@ -201,60 +106,6 @@ FOLDER should be a sring of folder name or folder spec." elmo-msgdb-global-mark-filename elmo-msgdb-dir))))))) -;; -;; number <-> location handling -;; -(defsubst elmo-msgdb-location-load (dir) - (elmo-object-load - (expand-file-name - elmo-msgdb-location-filename - dir))) - -(defsubst elmo-msgdb-location-add (alist number location) - (let ((ret-val alist)) - (setq ret-val - (elmo-msgdb-append-element ret-val (cons number location))) - ret-val)) - -(defsubst elmo-msgdb-location-save (dir alist) - (elmo-object-save - (expand-file-name - elmo-msgdb-location-filename - dir) alist)) - -(defun elmo-list-folder-by-location (spec locations &optional msgdb) - (let* ((path (elmo-msgdb-expand-path spec)) - (location-alist (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load path))) - (locations-in-db (mapcar 'cdr location-alist)) - result new-locs new-alist deleted-locs i - modified) - (setq new-locs - (elmo-delete-if (function - (lambda (x) (member x locations-in-db))) - locations)) - (setq deleted-locs - (elmo-delete-if (function - (lambda (x) (member x locations))) - locations-in-db)) - (setq modified new-locs) - (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0)) - (mapcar - (function - (lambda (x) - (setq location-alist - (delq (rassoc x location-alist) location-alist)))) - deleted-locs) - (while new-locs - (setq i (1+ i)) - (setq new-alist (cons (cons i (car new-locs)) new-alist)) - (setq new-locs (cdr new-locs))) - (setq result (nconc location-alist new-alist)) - (setq result (sort result (lambda (x y) (< (car x)(car y))))) - (if modified (elmo-msgdb-location-save path result)) - (mapcar 'car result))) - ;;; ;; persistent mark handling ;; (for each folder) @@ -403,6 +254,16 @@ header separator." (expand-file-name elmo-msgdb-mark-filename dir) obj)) +(defun elmo-msgdb-change-mark (msgdb before after) + "Set the BEFORE marks to AFTER." + (let ((mark-alist (elmo-msgdb-get-mark-alist msgdb)) + entity) + (while mark-alist + (setq entity (car mark-alist)) + (when (string= (cadr entity) before) + (setcar (cdr entity) after)) + (setq mark-alist (cdr mark-alist))))) + (defsubst elmo-msgdb-seen-save (dir obj) (elmo-object-save (expand-file-name elmo-msgdb-seen-filename dir) @@ -415,6 +276,7 @@ header separator." (defun elmo-msgdb-search-internal-primitive (condition entity number-list) (let ((key (elmo-filter-key condition)) + (case-fold-search t) result) (cond ((string= key "last") @@ -468,60 +330,45 @@ header separator." ((vectorp condition) (elmo-msgdb-search-internal-primitive condition entity number-list)) ((eq (car condition) 'and) - (and (elmo-msgdb-search-internal-primitive + (and (elmo-msgdb-search-internal (nth 1 condition) entity number-list) - (elmo-msgdb-search-internal-primitive + (elmo-msgdb-search-internal (nth 2 condition) entity number-list))) ((eq (car condition) 'or) - (or (elmo-msgdb-search-internal-primitive + (or (elmo-msgdb-search-internal (nth 1 condition) entity number-list) - (elmo-msgdb-search-internal-primitive + (elmo-msgdb-search-internal (nth 2 condition) entity number-list))))) -(defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache) - "Delete MSGS from FOLDER in MSGDB. +(defun elmo-msgdb-delete-msgs (msgdb msgs) + "Delete MSGS from MSGDB content of MSGDB is changed." (save-excursion - (let* ((msg-list msgs) - (dir (elmo-msgdb-expand-path folder)) - (overview (or (car msgdb) - (elmo-msgdb-overview-load dir))) - (number-alist (or (cadr msgdb) - (elmo-msgdb-number-load dir))) - (mark-alist (or (caddr msgdb) - (elmo-msgdb-mark-load dir))) - (loc-alist (or (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load dir))) - (hashtb (or (elmo-msgdb-get-overviewht msgdb) - (elmo-msgdb-make-overview-hashtb overview))) - (newmsgdb (list overview number-alist mark-alist (nth 3 msgdb) hashtb)) - ov-entity message-id) + (let* (;(msgdb (elmo-folder-msgdb folder)) + (overview (car msgdb)) + (number-alist (cadr msgdb)) + (mark-alist (caddr msgdb)) + (hashtb (elmo-msgdb-get-overviewht msgdb)) + (newmsgdb (list overview number-alist mark-alist hashtb)) + ov-entity) ;; remove from current database. - (while msg-list - (setq message-id (cdr (assq (car msg-list) number-alist))) - (if (and (not reserve-cache) message-id) - (elmo-cache-delete message-id - folder (car msg-list))) -;;; This is no good!!!! -;;; (setq overview (delete (assoc message-id overview) overview)) + (while msgs (setq overview (delq (setq ov-entity - (elmo-msgdb-overview-get-entity (car msg-list) newmsgdb)) + (elmo-msgdb-overview-get-entity (car msgs) newmsgdb)) overview)) (when (and elmo-use-overview-hashtb hashtb) (elmo-msgdb-clear-overview-hashtb ov-entity hashtb)) (setq number-alist - (delq (assq (car msg-list) number-alist) number-alist)) - (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist)) - (setq loc-alist (delq (assq (car msg-list) loc-alist) loc-alist)) - ;; XXX Should consider when folder is not persistent. - ;; (elmo-msgdb-location-save dir loc-alist) - (setq msg-list (cdr msg-list))) + (delq (assq (car msgs) number-alist) number-alist)) + (setq mark-alist (delq (assq (car msgs) mark-alist) mark-alist)) + (setq msgs (cdr msgs))) + ;(elmo-folder-set-message-modified-internal folder t) (setcar msgdb overview) (setcar (cdr msgdb) number-alist) (setcar (cddr msgdb) mark-alist) - (setcar (nthcdr 4 msgdb) hashtb)) + (setcar (nthcdr 3 msgdb) hashtb)) t)) ;return value (defsubst elmo-msgdb-set-overview (msgdb overview) @@ -598,6 +445,13 @@ content of MSGDB is changed." (and extra (cdr (assoc field-name extra))))) +(defsubst elmo-msgdb-overview-entity-get-extra (entity) + (and entity (aref (cdr entity) 8))) + +(defsubst elmo-msgdb-overview-entity-set-extra (entity extra) + (and entity (aset (cdr entity) 8 extra)) + entity) + (defun elmo-msgdb-overview-get-entity-by-number (database number) (when number (let ((db database) @@ -612,7 +466,7 @@ content of MSGDB is changed." (defun elmo-msgdb-overview-get-entity (id msgdb) (when id (let ((ovht (elmo-msgdb-get-overviewht msgdb))) - (if ovht ;; use overview hash + (if ovht ; use overview hash (if (stringp id) ;; ID is message-id (elmo-get-hash-val id ovht) (elmo-get-hash-val (format "#%d" id) ovht)) @@ -647,12 +501,11 @@ content of MSGDB is changed." (elmo-number-set-append killed-list msg)) (defun elmo-msgdb-append-to-killed-list (folder msgs) - (let ((dir (elmo-msgdb-expand-path folder))) - (elmo-msgdb-killed-list-save - dir - (elmo-number-set-append-list - (elmo-msgdb-killed-list-load dir) - msgs)))) + (elmo-folder-set-killed-list-internal + folder + (elmo-number-set-append-list + (elmo-folder-killed-list-internal folder) + msgs))) (defun elmo-msgdb-killed-list-length (killed-list) (let ((killed killed-list) @@ -699,17 +552,21 @@ content of MSGDB is changed." elmo-msgdb-dir) finfo elmo-mime-charset)) -(defun elmo-msgdb-flist-load (folder) +(defun elmo-msgdb-flist-load (fname) (let ((flist-file (expand-file-name elmo-msgdb-flist-filename - (elmo-msgdb-expand-path (list 'folder folder))))) - (elmo-object-load flist-file nil t))) + (expand-file-name + (elmo-safe-filename fname) + (expand-file-name "folder" elmo-msgdb-dir))))) + (elmo-object-load flist-file elmo-mime-charset t))) -(defun elmo-msgdb-flist-save (folder flist) +(defun elmo-msgdb-flist-save (fname flist) (let ((flist-file (expand-file-name elmo-msgdb-flist-filename - (elmo-msgdb-expand-path (list 'folder folder))))) - (elmo-object-save flist-file flist))) + (expand-file-name + (elmo-safe-filename fname) + (expand-file-name "folder" elmo-msgdb-dir))))) + (elmo-object-save flist-file flist elmo-mime-charset))) (defun elmo-crosspost-alist-load () (elmo-object-load (expand-file-name @@ -723,6 +580,30 @@ content of MSGDB is changed." elmo-msgdb-dir) alist)) +(defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb unread-marks seen-list) + ;; Add to seen list. + (let* ((number-alist (elmo-msgdb-get-number-alist msgdb)) + (mark-alist (elmo-msgdb-get-mark-alist msgdb)) + ent) + (while msgs + (if (setq ent (assq (car msgs) mark-alist)) + (unless (member (cadr ent) unread-marks) ;; not unread mark + (setq seen-list + (cons (cdr (assq (car msgs) number-alist)) seen-list))) + ;; no mark ... seen... + (setq seen-list + (cons (cdr (assq (car msgs) number-alist)) seen-list))) + (setq msgs (cdr msgs))) + seen-list)) + +(defun elmo-msgdb-get-message-id-from-buffer () + (or (elmo-field-body "message-id") + ;; no message-id, so put dummy msgid. + (concat (timezone-make-date-sortable + (elmo-field-body "date")) + (nth 1 (eword-extract-address-components + (or (elmo-field-body "from") "nobody")))))) + (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time) "Create overview entity from current buffer. Header region is supposed to be narrowed." @@ -731,7 +612,7 @@ Header region is supposed to be narrowed." message-id references from subject to cc date extra field-body) (elmo-set-buffer-multibyte default-enable-multibyte-characters) - (setq message-id (elmo-field-body "message-id")) + (setq message-id (elmo-msgdb-get-message-id-from-buffer)) (setq references (or (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to")) @@ -760,6 +641,55 @@ Header region is supposed to be narrowed." from subject date to cc size extra)) ))) + +(defun elmo-msgdb-copy-overview-entity (entity) + (cons (car entity) + (copy-sequence (cdr entity)))) + +(static-if (boundp 'nemacs-version) + (defsubst elmo-msgdb-insert-file-header (file) + "Insert the header of the article (Does not work on nemacs)." + (as-binary-input-file + (insert-file-contents file))) + (defsubst elmo-msgdb-insert-file-header (file) + "Insert the header of the article." + (let ((beg 0) + insert-file-contents-pre-hook ; To avoid autoconv-xmas... + insert-file-contents-post-hook + format-alist) + (when (file-exists-p file) + ;; Read until header separator is found. + (while (and (eq elmo-msgdb-file-header-chop-length + (nth 1 + (insert-file-contents-as-binary + file nil beg + (incf beg elmo-msgdb-file-header-chop-length))))) + (prog1 (not (search-forward "\n\n" nil t)) + (goto-char (point-max)))))))) + +(defsubst elmo-msgdb-create-overview-entity-from-file (number file) + (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas... + insert-file-contents-post-hook header-end + (attrib (file-attributes file)) + ret-val size mtime) + (with-temp-buffer + (if (not (file-exists-p file)) + () + (setq size (nth 7 attrib)) + (setq mtime (timezone-make-date-arpa-standard + (current-time-string (nth 5 attrib)) (current-time-zone))) + ;; insert header from file. + (catch 'done + (condition-case nil + (elmo-msgdb-insert-file-header file) + (error (throw 'done nil))) + (goto-char (point-min)) + (setq header-end + (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t) + (point) + (point-max))) + (narrow-to-region (point-min) header-end) + (elmo-msgdb-create-overview-from-buffer number size mtime)))))) (defun elmo-msgdb-overview-sort-by-date (overview) (sort overview @@ -778,7 +708,7 @@ Header region is supposed to be narrowed." (let ((overview (elmo-msgdb-get-overview msgdb))) (setq overview (elmo-msgdb-overview-sort-by-date overview)) (message "Sorting...done") - (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb)))) + (list overview (nth 1 msgdb)(nth 2 msgdb)))) (defun elmo-msgdb-clear-overview-hashtb (entity hashtb) (let (number) @@ -791,7 +721,8 @@ Header region is supposed to be narrowed." (elmo-clear-hash-val (car entity) hashtb))))) (defun elmo-msgdb-make-overview-hashtb (overview &optional hashtb) - (if elmo-use-overview-hashtb + (if (and elmo-use-overview-hashtb + overview) (let ((hashtb (or hashtb ;; append (elmo-make-hash (length overview))))) (while overview @@ -811,9 +742,8 @@ Header region is supposed to be narrowed." (nconc (car msgdb) (car msgdb-append)) (nconc (cadr msgdb) (cadr msgdb-append)) (nconc (caddr msgdb) (caddr msgdb-append)) - (nconc (cadddr msgdb) (cadddr msgdb-append)) (and set-hash - (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 4 msgdb))))) + (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 3 msgdb))))) (defsubst elmo-msgdb-clear (&optional msgdb) (if msgdb @@ -821,66 +751,8 @@ Header region is supposed to be narrowed." (setcar msgdb nil) (setcar (cdr msgdb) nil) (setcar (cddr msgdb) nil) - (setcar (cdddr msgdb) nil) - (setcar (nthcdr 4 msgdb) (elmo-msgdb-make-overview-hashtb nil))) - (list nil nil nil nil (elmo-msgdb-make-overview-hashtb nil)))) - -(defun elmo-msgdb-delete-path (folder &optional spec) - (let ((path (elmo-msgdb-expand-path (or spec folder)))) - (if (file-directory-p path) - (elmo-delete-directory path t)))) - -(defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec) - (let* ((old (directory-file-name (elmo-msgdb-expand-path old-folder))) - (new (directory-file-name (elmo-msgdb-expand-path new-folder))) - (new-dir (directory-file-name (file-name-directory new)))) - (if (not (file-directory-p old)) - () - (if (file-exists-p new) - (error "Already exists directory: %s" new) - (if (not (file-exists-p new-dir)) - (elmo-make-directory new-dir)) - (rename-file old new))))) - -(defun elmo-generic-folder-diff (spec folder &optional number-list) - (let ((cached-in-db-max (elmo-folder-get-info-max folder)) - (in-folder (elmo-call-func folder "max-of-folder")) - (in-db t) - unsync messages - in-db-max) - (if (or number-list (not cached-in-db-max)) - (let ((number-list (or number-list - (mapcar 'car - (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder)))))) - ;; No info-cache. - (setq in-db (sort number-list '<)) - (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db) - 0)) - (if (not number-list) - (elmo-folder-set-info-hashtb folder in-db-max nil))) - (setq in-db-max cached-in-db-max)) - (setq unsync (if (and in-db - (car in-folder)) - (- (car in-folder) in-db-max) - (if (and in-folder - (null in-db)) - (cdr in-folder) - (if (null (car in-folder)) - nil)))) - (setq messages (cdr in-folder)) - (if (and unsync messages (> unsync messages)) - (setq unsync messages)) - (cons (or unsync 0) (or messages 0)))) - -(defun elmo-generic-list-folder-unread (spec number-alist mark-alist - unread-marks) - (delq nil - (mapcar - (function (lambda (x) - (if (member (cadr (assq (car x) mark-alist)) unread-marks) - (car x)))) - mark-alist))) + (setcar (nthcdr 3 msgdb) (elmo-msgdb-make-overview-hashtb nil))) + (list nil nil nil (elmo-msgdb-make-overview-hashtb nil)))) (defsubst elmo-folder-get-info (folder &optional hashtb) (elmo-get-hash-val folder @@ -931,6 +803,24 @@ Header region is supposed to be narrowed." info-alist) (setq elmo-folder-info-hashtb hashtb))) +(defsubst elmo-msgdb-location-load (dir) + (elmo-object-load + (expand-file-name + elmo-msgdb-location-filename + dir))) + +(defsubst elmo-msgdb-location-add (alist number location) + (let ((ret-val alist)) + (setq ret-val + (elmo-msgdb-append-element ret-val (cons number location))) + ret-val)) + +(defsubst elmo-msgdb-location-save (dir alist) + (elmo-object-save + (expand-file-name + elmo-msgdb-location-filename + dir) alist)) + (require 'product) (product-provide (provide 'elmo-msgdb) (require 'elmo-version)) diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index 9037ace..23d5332 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -29,9 +29,75 @@ ;;; Code: ;; -(require 'elmo-msgdb) -(require 'elmo-vars) -(require 'elmo2) +(require 'elmo) +(require 'luna) + +(defvar elmo-multi-divide-number 100000 + "*Multi divider number.") + +;;; ELMO Multi folder +(eval-and-compile + (luna-define-class elmo-multi-folder (elmo-folder) + (children divide-number)) + (luna-define-internal-accessors 'elmo-multi-folder)) + +(luna-define-method elmo-folder-initialize ((folder + elmo-multi-folder) + name) + (elmo-multi-folder-set-children-internal + folder + (mapcar 'elmo-make-folder (split-string name ","))) + (elmo-multi-folder-set-divide-number-internal + folder + elmo-multi-divide-number) + folder) + +(luna-define-method elmo-folder-open-internal ((folder elmo-multi-folder)) + (dolist (fld (elmo-multi-folder-children-internal folder)) + (elmo-folder-open-internal fld))) + +(luna-define-method elmo-folder-check ((folder elmo-multi-folder)) + (dolist (fld (elmo-multi-folder-children-internal folder)) + (elmo-folder-check fld))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-multi-folder)) + (dolist (fld (elmo-multi-folder-children-internal folder)) + (elmo-folder-close-internal fld))) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-multi-folder)) + (expand-file-name (elmo-replace-string-as-filename + (elmo-folder-name-internal folder)) + (expand-file-name "multi" + elmo-msgdb-dir))) + +(luna-define-method elmo-folder-get-primitive-list ((folder elmo-multi-folder)) + (elmo-flatten + (mapcar + 'elmo-folder-get-primitive-list + (elmo-multi-folder-children-internal folder)))) + +(luna-define-method elmo-folder-contains-type ((folder elmo-multi-folder) type) + (let ((children (elmo-multi-folder-children-internal folder)) + match) + (while children + (when (elmo-folder-contains-type (car children) type) + (setq match t) + (setq children nil)) + (setq children (cdr children))) + match)) + +(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder) + number) + (elmo-message-use-cache-p + (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1) + (elmo-multi-folder-children-internal folder)) + (% number (elmo-multi-folder-divide-number-internal folder)))) + +(luna-define-method elmo-message-folder ((folder elmo-multi-folder) + number) + (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1) + (elmo-multi-folder-children-internal folder))) (defun elmo-multi-msgdb (msgdb base) (list (mapcar (function @@ -51,255 +117,362 @@ (+ base (car x)) (cdr x)))) (nth 2 msgdb)))) -(defun elmo-multi-msgdb-create-as-numlist (spec numlist new-mark already-mark - seen-mark important-mark - seen-list) - (when numlist - (let* ((flds (cdr spec)) - overview number-alist mark-alist entity - one-list-list - cur-number - i percent num - ret-val) - (setq one-list-list (elmo-multi-get-intlist-list numlist)) - (setq cur-number 0) - (while (< cur-number (length flds)) - (setq ret-val - (elmo-msgdb-append - ret-val - (elmo-multi-msgdb - (elmo-msgdb-create-as-numlist (nth cur-number flds) - (nth cur-number one-list-list) - new-mark already-mark +(defun elmo-multi-split-numbers (folder numlist &optional as-is) + (let ((numbers (sort numlist '<)) + (divider (elmo-multi-folder-divide-number-internal folder)) + (cur-number 0) + one-list numbers-list) + (while numbers + (setq cur-number (+ cur-number 1)) + (setq one-list nil) + (while (and numbers + (eq 0 + (/ (- (car numbers) + (* divider cur-number)) + divider))) + (setq one-list (nconc + one-list + (list + (if as-is + (car numbers) + (% (car numbers) + (* divider cur-number)))))) + (setq numbers (cdr numbers))) + (setq numbers-list (nconc numbers-list (list one-list)))) + numbers-list)) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-multi-folder) + numbers new-mark already-mark seen-mark important-mark seen-list) - (* elmo-multi-divide-number (1+ cur-number))))) - (setq cur-number (1+ cur-number))) - (elmo-msgdb-sort-by-date ret-val)))) - -;; returns append-msgdb -(defun elmo-multi-delete-crossposts (already-msgdb append-msgdb) - (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb)) - (dummy (copy-sequence (append - number-alist - (elmo-msgdb-get-number-alist already-msgdb)))) - (cur number-alist) - to-be-deleted - overview mark-alist - same) - (while cur - (setq dummy (delq (car cur) dummy)) - (if (setq same (rassoc (cdr (car cur)) dummy)) ;; same message id is remained - (unless (= (/ (car (car cur)) elmo-multi-divide-number) - (/ (car same) elmo-multi-divide-number)) - ;; base is also same...delete it! - (setq to-be-deleted (append to-be-deleted (list (car cur)))))) - (setq cur (cdr cur))) - (setq overview (elmo-delete-if - (function - (lambda (x) - (assq - (elmo-msgdb-overview-entity-get-number x) - to-be-deleted))) - (elmo-msgdb-get-overview append-msgdb))) - (setq mark-alist (elmo-delete-if - (function - (lambda (x) - (assq - (car x) to-be-deleted))) - (elmo-msgdb-get-mark-alist append-msgdb))) - ;; keep number-alist untouched for folder diff!! - (cons (and to-be-deleted (length to-be-deleted)) - (list overview number-alist mark-alist)))) - -(defun elmo-multi-msgdb-create (spec numlist new-mark already-mark - seen-mark important-mark seen-list) - (when numlist - (let* ((flds (cdr spec)) - overview number-alist mark-alist entity - one-list-list - cur-number - i percent num - ret-val) - (setq one-list-list (elmo-multi-get-intlist-list numlist)) - (setq cur-number 0) - (while (< cur-number (length flds)) - (setq ret-val - (elmo-msgdb-append - ret-val - (elmo-multi-msgdb - (elmo-msgdb-create (nth cur-number flds) - (nth cur-number one-list-list) - new-mark already-mark - seen-mark important-mark - seen-list) - (* elmo-multi-divide-number (1+ cur-number))))) - (setq cur-number (1+ cur-number))) - (elmo-msgdb-sort-by-date ret-val)))) - -(defun elmo-multi-list-folders (spec &optional hierarchy) - ;; not implemented. - nil) - -(defun elmo-multi-append-msg (spec string) - (error "Cannot append messages to multi folder")) - -(defun elmo-multi-read-msg (spec number outbuf &optional msgdb unread) - (let* ((flds (cdr spec)) - (folder (nth (- (/ number elmo-multi-divide-number) 1) flds)) - (number (% number elmo-multi-divide-number))) - (elmo-call-func folder "read-msg" number outbuf msgdb unread))) - -(defun elmo-multi-delete-msgs (spec msgs) - (let ((flds (cdr spec)) + (let* ((folders (elmo-multi-folder-children-internal folder)) + overview number-alist mark-alist entity + numbers-list + cur-number + i percent num + msgdb) + (setq numbers-list (elmo-multi-split-numbers folder numbers)) + (setq cur-number 0) + (while (< cur-number (length folders)) + (if (nth cur-number numbers-list) + (setq msgdb + (elmo-msgdb-append + msgdb + (elmo-multi-msgdb + (elmo-folder-msgdb-create (nth cur-number folders) + (nth cur-number numbers-list) + new-mark already-mark + seen-mark important-mark + seen-list) + (* (elmo-multi-folder-divide-number-internal folder) + (1+ cur-number)))))) + (setq cur-number (1+ cur-number))) + (elmo-msgdb-sort-by-date msgdb))) + +(luna-define-method elmo-folder-process-crosspost ((folder elmo-multi-folder) + &optional + number-alist) + (let ((number-alists (elmo-multi-split-number-alist + folder + (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder)))) + (cur-number 1)) + (dolist (child (elmo-multi-folder-children-internal folder)) + (elmo-folder-process-crosspost child (car number-alists)) + (setq cur-number (+ 1 cur-number) + number-alists (cdr number-alists))))) + +(defsubst elmo-multi-folder-append-msgdb (folder append-msgdb) + (if append-msgdb + (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb)) + (all-alist (copy-sequence (append + (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder)) + number-alist))) + (cur number-alist) + overview to-be-deleted + mark-alist same) + (while cur + (setq all-alist (delq (car cur) all-alist)) + ;; same message id exists. + (if (setq same (rassoc (cdr (car cur)) all-alist)) + (unless (= (/ (car (car cur)) + (elmo-multi-folder-divide-number-internal folder)) + (/ (car same) + (elmo-multi-folder-divide-number-internal folder))) + ;; base is also same...delete it! + (setq to-be-deleted + (append to-be-deleted (list (car (car cur))))))) + (setq cur (cdr cur))) + (cond ((eq (elmo-folder-process-duplicates-internal folder) + 'hide) + ;; Hide duplicates. + (elmo-msgdb-append-to-killed-list folder to-be-deleted) + (setq overview (elmo-delete-if + (lambda (x) + (memq (elmo-msgdb-overview-entity-get-number + x) + to-be-deleted)) + (elmo-msgdb-get-overview append-msgdb))) + ;; Should be mark as read. + (elmo-folder-mark-as-read folder to-be-deleted) + (elmo-msgdb-set-overview append-msgdb overview)) + ((eq (elmo-folder-process-duplicates-internal folder) + 'read) + ;; Mark as read duplicates. + (elmo-folder-mark-as-read folder to-be-deleted)) + (t + ;; Do nothing. + (setq to-be-deleted nil))) + (elmo-folder-set-msgdb-internal folder + (elmo-msgdb-append + (elmo-folder-msgdb folder) + append-msgdb t)) + (length to-be-deleted)) + 0)) + +(luna-define-method elmo-folder-append-msgdb ((folder elmo-multi-folder) + append-msgdb) + (elmo-multi-folder-append-msgdb folder append-msgdb)) + +(defmacro elmo-multi-real-folder-number (folder number) + "Returns a cons cell of real FOLDER and NUMBER." + (` (cons (nth (- + (/ (, number) + (elmo-multi-folder-divide-number-internal (, folder))) + 1) (elmo-multi-folder-children-internal (, folder))) + (% (, number) (elmo-multi-folder-divide-number-internal + (, folder)))))) + +(defsubst elmo-multi-find-fetch-strategy (folder entity ignore-cache) + (if entity + (let ((pair (elmo-multi-real-folder-number + folder + (elmo-msgdb-overview-entity-get-number entity))) + (new-entity (elmo-msgdb-copy-overview-entity entity))) + (setq new-entity + (elmo-msgdb-overview-entity-set-number new-entity (cdr pair))) + (elmo-find-fetch-strategy (car pair) new-entity ignore-cache)) + (elmo-make-fetch-strategy 'entire))) + +(luna-define-method elmo-find-fetch-strategy + ((folder elmo-multi-folder) + entity &optional ignore-cache) + (elmo-multi-find-fetch-strategy folder entity ignore-cache)) + +(luna-define-method elmo-message-fetch ((folder elmo-multi-folder) + number strategy + &optional section outbuf unseen) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-fetch (car pair) (cdr pair) strategy section outbuf unseen))) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-multi-folder) + numbers) + (let ((flds (elmo-multi-folder-children-internal folder)) one-list-list (cur-number 0)) - (setq one-list-list (elmo-multi-get-intlist-list msgs)) + (setq one-list-list (elmo-multi-split-numbers folder numbers)) (while (< cur-number (length flds)) - (elmo-delete-msgs (nth cur-number flds) - (nth cur-number one-list-list)) + (elmo-folder-delete-messages (nth cur-number flds) + (nth cur-number one-list-list)) (setq cur-number (+ 1 cur-number))) t)) -(defun elmo-multi-folder-diff (spec folder &optional number-list) - (let ((flds (cdr spec)) - (num-alist-list - (elmo-multi-split-number-alist - (elmo-msgdb-number-load (elmo-msgdb-expand-path spec)))) +(luna-define-method elmo-folder-diff ((folder elmo-multi-folder) + &optional numbers) + (elmo-multi-folder-diff folder numbers)) + +(defun elmo-multi-folder-diff (folder numbers) + (let ((flds (elmo-multi-folder-children-internal folder)) + (numbers (mapcar 'car + (elmo-msgdb-number-load + (elmo-folder-msgdb-path folder)))) + (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) (count 0) (unsync 0) (messages 0) + num-list diffs) + ;; If first time, dummy numbers is used as current number list. + (unless numbers + (let ((i 0) + (divider (elmo-multi-folder-divide-number-internal folder))) + (dolist (folder flds) + (setq i (+ i 1)) + (setq numbers + (cons (* i divider) numbers))))) + (setq num-list + (elmo-multi-split-numbers folder + (elmo-uniq-list + (nconc + (elmo-number-set-to-number-list killed) + numbers)))) (while flds (setq diffs (nconc diffs (list (elmo-folder-diff (car flds) - (mapcar 'car - (nth count num-alist-list)))))) + (car num-list))))) (setq count (+ 1 count)) + (setq num-list (cdr num-list)) (setq flds (cdr flds))) (while diffs (and (car (car diffs)) (setq unsync (+ unsync (car (car diffs))))) (setq messages (+ messages (cdr (car diffs)))) (setq diffs (cdr diffs))) - (elmo-folder-set-info-hashtb folder - nil messages) + (elmo-folder-set-info-hashtb folder nil messages) (cons unsync messages))) -(defun elmo-multi-split-mark-alist (mark-alist) - (let ((cur-number 0) - (alist (sort (copy-sequence mark-alist) +(defun elmo-multi-split-number-alist (folder number-alist) + (let ((alist (sort (copy-sequence number-alist) (lambda (pair1 pair2) (< (car pair1)(car pair2))))) - one-alist result) + (cur-number 0) + one-alist split num) (while alist (setq cur-number (+ cur-number 1)) (setq one-alist nil) (while (and alist (eq 0 - (/ (- (car (car alist)) + (/ (- (setq num (car (car alist))) (* elmo-multi-divide-number cur-number)) - elmo-multi-divide-number))) + (elmo-multi-folder-divide-number-internal folder)))) (setq one-alist (nconc one-alist (list - (list (% (car (car alist)) - (* elmo-multi-divide-number cur-number)) - (cadr (car alist)))))) + (cons + (% num (* (elmo-multi-folder-divide-number-internal + folder) cur-number)) + (cdr (car alist)))))) (setq alist (cdr alist))) - (setq result (nconc result (list one-alist)))) - result)) + (setq split (nconc split (list one-alist)))) + split)) -(defun elmo-multi-split-number-alist (number-alist) - (let ((alist (sort (copy-sequence number-alist) +(defun elmo-multi-split-mark-alist (folder mark-alist) + (let ((cur-number 0) + (alist (sort (copy-sequence mark-alist) (lambda (pair1 pair2) (< (car pair1)(car pair2))))) - (cur-number 0) - one-alist split num) + one-alist result) (while alist (setq cur-number (+ cur-number 1)) (setq one-alist nil) (while (and alist (eq 0 - (/ (- (setq num (car (car alist))) - (* elmo-multi-divide-number cur-number)) - elmo-multi-divide-number))) + (/ (- (car (car alist)) + (* (elmo-multi-folder-divide-number-internal + folder) cur-number)) + (elmo-multi-folder-divide-number-internal folder)))) (setq one-alist (nconc one-alist (list - (cons - (% num (* elmo-multi-divide-number cur-number)) - (cdr (car alist)))))) + (list (% (car (car alist)) + (* (elmo-multi-folder-divide-number-internal + folder) cur-number)) + (cadr (car alist)))))) (setq alist (cdr alist))) - (setq split (nconc split (list one-alist)))) - split)) + (setq result (nconc result (list one-alist)))) + result)) + +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-multi-folder) unread-marks &optional mark-alist) + (elmo-multi-folder-list-unreads-internal folder unread-marks)) -(defun elmo-multi-list-folder-unread (spec number-alist mark-alist - unread-marks) - (let ((folders (cdr spec)) +(defun elmo-multi-folder-list-unreads-internal (folder unread-marks) + (let ((folders (elmo-multi-folder-children-internal folder)) + (mark-alists (elmo-multi-split-mark-alist + folder + (elmo-msgdb-get-mark-alist + (elmo-folder-msgdb folder)))) (cur-number 0) - (split-mark-alist (elmo-multi-split-mark-alist mark-alist)) - (split-number-alist (elmo-multi-split-number-alist number-alist)) - unreads) + unreads + all-unreads) (while folders - (setq cur-number (+ cur-number 1) - unreads (append - unreads - (mapcar - (function - (lambda (x) - (+ - (* elmo-multi-divide-number cur-number) x))) - (elmo-list-folder-unread (car folders) - (car split-number-alist) - (car split-mark-alist) - unread-marks))) - split-number-alist (cdr split-number-alist) - split-mark-alist (cdr split-mark-alist) + (setq cur-number (+ cur-number 1)) + (unless (listp (setq unreads + (elmo-folder-list-unreads-internal + (car folders) unread-marks (car mark-alists)))) + (setq unreads (delq nil + (mapcar + (lambda (x) + (if (member (cadr x) unread-marks) + (car x))) + (car mark-alists))))) + (setq all-unreads + (nconc all-unreads + (mapcar + (lambda (x) + (+ x + (* cur-number + (elmo-multi-folder-divide-number-internal + folder)))) + unreads))) + (setq mark-alists (cdr mark-alists) folders (cdr folders))) - unreads)) - -(defun elmo-multi-list-folder-important (spec number-alist) - (let ((folders (cdr spec)) + all-unreads)) + +(luna-define-method elmo-folder-list-importants-internal + ((folder elmo-multi-folder) important-mark) + (let ((folders (elmo-multi-folder-children-internal folder)) + (mark-alists (elmo-multi-split-mark-alist + folder + (elmo-msgdb-get-mark-alist + (elmo-folder-msgdb folder)))) (cur-number 0) - (split-number-alist (elmo-multi-split-number-alist number-alist)) - importants) + importants + all-importants) (while folders - (setq cur-number (+ cur-number 1) - importants (nconc - importants - (mapcar - (function - (lambda (x) - (+ (* elmo-multi-divide-number cur-number) x))) - (elmo-list-folder-important - (car folders) - (car split-number-alist)))) + (setq cur-number (+ cur-number 1)) + (when (listp (setq importants + (elmo-folder-list-importants-internal + (car folders) important-mark))) + (setq all-importants + (nconc all-importants + (mapcar + (lambda (x) + (+ x + (* cur-number + (elmo-multi-folder-divide-number-internal + folder)))) + importants)))) + (setq mark-alists (cdr mark-alists) folders (cdr folders))) - importants)) + all-importants)) -(defun elmo-multi-list-folder (spec &optional nohide) - (let* ((flds (cdr spec)) +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-multi-folder) &optional nohide) + (let* ((flds (elmo-multi-folder-children-internal folder)) (cur-number 0) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - numbers) + list numbers) (while flds (setq cur-number (+ cur-number 1)) - (setq numbers (append - numbers - (mapcar - (function - (lambda (x) - (+ - (* elmo-multi-divide-number cur-number) x))) - (elmo-list-folder (car flds))))) + (setq list (elmo-folder-list-messages-internal (car flds))) + (setq numbers + (append + numbers + (if (listp list) + (mapcar + (function + (lambda (x) + (+ + (* (elmo-multi-folder-divide-number-internal + folder) cur-number) x))) + list) + ;; Use current list. + (elmo-delete-if + (lambda (num) + (not + (eq cur-number (/ num + (elmo-multi-folder-divide-number-internal + folder))))) + (mapcar + 'car + (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder))))))) (setq flds (cdr flds))) - (elmo-living-messages numbers killed))) + numbers)) -(defun elmo-multi-folder-exists-p (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-folder-exists-p ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'exists (while flds (unless (elmo-folder-exists-p (car flds)) @@ -307,36 +480,37 @@ (setq flds (cdr flds))) t))) -(defun elmo-multi-folder-creatable-p (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-folder-creatable-p ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'creatable (while flds - (when (and (elmo-call-func (car flds) "folder-creatable-p") + (when (and (elmo-folder-creatable-p (car flds)) (not (elmo-folder-exists-p (car flds)))) - ;; If folder already exists, don't to `creatable'. - ;; Because this function is called, when folder doesn't exists. + ;; If folder already exists, don't to `creatable'. + ;; Because this function is called, when folder doesn't exists. (throw 'creatable t)) (setq flds (cdr flds))) nil))) -(defun elmo-multi-create-folder (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-folder-create ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'create (while flds (unless (or (elmo-folder-exists-p (car flds)) - (elmo-create-folder (car flds))) + (elmo-folder-create (car flds))) (throw 'create nil)) (setq flds (cdr flds))) t))) -(defun elmo-multi-search (spec condition &optional numlist) - (let* ((flds (cdr spec)) +(luna-define-method elmo-folder-search ((folder elmo-multi-folder) + condition &optional numlist) + (let* ((flds (elmo-multi-folder-children-internal folder)) (cur-number 0) numlist-list cur-numlist ; for filtered search. ret-val) (if numlist (setq numlist-list - (elmo-multi-get-intlist-list numlist t))) + (elmo-multi-split-numbers folder numlist t))) (while flds (setq cur-number (+ cur-number 1)) (when numlist @@ -352,31 +526,30 @@ (function (lambda (x) (+ - (* elmo-multi-divide-number cur-number) x))) - (elmo-call-func - (car flds) "search" condition))))) + (* (elmo-multi-folder-divide-number-internal + folder) cur-number) x))) + (elmo-folder-search + (car flds) condition))))) (when numlist (setq numlist-list (cdr numlist-list))) (setq flds (cdr flds))) ret-val)) -(defun elmo-multi-use-cache-p (spec number) - (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1) - (cdr spec)) - "use-cache-p" - (% number elmo-multi-divide-number))) - -(defun elmo-multi-local-file-p (spec number) - (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1) - (cdr spec)) - "local-file-p" - (% number elmo-multi-divide-number))) - -(defun elmo-multi-commit (spec) - (mapcar 'elmo-commit (cdr spec))) - -(defun elmo-multi-plugged-p (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder) + number) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-use-cache-p (car pair) (cdr pair)))) + +(luna-define-method elmo-message-file-p ((folder elmo-multi-folder) number) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-file-p (car pair) (cdr pair)))) + +(luna-define-method elmo-message-file-name ((folder elmo-multi-folder) number) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-file-name (car pair) (cdr pair)))) + +(luna-define-method elmo-folder-plugged-p ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'plugged (while flds (unless (elmo-folder-plugged-p (car flds)) @@ -384,40 +557,65 @@ (setq flds (cdr flds))) t))) -(defun elmo-multi-set-plugged (spec plugged add) - (let* ((flds (cdr spec))) - (while flds - (elmo-folder-set-plugged (car flds) plugged add) - (setq flds (cdr flds))))) - -(defun elmo-multi-get-msg-filename (spec number &optional loc-alist) - (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1) - (cdr spec)) - "get-msg-filename" - (% number elmo-multi-divide-number) - loc-alist)) - -(defun elmo-multi-sync-number-alist (spec number-alist) - (let ((folder-list (cdr spec)) - (number-alist-list - (elmo-multi-split-number-alist number-alist)) - (multi-base 0) - append-alist result-alist) - (while folder-list - (incf multi-base) - (setq append-alist - (elmo-call-func (nth (- multi-base 1) (cdr spec)) ;; folder name - "sync-number-alist" - (nth (- multi-base 1) number-alist-list))) - (mapcar - (function - (lambda (x) - (setcar x - (+ (* elmo-multi-divide-number multi-base) (car x))))) - append-alist) - (setq result-alist (nconc result-alist append-alist)) - (setq folder-list (cdr folder-list))) - result-alist)) +(luna-define-method elmo-folder-set-plugged ((folder elmo-multi-folder) + plugged add) + (let ((flds (elmo-multi-folder-children-internal folder))) + (dolist (fld flds) + (elmo-folder-set-plugged fld plugged add)))) + +(defun elmo-multi-folder-numbers-list-assoc (folder folder-numbers) + (let (ent) + (while folder-numbers + (when (string= (elmo-folder-name-internal (car (car folder-numbers))) + (elmo-folder-name-internal folder)) + (setq ent (car folder-numbers) + folder-numbers nil)) + (setq folder-numbers (cdr folder-numbers))) + ent)) + +(defun elmo-multi-make-folder-numbers-list (folder msgs) + (let ((msg-list msgs) + pair fld-list + ret-val) + (while msg-list + (when (and (numberp (car msg-list)) + (> (car msg-list) 0)) + (setq pair (elmo-multi-real-folder-number folder (car msg-list))) + (if (setq fld-list (elmo-multi-folder-numbers-list-assoc + (car pair) + ret-val)) + (setcdr fld-list (cons (cdr pair) (cdr fld-list))) + (setq ret-val (cons (cons (car pair) (list (cdr pair))) ret-val)))) + (setq msg-list (cdr msg-list))) + ret-val)) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-multi-folder) + numbers) + (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) + (elmo-folder-mark-as-important (car folder-numbers) + (cdr folder-numbers))) + t) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-multi-folder) + numbers) + (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) + (elmo-folder-unmark-important (car folder-numbers) + (cdr folder-numbers))) + t) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-multi-folder) + numbers) + (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) + (elmo-folder-mark-as-read (car folder-numbers) + (cdr folder-numbers))) + t) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-multi-folder) + numbers) + (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers)) + (elmo-folder-unmark-read (car folder-numbers) + (cdr folder-numbers))) + t) (require 'product) (product-provide (provide 'elmo-multi) (require 'elmo-version)) diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el index e97c9b2..d3af2cc 100644 --- a/elmo/elmo-net.el +++ b/elmo/elmo-net.el @@ -26,10 +26,25 @@ ;;; Commentary: ;; -(require 'luna) +(eval-when-compile (require 'cl)) + (require 'elmo-util) +(require 'elmo-dop) (require 'elmo-vars) +(require 'elmo-cache) +(require 'elmo) + +;;; Code: +;; + +;;; ELMO net folder +(eval-and-compile + (luna-define-class elmo-net-folder + (elmo-folder) + (user auth server port stream-type)) + (luna-define-internal-accessors 'elmo-net-folder)) +;;; Session (eval-and-compile (autoload 'starttls-negotiate "starttls") (autoload 'sasl-find-mechanism "sasl") @@ -45,7 +60,7 @@ ;; (eval-and-compile (luna-define-class elmo-network-session () (name - host + server port user auth @@ -101,24 +116,29 @@ (elmo-network-session-name-internal session) (elmo-network-session-user-internal session) (elmo-network-session-auth-internal session) - (elmo-network-session-host-internal session) + (elmo-network-session-server-internal session) (elmo-network-session-port-internal session))) (defvar elmo-network-session-cache nil) (defvar elmo-network-session-name-prefix nil) -(defsubst elmo-network-session-cache-key (name host port user auth stream-type) - "Returns session cache key." +(defsubst elmo-network-session-cache-key (name folder) + "Returns session cache key for NAME and FOLDER." (format "%s:%s/%s@%s:%d%s" (concat elmo-network-session-name-prefix name) - user auth host port (or stream-type ""))) + (elmo-net-folder-user-internal folder) + (elmo-net-folder-auth-internal folder) + (elmo-net-folder-server-internal folder) + (elmo-net-folder-port-internal folder) + (or + (elmo-network-stream-type-spec-string + (elmo-net-folder-stream-type-internal folder)) ""))) (defun elmo-network-clear-session-cache () "Clear session cache." (interactive) - (mapcar (lambda (pair) - (elmo-network-close-session (cdr pair))) - elmo-network-session-cache) + (dolist (pair elmo-network-session-cache) + (elmo-network-close-session (cdr pair))) (setq elmo-network-session-cache nil)) (defmacro elmo-network-session-buffer (session) @@ -126,25 +146,21 @@ (` (process-buffer (elmo-network-session-process-internal (, session))))) -(defun elmo-network-get-session (class name host port user auth stream-type - &optional if-exists) +(defun elmo-network-get-session (class name folder &optional if-exists) "Get network session from session cache or a new network session. CLASS is the class name of the session. NAME is the name of the process. -HOST is the name of the server host. -PORT is the port number of the service. -USER is the user-id for the authenticate. -AUTH is the authenticate method name (symbol). -STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist'). +FOLDER is the ELMO folder structure. Returns a `elmo-network-session' instance. If optional argument IF-EXISTS is non-nil, it does not return session if there is no session cache. if making session failed, returns nil." (let (pair session key) - (if (not (elmo-plugged-p host port)) + (if (not (elmo-plugged-p + (elmo-net-folder-server-internal folder) + (elmo-net-folder-port-internal folder))) (error "Unplugged")) - (setq pair (assoc (setq key (elmo-network-session-cache-key - name host port user auth stream-type)) + (setq pair (assoc (setq key (elmo-network-session-cache-key name folder)) elmo-network-session-cache)) (when (and pair (not (memq (process-status @@ -159,19 +175,25 @@ if making session failed, returns nil." (cdr pair) ; connection cache exists. (unless if-exists (setq session - (elmo-network-open-session class name - host port user auth stream-type)) + (elmo-network-open-session + class + name + (elmo-net-folder-server-internal folder) + (elmo-net-folder-port-internal folder) + (elmo-net-folder-user-internal folder) + (elmo-net-folder-auth-internal folder) + (elmo-net-folder-stream-type-internal folder))) (setq elmo-network-session-cache (cons (cons key session) elmo-network-session-cache)) session)))) -(defun elmo-network-open-session (class name host port user auth +(defun elmo-network-open-session (class name server port user auth stream-type) "Open an authenticated network session. CLASS is the class name of the session. NAME is the name of the process. -HOST is the name of the server host. +SERVER is the name of the server server. PORT is the port number of the service. USER is the user-id for the authenticate. AUTH is the authenticate method name (symbol). @@ -180,7 +202,7 @@ Returns a process object. if making session failed, returns nil." (let ((session (luna-make-entity class :name name - :host host + :server server :port port :user user :auth auth @@ -190,7 +212,7 @@ Returns a process object. if making session failed, returns nil." (buffer (format " *%s session for %s@%s:%d%s" (concat elmo-network-session-name-prefix name) user - host + server port (or (elmo-network-stream-type-spec-string stream-type) ""))) @@ -204,7 +226,7 @@ Returns a process object. if making session failed, returns nil." session (setq process (elmo-open-network-stream (elmo-network-session-name-internal session) - buffer host port stream-type))) + buffer server port stream-type))) (when process (elmo-network-initialize-session session) (elmo-network-authenticate-session session) @@ -216,7 +238,7 @@ Returns a process object. if making session failed, returns nil." (signal (car error)(cdr error)))) session)) -(defun elmo-open-network-stream (name buffer host service stream-type) +(defun elmo-open-network-stream (name buffer server service stream-type) (let ((auto-plugged (and elmo-auto-change-plugged (> elmo-auto-change-plugged 0))) process) @@ -229,20 +251,296 @@ Returns a process object. if making session failed, returns nil." (setq process (if stream-type (funcall (elmo-network-stream-type-function stream-type) - name buffer host service) - (open-network-stream name buffer host service))))) + name buffer server service) + (open-network-stream name buffer server service))))) (error (when auto-plugged - (elmo-set-plugged nil host service (current-time)) - (message "Auto plugged off at %s:%d" host service) + (elmo-set-plugged nil server service stream-type (current-time)) + (message "Auto plugged off at %s:%d" server service) (sit-for 1)) (signal (car err) (cdr err)))) (when process (process-kill-without-query process) (when auto-plugged - (elmo-set-plugged t host service)) + (elmo-set-plugged t server service stream-type)) process))) +(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)))) + +(defun elmo-net-port-info (folder) + (list (elmo-net-folder-server-internal folder) + (elmo-net-folder-port-internal folder) + (elmo-network-stream-type-symbol + (elmo-net-folder-stream-type-internal folder)))) + +(defun elmo-net-port-label (folder) + (concat + (symbol-name (elmo-folder-type-internal folder)) + (if (elmo-net-folder-stream-type-internal folder) + (concat "!" (symbol-name + (elmo-network-stream-type-symbol + (elmo-net-folder-stream-type-internal + folder))))))) + +(luna-define-method elmo-folder-plugged-p ((folder elmo-net-folder)) + (apply 'elmo-plugged-p + (append (elmo-net-port-info folder) + (list nil (quote (elmo-net-port-label folder)))))) + +(luna-define-method elmo-folder-set-plugged ((folder elmo-net-folder) + plugged &optional add) + (apply 'elmo-set-plugged plugged + (append (elmo-net-port-info folder) + (list nil nil (quote (elmo-net-port-label folder)) add)))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-net-folder)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-exists-p-plugged) + t)) ; If unplugged, assume the folder exists. + +(luna-define-method elmo-folder-status ((folder elmo-net-folder)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-status-plugged) + (elmo-folder-send folder 'elmo-folder-status-unplugged))) + +(luna-define-method elmo-folder-status-unplugged + ((folder elmo-net-folder)) + (if elmo-enable-disconnected-operation + (elmo-folder-status-dop folder) + (error "Unplugged"))) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-net-folder) &optional nohide) + (elmo-net-folder-list-messages-internal folder nohide)) + +(defun elmo-net-folder-list-messages-internal (folder nohide) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-list-messages-plugged nohide) + (elmo-folder-send folder 'elmo-folder-list-messages-unplugged))) + +(luna-define-method elmo-folder-list-messages-plugged + ((folder elmo-net-folder)) + t) + +;; Should consider offline append and removal. +(luna-define-method elmo-folder-list-messages-unplugged ((folder + elmo-net-folder)) + (if elmo-enable-disconnected-operation + (let ((deleting (elmo-dop-list-deleting-messages folder))) + (nconc + ;; delete deleting messages + (elmo-delete-if + (lambda (number) (memq number deleting)) + ;; current number-list. + (mapcar + 'car + (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))) + ;; append appending messages + (mapcar (lambda (x) (* -1 x)) + (elmo-dop-spool-folder-list-messages folder)))) + (error "Unplugged"))) + +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-net-folder) unread-marks &optional mark-alist) + (if (and (elmo-folder-plugged-p folder) + (elmo-folder-use-flag-p folder)) + (elmo-folder-send folder 'elmo-folder-list-unreads-plugged) + t)) + +(luna-define-method elmo-folder-list-importants-internal + ((folder elmo-net-folder) important-mark) + (if (and (elmo-folder-plugged-p folder) + (elmo-folder-use-flag-p folder)) + (elmo-folder-send folder 'elmo-folder-list-importants-plugged) + t)) + +(luna-define-method elmo-folder-list-unreads-plugged + ((folder elmo-net-folder)) + t) + +(luna-define-method elmo-folder-list-importants-plugged + ((folder elmo-net-folder)) + t) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-net-folder) + numbers) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers) + (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers))) + +(luna-define-method elmo-folder-delete-messages-unplugged ((folder + elmo-net-folder) + numbers) + (elmo-folder-delete-messages-dop folder numbers)) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-net-folder) + numbers new-mark + already-mark seen-mark + important-mark seen-list) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-msgdb-create-plugged + numbers + new-mark + already-mark seen-mark + important-mark seen-list) + (elmo-folder-send folder 'elmo-folder-msgdb-create-unplugged + numbers + new-mark already-mark seen-mark + important-mark seen-list))) + +(luna-define-method elmo-folder-msgdb-create-unplugged ((folder + elmo-net-folder) + numbers + new-mark already-mark + seen-mark + important-mark + seen-list) + ;; XXXX should be appended to already existing msgdb. + (elmo-dop-msgdb + (elmo-folder-msgdb-create (elmo-dop-spool-folder folder) + (mapcar 'abs numbers) + new-mark already-mark + seen-mark + important-mark + seen-list))) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-net-folder) + numbers) + (if (elmo-folder-use-flag-p folder) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-unmark-important-plugged + numbers) + (elmo-folder-send folder + 'elmo-folder-unmark-important-unplugged numbers)) + t)) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-net-folder) + numbers) + (if (elmo-folder-use-flag-p folder) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-mark-as-important-plugged + numbers) + (elmo-folder-send folder 'elmo-folder-mark-as-important-unplugged + numbers)) + t)) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-net-folder) + numbers) + (if (elmo-folder-use-flag-p folder) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-unmark-read-plugged numbers) + (elmo-folder-send folder 'elmo-folder-unmark-read-unplugged numbers)) + t)) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-net-folder) + numbers) + (if (elmo-folder-use-flag-p folder) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-mark-as-read-plugged numbers) + (elmo-folder-send + folder 'elmo-folder-mark-as-read-unplugged numbers)) + t)) + +(luna-define-method elmo-folder-mark-as-read-unplugged ((folder + elmo-net-folder) + numbers) + (elmo-folder-mark-as-read-dop folder numbers)) + +(luna-define-method elmo-folder-unmark-read-unplugged ((folder elmo-net-folder) + numbers) + (elmo-folder-unmark-read-dop folder numbers)) + +(luna-define-method elmo-folder-mark-as-important-unplugged ((folder + elmo-net-folder) + numbers) + (elmo-folder-mark-as-important-dop folder numbers)) + +(luna-define-method elmo-folder-unmark-important-unplugged ((folder + elmo-net-folder) + numbers) + (elmo-folder-unmark-important-dop folder numbers)) + +(luna-define-method elmo-message-encache :around ((folder elmo-net-folder) + number) + (if (elmo-folder-plugged-p folder) + (luna-call-next-method) + (if elmo-enable-disconnected-operation + (elmo-message-encache-dop folder number) + (error "Unplugged")))) + +(luna-define-generic elmo-message-fetch-plugged (folder number strategy + &optional + section + outbuf + unseen) + "") + +(luna-define-generic elmo-message-fetch-unplugged (folder number strategy + &optional + section + outbuf + unseen) + "") + +(luna-define-method elmo-message-fetch-internal ((folder elmo-net-folder) + number strategy + &optional section unseen) + (if (elmo-folder-plugged-p folder) + (elmo-message-fetch-plugged folder number + strategy section + (current-buffer) unseen) + (elmo-message-fetch-unplugged folder number + strategy section + (current-buffer) unseen))) + +(luna-define-method elmo-message-fetch-unplugged + ((folder elmo-net-folder) number strategy &optional section outbuf unseen) + (if (and elmo-enable-disconnected-operation + (< number 0)) + (elmo-message-fetch-internal + (elmo-dop-spool-folder folder) (abs number) strategy + section unseen) + (error "Unplugged"))) + +(luna-define-method elmo-folder-check ((folder elmo-net-folder)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-check-plugged))) + +(luna-define-method elmo-folder-close :after ((folder elmo-net-folder)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-check-plugged))) + +(luna-define-method elmo-folder-diff :around ((folder elmo-net-folder) + &optional numbers) + (if (and (elmo-folder-use-flag-p folder) + (elmo-folder-plugged-p folder)) + (elmo-folder-send folder 'elmo-folder-diff-plugged) + (luna-call-next-method))) + +(luna-define-method elmo-folder-local-p ((folder elmo-net-folder)) + nil) + +(luna-define-method elmo-quit ((folder elmo-net-folder)) + (elmo-network-clear-session-cache)) + (require 'product) (product-provide (provide 'elmo-net) (require 'elmo-version)) diff --git a/elmo/elmo-nmz.el b/elmo/elmo-nmz.el new file mode 100644 index 0000000..c768d26 --- /dev/null +++ b/elmo/elmo-nmz.el @@ -0,0 +1,240 @@ +;;; elmo-nmz.el -- Namazu interface for ELMO. + +;; Copyright (C) 2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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: +;; +(require 'elmo) +(require 'elmo-map) + +(defcustom elmo-nmz-default-index-path "~/Mail" + "*Default index path for namazu." + :type 'directory + :group 'elmo) + +(defcustom elmo-nmz-prog "namazu" + "*Program name of namazu." + :type 'string + :group 'elmo) + +(defcustom elmo-nmz-charset 'iso-2022-jp + "*Charset for namazu argument." + :type 'symbol + :group 'elmo) + +(defcustom elmo-nmz-args '("--all" "--list" "--early") + "*Argument list for namazu to list matched files." + :type '(repeat string) + :group 'elmo) + +;;; "namazu search" +(eval-and-compile + (luna-define-class elmo-nmz-folder + (elmo-map-folder) (pattern index-path)) + (luna-define-internal-accessors 'elmo-nmz-folder)) + +(luna-define-method elmo-folder-initialize ((folder + elmo-nmz-folder) + name) + (with-temp-buffer + (insert "[" name) + (goto-char (point-min)) + (forward-sexp) + (elmo-nmz-folder-set-pattern-internal folder + (buffer-substring + (+ 1 (point-min)) + (- (point) 1))) + (elmo-nmz-folder-set-index-path-internal folder + (buffer-substring (point) + (point-max))) + (if (eq (length (elmo-nmz-folder-index-path-internal folder)) 0) + (elmo-nmz-folder-set-index-path-internal folder + elmo-nmz-default-index-path)) + folder)) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-nmz-folder)) + (expand-file-name + (elmo-replace-string-as-filename + (elmo-folder-name-internal folder)) + (expand-file-name "nmz" elmo-msgdb-dir))) + +(defun elmo-nmz-msgdb-create-entity (folder number) + "Create msgdb entity for the message in the FOLDER with NUMBER." + (elmo-msgdb-create-overview-entity-from-file + number + (elmo-map-message-location folder number))) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-nmz-folder) + numlist new-mark + already-mark seen-mark + important-mark + seen-list) + (let* (overview number-alist mark-alist entity + i percent num pair) + (setq num (length numlist)) + (setq i 0) + (message "Creating msgdb...") + (while numlist + (setq entity + (elmo-nmz-msgdb-create-entity + folder (car numlist))) + (when entity + (setq overview + (elmo-msgdb-append-element + overview entity)) + (setq number-alist + (elmo-msgdb-number-add number-alist + (elmo-msgdb-overview-entity-get-number + entity) + (elmo-msgdb-overview-entity-get-id + entity))) + (setq mark-alist + (elmo-msgdb-mark-append + mark-alist + (elmo-msgdb-overview-entity-get-number + entity) + (or (elmo-msgdb-global-mark-get + (elmo-msgdb-overview-entity-get-id + entity)) + new-mark)))) + (when (> num elmo-display-progress-threshold) + (setq i (1+ i)) + (setq percent (/ (* i 100) num)) + (elmo-display-progress + 'elmo-folder-msgdb-create "Creating msgdb..." + percent)) + (setq numlist (cdr numlist))) + (message "Creating msgdb...done.") + (list overview number-alist mark-alist))) + +(luna-define-method elmo-folder-message-file-p ((folder elmo-nmz-folder)) + t) + +(luna-define-method elmo-message-file-name ((folder elmo-nmz-folder) + number) + (elmo-map-message-location folder number)) + +(luna-define-method elmo-folder-message-make-temp-file-p + ((folder elmo-nmz-folder)) + t) + +(luna-define-method elmo-folder-diff ((folder elmo-nmz-folder) + &optional numbers) + (cons nil nil)) + +(luna-define-method elmo-folder-message-make-temp-files ((folder + elmo-nmz-folder) + numbers + &optional + start-number) + (let ((temp-dir (elmo-folder-make-temp-dir folder)) + (cur-number (if start-number 0))) + (dolist (number numbers) + (elmo-add-name-to-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-nmz-folder) + location strategy + &optional section unseen) + (when (file-exists-p location) + (insert-file-contents-as-binary location))) + +(luna-define-method elmo-map-folder-list-message-locations + ((folder elmo-nmz-folder)) + (let (bol locations) + (with-temp-buffer + (apply 'call-process elmo-nmz-prog nil t t + (append elmo-nmz-args + (list + (encode-mime-charset-string + (elmo-nmz-folder-pattern-internal folder) + elmo-nmz-charset) + (expand-file-name + (elmo-nmz-folder-index-path-internal folder))))) + (goto-char (point-min)) + (while (not (eobp)) + (beginning-of-line) + (setq bol (point)) + (end-of-line) + (setq locations (cons (buffer-substring bol (point)) locations)) + (forward-line 1)) + locations))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-nmz-folder)) + t) + +(luna-define-method elmo-folder-search ((folder elmo-nmz-folder) + condition &optional from-msgs) + (let* ((msgs (or from-msgs (elmo-folder-list-messages folder))) + (orig msgs) + (i 0) + case-fold-search matches + percent num + (num (length msgs))) + (while msgs + (if (elmo-file-field-condition-match + (elmo-map-message-location folder (car msgs)) + condition + (car msgs) + orig) + (setq matches (cons (car msgs) matches))) + (setq i (1+ i)) + (setq percent (/ (* i 100) num)) + (elmo-display-progress + 'elmo-nmz-search "Searching..." + percent) + (setq msgs (cdr msgs))) + matches)) + +;;; To override elmo-map-folder methods. +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-nmz-folder) unread-marks &optional mark-alist) + t) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-nmz-folder) + numbers) + t) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-nmz-folder) + numbers) + t) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-nmz-folder) numbers) + t) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-nmz-folder) numbers) + t) + +(require 'product) +(product-provide (provide 'elmo-nmz) (require 'elmo-version)) + +;;; elmo-nmz.el ends here \ No newline at end of file diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index c4ed392..cf3c2c4 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -33,12 +33,100 @@ ;;; Code: ;; +(require 'elmo-vars) +(require 'elmo-util) +(require 'elmo-date) (require 'elmo-msgdb) -(eval-when-compile - (require 'elmo-cache) - (require 'elmo-util)) +(require 'elmo-cache) +(require 'elmo) (require 'elmo-net) +;; User options +(defcustom elmo-nntp-default-server "localhost" + "*Default NNTP server." + :type 'string + :group 'elmo) + +(defcustom elmo-nntp-default-user nil + "*Default User of NNTP. nil means no user authentication." + :type 'string + :group 'elmo) + +(defcustom elmo-nntp-default-port 119 + "*Default Port number of NNTP." + :type 'integer + :group 'elmo) + +(defcustom elmo-nntp-default-stream-type nil + "*Default stream type for NNTP. +Any symbol value of `elmo-network-stream-type-alist' or +`elmo-nntp-stream-type-alist'." + :type 'symbol + :group 'elmo) + +(defvar elmo-nntp-stream-type-alist nil + "*Stream bindings for NNTP. +This is taken precedence over `elmo-network-stream-type-alist'.") + +(defvar elmo-nntp-overview-fetch-chop-length 200 + "*Number of overviews to fetch in one request in nntp.") + +(defvar elmo-nntp-use-cache t + "Use cache in nntp folder.") + +(defvar elmo-nntp-max-number-precedes-list-active nil + "Non-nil means max number of msgdb is set as the max number of `list active'. +(Needed for inn 2.3 or later?).") + +;;; ELMO NNTP folder +(eval-and-compile + (luna-define-class elmo-nntp-folder (elmo-net-folder) + (group temp-crosses reads)) + (luna-define-internal-accessors 'elmo-nntp-folder)) + +(luna-define-method elmo-folder-initialize :around ((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))) + (setq name (luna-call-next-method)) + (when (string-match + "^\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?" + name) + (elmo-nntp-folder-set-group-internal + folder + (if (match-beginning 1) + (elmo-match-string 1 name))) + ;; Setup slots for elmo-net-folder + (elmo-net-folder-set-user-internal folder + (if (match-beginning 2) + (elmo-match-substring 2 name 1) + elmo-nntp-default-user)) + (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-nntp-default-stream-type)) + folder))) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder)) + (convert-standard-filename + (expand-file-name + (elmo-nntp-folder-group-internal folder) + (expand-file-name (or (elmo-net-folder-server-internal folder) "nowhere") + (expand-file-name "nntp" + elmo-msgdb-dir))))) + +;;; NNTP Session (eval-and-compile (luna-define-class elmo-nntp-session (elmo-network-session) (current-group)) @@ -57,7 +145,7 @@ Don't cache if nil.") (defvar elmo-nntp-list-folders-cache nil) -(defvar elmo-nntp-groups-hashtb nil) + (defvar elmo-nntp-groups-async nil) (defvar elmo-nntp-header-fetch-chop-length 200) @@ -85,7 +173,7 @@ Don't cache if nil.") (list-active . 2))) (defmacro elmo-nntp-get-server-command (session) - (` (assoc (cons (elmo-network-session-host-internal (, session)) + (` (assoc (cons (elmo-network-session-server-internal (, session)) (elmo-network-session-port-internal (, session))) elmo-nntp-server-command-alist))) @@ -97,7 +185,7 @@ Don't cache if nil.") (nconc elmo-nntp-server-command-alist (list (cons (cons - (elmo-network-session-host-internal (, session)) + (elmo-network-session-server-internal (, session)) (elmo-network-session-port-internal (, session))) (setq entry (vector @@ -156,25 +244,21 @@ Don't cache if nil.") (concat (and user (concat ":" user)) (if (and server - (null (string= server elmo-default-nntp-server))) + (null (string= server elmo-nntp-default-server))) (concat "@" server)) (if (and port - (null (eq port elmo-default-nntp-port))) + (null (eq port elmo-nntp-default-port))) (concat ":" (if (numberp port) (int-to-string port) port))) (unless (eq (elmo-network-stream-type-symbol type) - elmo-default-nntp-stream-type) + elmo-nntp-default-stream-type) (elmo-network-stream-type-spec-string type)))) -(defun elmo-nntp-get-session (spec &optional if-exists) +(defun elmo-nntp-get-session (folder &optional if-exists) (elmo-network-get-session 'elmo-nntp-session "NNTP" - (elmo-nntp-spec-hostname spec) - (elmo-nntp-spec-port spec) - (elmo-nntp-spec-username spec) - nil ; auth type - (elmo-nntp-spec-stream-type spec) + folder if-exists)) (luna-define-method elmo-network-initialize-session ((session @@ -314,8 +398,7 @@ Don't cache if nil.") (with-current-buffer outbuf (erase-buffer) (insert-buffer-substring (elmo-network-session-buffer session) - start (- end 3)) - (elmo-delete-cr-get-content-type))))) + start (- end 3)))))) (defun elmo-nntp-select-group (session group &optional force) (let (response) @@ -365,31 +448,41 @@ Don't cache if nil.") msgdb (nconc number-alist (list (cons max-number nil))))))) -(defun elmo-nntp-list-folders (spec &optional hierarchy) - (let ((session (elmo-nntp-get-session spec)) +(luna-define-method elmo-folder-list-subfolders ((folder elmo-nntp-folder) + &optional one-level) + (elmo-nntp-folder-list-subfolders folder one-level)) + +(defun elmo-nntp-folder-list-subfolders (folder one-level) + (let ((session (elmo-nntp-get-session folder)) response ret-val top-ng append-serv use-list-active start) (with-temp-buffer - (if (and (elmo-nntp-spec-group spec) - (elmo-nntp-select-group session (elmo-nntp-spec-group spec))) + (if (and (elmo-nntp-folder-group-internal folder) + (elmo-nntp-select-group + session + (elmo-nntp-folder-group-internal folder))) ;; add top newsgroups - (setq ret-val (list (elmo-nntp-spec-group spec)))) + (setq ret-val (list (elmo-nntp-folder-group-internal folder)))) (unless (setq response (elmo-nntp-list-folders-get-cache - (elmo-nntp-spec-group spec)(current-buffer))) + (elmo-nntp-folder-group-internal folder) + (current-buffer))) (when (setq use-list-active (elmo-nntp-list-active-p session)) (elmo-nntp-send-command session (concat "list" - (if (and (elmo-nntp-spec-group spec) - (null (string= (elmo-nntp-spec-group spec) ""))) + (if (and (elmo-nntp-folder-group-internal folder) + (null (string= (elmo-nntp-folder-group-internal + folder) ""))) (concat " active" - (format " %s.*" (elmo-nntp-spec-group spec) + (format " %s.*" + (elmo-nntp-folder-group-internal folder) ""))))) (if (elmo-nntp-read-response session t) (if (null (setq response (elmo-nntp-read-contents session))) (error "NNTP List folders failed") (when elmo-nntp-list-folders-use-cache (setq elmo-nntp-list-folders-cache - (list (current-time) (elmo-nntp-spec-group spec) + (list (current-time) + (elmo-nntp-folder-group-internal folder) response))) (erase-buffer) (insert response)) @@ -407,22 +500,27 @@ Don't cache if nil.") (setq start nil) (while (string-match (concat "^" (regexp-quote - (or (elmo-nntp-spec-group spec) - "")) ".*$") + (or + (elmo-nntp-folder-group-internal + folder) + "")) ".*$") response start) (insert (match-string 0 response) "\n") (setq start (match-end 0))))) (goto-char (point-min)) (let ((len (count-lines (point-min) (point-max))) (i 0) regexp) - (if hierarchy + (if one-level (progn (setq regexp (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n" - (if (and (elmo-nntp-spec-group spec) - (null (string= - (elmo-nntp-spec-group spec) ""))) - (concat (elmo-nntp-spec-group spec) + (if (and + (elmo-nntp-folder-group-internal folder) + (null (string= + (elmo-nntp-folder-group-internal + folder) ""))) + (concat (elmo-nntp-folder-group-internal + folder) "\\.") ""))) (while (looking-at regexp) (setq top-ng (elmo-match-buffer 1)) @@ -453,31 +551,34 @@ Don't cache if nil.") (when (> len elmo-display-progress-threshold) (elmo-display-progress 'elmo-nntp-list-folders "Parsing active..." 100)))) - (unless (string= (elmo-nntp-spec-hostname spec) - elmo-default-nntp-server) - (setq append-serv (concat "@" (elmo-nntp-spec-hostname spec)))) - (unless (eq (elmo-nntp-spec-port spec) elmo-default-nntp-port) + (unless (string= (elmo-net-folder-server-internal folder) + elmo-nntp-default-server) + (setq append-serv (concat "@" (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 - (elmo-nntp-spec-port spec))))) + (elmo-net-folder-port-internal folder))))) (unless (eq (elmo-network-stream-type-symbol - (elmo-nntp-spec-stream-type spec)) - elmo-default-nntp-stream-type) + (elmo-net-folder-stream-type-internal folder)) + elmo-nntp-default-stream-type) (setq append-serv (concat append-serv (elmo-network-stream-type-spec-string - (elmo-nntp-spec-stream-type spec))))) + (elmo-net-folder-stream-type-internal folder))))) (mapcar '(lambda (fld) (if (consp fld) (list (concat "-" (car fld) - (and (elmo-nntp-spec-username spec) + (and (elmo-net-folder-user-internal folder) (concat - ":" (elmo-nntp-spec-username spec))) + ":" + (elmo-net-folder-user-internal folder))) (and append-serv (concat append-serv)))) (concat "-" fld - (and (elmo-nntp-spec-username spec) - (concat ":" (elmo-nntp-spec-username spec))) + (and (elmo-net-folder-user-internal folder) + (concat ":" (elmo-net-folder-user-internal + folder))) (and append-serv (concat append-serv))))) ret-val))) @@ -496,12 +597,11 @@ Don't cache if nil.") (goto-char (point-min)) (read (current-buffer))))) -(defun elmo-nntp-list-folder (spec &optional nohide) - (let ((session (elmo-nntp-get-session spec)) - (group (elmo-nntp-spec-group spec)) - (killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) +(luna-define-method elmo-folder-list-messages-internal ((folder + elmo-nntp-folder) + &optional nohide) + (let ((session (elmo-nntp-get-session folder)) + (group (elmo-nntp-folder-group-internal folder)) response numbers use-listgroup) (save-excursion (when (setq use-listgroup (elmo-nntp-listgroup-p session)) @@ -528,39 +628,43 @@ Don't cache if nil.") (setq numbers (elmo-nntp-make-msglist (elmo-match-string 2 response) (elmo-match-string 3 response))))) - (elmo-living-messages numbers killed)))) + numbers))) + +(luna-define-method elmo-folder-status ((folder elmo-nntp-folder)) + (elmo-nntp-folder-status folder)) -(defun elmo-nntp-max-of-folder (spec) - (let ((killed-list (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) +(defun elmo-nntp-folder-status (folder) + (let ((killed-list (elmo-msgdb-killed-list-load + (elmo-folder-msgdb-path folder))) end-num entry) (if elmo-nntp-groups-async (if (setq entry (elmo-get-hash-val - (concat (elmo-nntp-spec-group spec) + (concat (elmo-nntp-folder-group-internal folder) (elmo-nntp-folder-postfix - (elmo-nntp-spec-username spec) - (elmo-nntp-spec-hostname spec) - (elmo-nntp-spec-port spec) - (elmo-nntp-spec-stream-type spec))) - elmo-nntp-groups-hashtb)) + (elmo-net-folder-user-internal folder) + (elmo-net-folder-server-internal folder) + (elmo-net-folder-port-internal folder) + (elmo-net-folder-stream-type-internal folder))) + elmo-newsgroups-hashtb)) (progn (setq end-num (nth 2 entry)) - (when (and killed-list elmo-use-killed-list + (when(and killed-list (elmo-number-set-member end-num killed-list)) ;; Max is killed. (setq end-num nil)) (cons end-num (car entry))) - (error "No such newsgroup \"%s\"" (elmo-nntp-spec-group spec))) - (let ((session (elmo-nntp-get-session spec)) + (error "No such newsgroup \"%s\"" + (elmo-nntp-folder-group-internal folder))) + (let ((session (elmo-nntp-get-session folder)) response e-num) (if (null session) (error "Connection failed")) (save-excursion (elmo-nntp-send-command session - (format "group %s" - (elmo-nntp-spec-group spec))) + (format + "group %s" + (elmo-nntp-folder-group-internal folder))) (setq response (elmo-nntp-read-response session)) (if (and response (string-match @@ -571,14 +675,14 @@ Don't cache if nil.") (elmo-match-string 3 response))) (setq e-num (string-to-int (elmo-match-string 1 response))) - (when (and killed-list elmo-use-killed-list + (when (and killed-list (elmo-number-set-member end-num killed-list)) ;; Max is killed. (setq end-num nil)) (cons end-num e-num)) (if (null response) (error "Selecting newsgroup \"%s\" failed" - (elmo-nntp-spec-group spec)) + (elmo-nntp-folder-group-internal folder)) nil))))))) (defconst elmo-nntp-overview-index @@ -593,7 +697,6 @@ Don't cache if nil.") ("xref" . 8))) (defun elmo-nntp-create-msgdb-from-overview-string (str - folder new-mark already-mark seen-mark @@ -654,7 +757,8 @@ Don't cache if nil.") (setq message-id (aref ov-entity 4)) (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-cache-exists-p message-id);; XXX + (if (elmo-file-cache-status + (elmo-file-cache-get message-id)) (if seen nil already-mark) @@ -668,73 +772,38 @@ Don't cache if nil.") (setq ov-list (cdr ov-list))) (list overview number-alist mark-alist))) -(defun elmo-nntp-msgdb-create-as-numlist (spec numlist new-mark already-mark - seen-mark important-mark - seen-list) - "Create msgdb for SPEC for NUMLIST." - (elmo-nntp-msgdb-create spec numlist new-mark already-mark - seen-mark important-mark seen-list - t)) - -(defun elmo-nntp-msgdb-create (spec numlist new-mark already-mark - seen-mark important-mark - seen-list &optional as-num) - (when numlist - (let ((filter numlist) - (session (elmo-nntp-get-session spec)) - beg-num end-num cur length - ret-val ov-str use-xover dir) - (elmo-nntp-select-group session (elmo-nntp-spec-group spec)) - (when (setq use-xover (elmo-nntp-xover-p session)) - (setq beg-num (car numlist) - cur beg-num - end-num (nth (1- (length numlist)) numlist) - length (+ (- end-num beg-num) 1)) - (message "Getting overview...") - (while (<= cur end-num) - (elmo-nntp-send-command - session - (format - "xover %s-%s" - (int-to-string cur) - (int-to-string - (+ cur - elmo-nntp-overview-fetch-chop-length)))) - (with-current-buffer (elmo-network-session-buffer session) - (if ov-str - (setq ret-val - (elmo-msgdb-append - ret-val - (elmo-nntp-create-msgdb-from-overview-string - ov-str - (elmo-nntp-spec-group spec) - new-mark - already-mark - seen-mark - important-mark - seen-list - filter - ))))) - (if (null (elmo-nntp-read-response session t)) - (progn - (setq cur end-num);; exit while loop - (elmo-nntp-set-xover session nil) - (setq use-xover nil)) - (if (null (setq ov-str (elmo-nntp-read-contents session))) - (error "Fetching overview failed"))) - (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1)) - (when (> length elmo-display-progress-threshold) - (elmo-display-progress - 'elmo-nntp-msgdb-create "Getting overview..." - (/ (* (+ (- (min cur end-num) - beg-num) 1) 100) length)))) - (when (> length elmo-display-progress-threshold) - (elmo-display-progress - 'elmo-nntp-msgdb-create "Getting overview..." 100))) - (if (not use-xover) - (setq ret-val (elmo-nntp-msgdb-create-by-header - session numlist - new-mark already-mark seen-mark seen-list)) +(luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder) + numbers new-mark already-mark + seen-mark important-mark + seen-list) + (elmo-nntp-folder-msgdb-create folder numbers new-mark already-mark + seen-mark important-mark + seen-list)) + +(defun elmo-nntp-folder-msgdb-create (folder numbers new-mark already-mark + seen-mark important-mark + seen-list) + (let ((filter numbers) + (session (elmo-nntp-get-session folder)) + beg-num end-num cur length + ret-val ov-str use-xover dir) + (elmo-nntp-select-group session (elmo-nntp-folder-group-internal + folder)) + (when (setq use-xover (elmo-nntp-xover-p session)) + (setq beg-num (car numbers) + cur beg-num + end-num (nth (1- (length numbers)) numbers) + length (+ (- end-num beg-num) 1)) + (message "Getting overview...") + (while (<= cur end-num) + (elmo-nntp-send-command + session + (format + "xover %s-%s" + (int-to-string cur) + (int-to-string + (+ cur + elmo-nntp-overview-fetch-chop-length)))) (with-current-buffer (elmo-network-session-buffer session) (if ov-str (setq ret-val @@ -742,52 +811,88 @@ Don't cache if nil.") ret-val (elmo-nntp-create-msgdb-from-overview-string ov-str - (elmo-nntp-spec-group spec) new-mark already-mark seen-mark important-mark seen-list - filter)))))) - (when elmo-use-killed-list - (setq dir (elmo-msgdb-expand-path spec)) - (elmo-msgdb-killed-list-save - dir - (nconc - (elmo-msgdb-killed-list-load dir) - (car (elmo-list-diff - numlist - (mapcar 'car - (elmo-msgdb-get-number-alist - ret-val))))))) - ;; If there are canceled messages, overviews are not obtained - ;; to max-number(inn 2.3?). - (when (and (elmo-nntp-max-number-precedes-list-active-p) - (elmo-nntp-list-active-p session)) - (elmo-nntp-send-command session - (format "list active %s" - (elmo-nntp-spec-group spec))) - (if (null (elmo-nntp-read-response session)) + filter + ))))) + (if (null (elmo-nntp-read-response session t)) (progn - (elmo-nntp-set-list-active session nil) - (error "NNTP list command failed"))) - (elmo-nntp-catchup-msgdb - ret-val - (nth 1 (read (concat "(" (elmo-nntp-read-contents - session) ")"))))) - ret-val))) - -(defun elmo-nntp-sync-number-alist (spec number-alist) + (setq cur end-num);; exit while loop + (elmo-nntp-set-xover session nil) + (setq use-xover nil)) + (if (null (setq ov-str (elmo-nntp-read-contents session))) + (error "Fetching overview failed"))) + (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1)) + (when (> length elmo-display-progress-threshold) + (elmo-display-progress + 'elmo-nntp-msgdb-create "Getting overview..." + (/ (* (+ (- (min cur end-num) + beg-num) 1) 100) length)))) + (when (> length elmo-display-progress-threshold) + (elmo-display-progress + 'elmo-nntp-msgdb-create "Getting overview..." 100))) + (if (not use-xover) + (setq ret-val (elmo-nntp-msgdb-create-by-header + session numbers + new-mark already-mark seen-mark seen-list)) + (with-current-buffer (elmo-network-session-buffer session) + (if ov-str + (setq ret-val + (elmo-msgdb-append + ret-val + (elmo-nntp-create-msgdb-from-overview-string + ov-str + new-mark + already-mark + seen-mark + important-mark + seen-list + filter)))))) + (elmo-folder-set-killed-list-internal + folder + (nconc + (elmo-folder-killed-list-internal folder) + (car (elmo-list-diff + numbers + (mapcar 'car + (elmo-msgdb-get-number-alist + ret-val)))))) + ;; If there are canceled messages, overviews are not obtained + ;; to max-number(inn 2.3?). + (when (and (elmo-nntp-max-number-precedes-list-active-p) + (elmo-nntp-list-active-p session)) + (elmo-nntp-send-command session + (format "list active %s" + (elmo-nntp-folder-group-internal + folder))) + (if (null (elmo-nntp-read-response session)) + (progn + (elmo-nntp-set-list-active session nil) + (error "NNTP list command failed"))) + (elmo-nntp-catchup-msgdb + ret-val + (nth 1 (read (concat "(" (elmo-nntp-read-contents + session) ")"))))) + ret-val)) + +(luna-define-method elmo-folder-update-number ((folder elmo-nntp-folder)) (if (elmo-nntp-max-number-precedes-list-active-p) - (let ((session (elmo-nntp-get-session spec))) + (let ((session (elmo-nntp-get-session folder)) + (number-alist (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder)))) (if (elmo-nntp-list-active-p session) (let (msgdb-max max-number) ;; If there are canceled messages, overviews are not obtained ;; to max-number(inn 2.3?). - (elmo-nntp-select-group session (elmo-nntp-spec-group spec)) + (elmo-nntp-select-group session + (elmo-nntp-folder-group-internal folder)) (elmo-nntp-send-command session (format "list active %s" - (elmo-nntp-spec-group spec))) + (elmo-nntp-folder-group-internal + folder))) (if (null (elmo-nntp-read-response session)) (error "NNTP list command failed")) (setq max-number @@ -799,18 +904,18 @@ Don't cache if nil.") (if (or (and number-alist (not msgdb-max)) (and msgdb-max max-number (< msgdb-max max-number))) - (nconc number-alist - (list (cons max-number nil))) - number-alist)) - number-alist)))) + (elmo-msgdb-set-number-alist + (elmo-folder-msgdb folder) + (nconc number-alist + (list (cons max-number nil)))))))))) -(defun elmo-nntp-msgdb-create-by-header (session numlist +(defun elmo-nntp-msgdb-create-by-header (session numbers new-mark already-mark seen-mark seen-list) (with-temp-buffer - (elmo-nntp-retrieve-headers session (current-buffer) numlist) + (elmo-nntp-retrieve-headers session (current-buffer) numbers) (elmo-nntp-msgdb-create-message - (length numlist) new-mark already-mark seen-mark seen-list))) + (length numbers) new-mark already-mark seen-mark seen-list))) (defun elmo-nntp-parse-xhdr-response (string) (let (response) @@ -852,7 +957,12 @@ Don't cache if nil.") "Get nntp header string." (save-excursion (let ((session (elmo-nntp-get-session - (list 'nntp nil user server port type)))) + (luna-make-entity + 'elmo-nntp-folder + :user user + :server server + :port port + :stream-type type)))) (elmo-nntp-send-command session (format "head %s" msgid)) (if (elmo-nntp-read-response session) @@ -860,10 +970,24 @@ Don't cache if nil.") (with-current-buffer (elmo-network-session-buffer session) (std11-field-body "Newsgroups"))))) -(defun elmo-nntp-read-msg (spec number outbuf &optional msgdb unread) - (let ((session (elmo-nntp-get-session spec))) +(luna-define-method elmo-message-fetch-with-cache-process :after + ((folder elmo-nntp-folder) number strategy &optional section unread) + (elmo-nntp-setup-crosspost-buffer folder number) + (unless unread + (elmo-nntp-folder-update-crosspost-message-alist + folder (list number)))) + +(luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder) + number strategy + &optional section outbuf + unread) + (elmo-nntp-message-fetch folder number strategy section outbuf unread)) + +(defun elmo-nntp-message-fetch (folder number strategy section outbuf unread) + (let ((session (elmo-nntp-get-session folder)) + newsgroups) (with-current-buffer (elmo-network-session-buffer session) - (elmo-nntp-select-group session (elmo-nntp-spec-group spec)) + (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder)) (elmo-nntp-send-command session (format "article %s" number)) (if (null (elmo-nntp-read-response session t)) (progn @@ -875,21 +999,20 @@ Don't cache if nil.") (goto-char (point-min)) (while (re-search-forward "^\\." nil t) (replace-match "") - (forward-line)))))))) - -;;(defun elmo-msgdb-nntp-overview-create-range (spec beg end mark) -;; (elmo-nntp-overview-create-range hostname beg end mark folder))) - -;;(defun elmo-msgdb-nntp-max-of-folder (spec) -;; (elmo-nntp-max-of-folder hostname folder))) - -(defun elmo-nntp-append-msg (spec string &optional msg no-see)) + (forward-line)) + (elmo-nntp-setup-crosspost-buffer folder number) + (unless unread + (elmo-nntp-folder-update-crosspost-message-alist + folder (list number))))))))) (defun elmo-nntp-post (hostname content-buf) (let ((session (elmo-nntp-get-session - (list 'nntp nil elmo-default-nntp-user - hostname elmo-default-nntp-port - elmo-default-nntp-stream-type))) + (luna-make-entity + 'elmo-nntp-folder + :user elmo-nntp-default-user + :server hostname + :port elmo-nntp-default-port + :stream-type elmo-nntp-default-stream-type))) response has-message-id) (save-excursion (set-buffer content-buf) @@ -941,46 +1064,36 @@ Don't cache if nil.") (unless (eq (forward-line 1) 0) (setq data-continue nil)) (elmo-nntp-send-data-line session line))))) -(defun elmo-nntp-delete-msgs (spec msgs) - "MSGS on FOLDER at SERVER pretended as Deleted. Returns nil if failed." - (if elmo-use-killed-list - (let* ((dir (elmo-msgdb-expand-path spec)) - (killed-list (elmo-msgdb-killed-list-load dir))) - (mapcar '(lambda (msg) - (setq killed-list - (elmo-msgdb-set-as-killed killed-list msg))) - msgs) - (elmo-msgdb-killed-list-save dir killed-list))) - t) +(luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder) + numbers) + (elmo-nntp-folder-delete-messages folder numbers)) -(defun elmo-nntp-check-validity (spec validity-file) - t) -(defun elmo-nntp-sync-validity (spec validity-file) +(defun elmo-nntp-folder-delete-messages (folder numbers) + (let ((killed-list (elmo-folder-killed-list-internal folder))) + (dolist (number numbers) + (setq killed-list + (elmo-msgdb-set-as-killed killed-list number))) + (elmo-folder-set-killed-list-internal folder killed-list)) t) -(defun elmo-nntp-folder-exists-p (spec) - (let ((session (elmo-nntp-get-session spec))) - (if (elmo-nntp-plugged-p spec) +(luna-define-method elmo-folder-exists-p ((folder elmo-nntp-folder)) + (let ((session (elmo-nntp-get-session folder))) + (if (elmo-folder-plugged-p folder) (progn - (elmo-nntp-send-command session - (format "group %s" - (elmo-nntp-spec-group spec))) + (elmo-nntp-send-command + session + (format "group %s" + (elmo-nntp-folder-group-internal folder))) (elmo-nntp-read-response session)) t))) -(defun elmo-nntp-folder-creatable-p (spec) - nil) - -(defun elmo-nntp-create-folder (spec) - nil) ; noop - (defun elmo-nntp-retrieve-field (spec field from-msgs) "Retrieve FIELD values from FROM-MSGS. Returns a list of cons cells like (NUMBER . VALUE)" (let ((session (elmo-nntp-get-session spec))) (if (elmo-nntp-xhdr-p session) (progn - (elmo-nntp-select-group session (elmo-nntp-spec-group spec)) + (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec)) (elmo-nntp-send-command session (format "xhdr %s %s" field @@ -1003,13 +1116,13 @@ Returns a list of cons cells like (NUMBER . VALUE)" (let ((search-key (elmo-filter-key condition))) (cond ((string= "last" search-key) - (let ((numbers (or from-msgs (elmo-nntp-list-folder spec)))) + (let ((numbers (or from-msgs (elmo-folder-list-messages spec)))) (nthcdr (max (- (length numbers) (string-to-int (elmo-filter-value condition))) 0) numbers))) ((string= "first" search-key) - (let* ((numbers (or from-msgs (elmo-nntp-list-folder spec))) + (let* ((numbers (or from-msgs (elmo-folder-list-messages spec))) (rest (nthcdr (string-to-int (elmo-filter-value condition) ) numbers))) (mapcar '(lambda (x) (delete x numbers)) rest) @@ -1063,43 +1176,46 @@ Returns a list of cons cells like (NUMBER . VALUE)" (elmo-list-filter from-msgs result) result)))))) -(defun elmo-nntp-search (spec condition &optional from-msgs) +(luna-define-method elmo-folder-search ((folder elmo-nntp-folder) + condition &optional from-msgs) (let (result) (cond ((vectorp condition) (setq result (elmo-nntp-search-primitive - spec condition from-msgs))) + folder condition from-msgs))) ((eq (car condition) 'and) - (setq result (elmo-nntp-search spec (nth 1 condition) from-msgs) + (setq result (elmo-folder-search folder (nth 1 condition) from-msgs) result (elmo-list-filter result - (elmo-nntp-search - spec (nth 2 condition) + (elmo-folder-search + folder (nth 2 condition) from-msgs)))) ((eq (car condition) 'or) - (setq result (elmo-nntp-search spec (nth 1 condition) from-msgs) + (setq result (elmo-folder-search folder (nth 1 condition) from-msgs) result (elmo-uniq-list (nconc result - (elmo-nntp-search spec (nth 2 condition) - from-msgs))) + (elmo-folder-search folder (nth 2 condition) + from-msgs))) result (sort result '<)))))) -(defun elmo-nntp-get-folders-info-prepare (spec session-keys) +(defun elmo-nntp-get-folders-info-prepare (folder session-keys) (condition-case () - (let ((session (elmo-nntp-get-session spec)) + (let ((session (elmo-nntp-get-session folder)) key count) (with-current-buffer (elmo-network-session-buffer session) (unless (setq key (assoc session session-keys)) (erase-buffer) (setq key (cons session (vector 0 - (elmo-nntp-spec-hostname spec) - (elmo-nntp-spec-username spec) - (elmo-nntp-spec-port spec) - (elmo-nntp-spec-stream-type spec)))) + (elmo-net-folder-server-internal folder) + (elmo-net-folder-user-internal folder) + (elmo-net-folder-port-internal folder) + (elmo-net-folder-stream-type-internal + folder)))) (setq session-keys (nconc session-keys (list key)))) (elmo-nntp-send-command session (format "group %s" - (elmo-nntp-spec-group spec)) + (elmo-nntp-folder-group-internal + folder)) 'noerase) (if elmo-nntp-get-folders-securely (accept-process-output @@ -1124,8 +1240,8 @@ Returns a list of cons cells like (NUMBER . VALUE)" (user (aref key 2)) (port (aref key 3)) (type (aref key 4)) - (hashtb (or elmo-nntp-groups-hashtb - (setq elmo-nntp-groups-hashtb + (hashtb (or elmo-newsgroups-hashtb + (setq elmo-newsgroups-hashtb (elmo-make-hash count))))) (save-excursion (elmo-nntp-groups-read-response session cur count) @@ -1200,17 +1316,6 @@ Returns a list of cons cells like (NUMBER . VALUE)" (replace-match "" t t)) (copy-to-buffer outbuf (point-min) (point-max))))) -(defun elmo-nntp-make-groups-hashtb (folders &optional size) - (let ((hashtb (or elmo-nntp-groups-hashtb - (setq elmo-nntp-groups-hashtb - (elmo-make-hash (or size (length folders))))))) - (mapcar - '(lambda (fld) - (or (elmo-get-hash-val fld hashtb) - (elmo-set-hash-val fld nil hashtb))) - folders) - hashtb)) - ;; from nntp.el [Gnus] (defsubst elmo-nntp-next-result-arrived-p () @@ -1311,7 +1416,8 @@ Returns a list of cons cells like (NUMBER . VALUE)" (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-cache-exists-p message-id);; XXX + (if (elmo-file-cache-status + (elmo-file-cache-get message-id)) (if seen nil already-mark) @@ -1335,39 +1441,141 @@ Returns a list of cons cells like (NUMBER . VALUE)" 'elmo-nntp-msgdb-create-message "Creating msgdb..." 100)) (list overview number-alist mark-alist)))) -(defun elmo-nntp-use-cache-p (spec number) +(luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number) elmo-nntp-use-cache) -(defun elmo-nntp-local-file-p (spec number) +(luna-define-method elmo-folder-creatable-p ((folder elmo-nntp-folder)) + nil) + +(luna-define-method elmo-folder-writable-p ((folder elmo-nntp-folder)) nil) -(defun elmo-nntp-port-label (spec) - (concat "nntp" - (if (elmo-nntp-spec-stream-type spec) - (concat "!" (symbol-name - (elmo-network-stream-type-symbol - (elmo-nntp-spec-stream-type spec))))))) - -(defsubst elmo-nntp-portinfo (spec) - (list (elmo-nntp-spec-hostname spec) - (elmo-nntp-spec-port spec))) - -(defun elmo-nntp-plugged-p (spec) - (apply 'elmo-plugged-p - (append (elmo-nntp-portinfo spec) - (list nil (quote (elmo-nntp-port-label spec)))))) - -(defun elmo-nntp-set-plugged (spec plugged add) - (apply 'elmo-set-plugged plugged - (append (elmo-nntp-portinfo spec) - (list nil nil (quote (elmo-nntp-port-label spec)) add)))) - -(defalias 'elmo-nntp-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-nntp-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-nntp-commit 'elmo-generic-commit) -(defalias 'elmo-nntp-folder-diff 'elmo-generic-folder-diff) +(defun elmo-nntp-parse-newsgroups (string &optional subscribe-only) + (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")) + ngs) + (if (not subscribe-only) + nglist + (dolist (ng nglist) + (if (intern-soft ng elmo-newsgroups-hashtb) + (setq ngs (cons ng ngs)))) + ngs))) + +;;; Crosspost processing. + +;; 1. setup crosspost alist. +;; 1.1. When message is fetched and is crossposted message, +;; it is remembered in `temp-crosses' slot. +;; temp-crosses slot is a list of cons cell: +;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng)) +;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared, +;; 1.3. In elmo-folder-mark-as-read, move crosspost entry +;; from `temp-crosses' slot to `elmo-crosspost-message-alist'. + +;; 2. process crosspost alist. +;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from +;; `elmo-crosspost-message-alist'. +;; 2.2. remove crosspost entry for current newsgroup from +;; `elmo-crosspost-message-alist'. +;; 2.3. elmo-folder-list-unreads return unread message list according to +;; `reads' slot. +;; (There's a problem that if `elmo-folder-list-unreads' +;; never executed, crosspost information is thrown away.) +;; 2.4. In elmo-folder-close, `read' slot is cleared, + +(defun elmo-nntp-setup-crosspost-buffer (folder number) +;; 1.1. When message is fetched and is crossposted message, +;; it is remembered in `temp-crosses' slot. +;; temp-crosses slot is a list of cons cell: +;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng)) + (let (newsgroups crosspost-newsgroups message-id) + (save-restriction + (std11-narrow-to-header) + (setq newsgroups (std11-fetch-field "newsgroups") + message-id (std11-msg-id-string + (car (std11-parse-msg-id-string + (std11-fetch-field "message-id")))))) + (when newsgroups + (when (setq crosspost-newsgroups + (delete + (elmo-nntp-folder-group-internal folder) + (elmo-nntp-parse-newsgroups newsgroups t))) + (unless (assq number + (elmo-nntp-folder-temp-crosses-internal folder)) + (elmo-nntp-folder-set-temp-crosses-internal + folder + (cons (cons number (list message-id crosspost-newsgroups 'ng)) + (elmo-nntp-folder-temp-crosses-internal folder)))))))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder)) +;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared, + (elmo-nntp-folder-set-temp-crosses-internal folder nil) + (elmo-nntp-folder-set-reads-internal folder nil) + ) + +(defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers) +;; 1.3. In elmo-folder-mark-as-read, move crosspost entry +;; from `temp-crosses' slot to `elmo-crosspost-message-alist'. + (let (elem) + (dolist (number numbers) + (when (setq elem (assq number + (elmo-nntp-folder-temp-crosses-internal folder))) + (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist) + (setq elmo-crosspost-message-alist + (cons (cdr elem) elmo-crosspost-message-alist))) + (elmo-nntp-folder-set-temp-crosses-internal + folder + (delq elem (elmo-nntp-folder-temp-crosses-internal folder))))))) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-nntp-folder) + numbers) + (elmo-nntp-folder-update-crosspost-message-alist folder numbers) + t) + +(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder) + &optional + number-alist) + (elmo-nntp-folder-process-crosspost folder number-alist)) + +(defun elmo-nntp-folder-process-crosspost (folder number-alist) +;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from +;; `elmo-crosspost-message-alist'. +;; 2.2. remove crosspost entry for current newsgroup from +;; `elmo-crosspost-message-alist'. + (let (cross-deletes reads entity ngs) + (dolist (cross elmo-crosspost-message-alist) + (if number-alist + (when (setq entity (rassoc (nth 0 cross) number-alist)) + (setq reads (cons (car entity) reads))) + (when (setq entity (elmo-msgdb-overview-get-entity + (nth 0 cross) + (elmo-folder-msgdb folder))) + (setq reads (cons (elmo-msgdb-overview-entity-get-number entity) + reads)))) + (when entity + (if (setq ngs (delete (elmo-nntp-folder-group-internal folder) + (nth 1 cross))) + (setcar (cdr cross) ngs) + (setq cross-deletes (cons cross cross-deletes))) + (setq elmo-crosspost-message-alist-modified t))) + (dolist (dele cross-deletes) + (setq elmo-crosspost-message-alist (delq + dele + elmo-crosspost-message-alist))) + (elmo-nntp-folder-set-reads-internal folder reads))) + +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-nntp-folder) unread-marks mark-alist) + ;; 2.3. elmo-folder-list-unreads return unread message list according to + ;; `reads' slot. + (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist + (elmo-folder-msgdb folder))))) + (elmo-living-messages (delq nil + (mapcar + (lambda (x) + (if (member (nth 1 x) unread-marks) + (car x))) + mark-alist)) + (elmo-nntp-folder-reads-internal folder)))) (require 'product) (product-provide (provide 'elmo-nntp) (require 'elmo-version)) diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el index 6ed21e9..b5d9237 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -29,119 +29,207 @@ ;;; Code: ;; -(require 'elmo-msgdb) - -(defalias 'elmo-pipe-msgdb-create 'elmo-pipe-msgdb-create-as-numlist) - -(defun elmo-pipe-msgdb-create-as-numlist (spec numlist new-mark already-mark - seen-mark important-mark - seen-list) - (elmo-msgdb-create-as-numlist (elmo-pipe-spec-dst spec) - numlist new-mark already-mark - seen-mark important-mark seen-list)) - -(defun elmo-pipe-list-folders (spec &optional hierarchy) - nil) - -(defun elmo-pipe-append-msg (spec string &optional msg no-see) - (elmo-append-msg (elmo-pipe-spec-dst spec) string)) - -(defun elmo-pipe-read-msg (spec number outbuf &optional msgdb unread) - (elmo-call-func (elmo-pipe-spec-dst spec) - "read-msg" - number outbuf msgdb unread)) - -(defun elmo-pipe-delete-msgs (spec msgs) - (elmo-delete-msgs (elmo-pipe-spec-dst spec) msgs)) +(require 'elmo) + +;;; ELMO pipe folder +(eval-and-compile + (luna-define-class elmo-pipe-folder (elmo-folder) + (src dst)) + (luna-define-internal-accessors 'elmo-pipe-folder)) + +(luna-define-method elmo-folder-initialize ((folder elmo-pipe-folder) + name) + (when (string-match "^\\([^|]*\\)|\\(.*\\)$" name) + (elmo-pipe-folder-set-src-internal folder + (elmo-make-folder + (elmo-match-string 1 name))) + (elmo-pipe-folder-set-dst-internal folder + (elmo-make-folder + (elmo-match-string 2 name)))) + folder) + +(luna-define-method elmo-folder-get-primitive-list ((folder elmo-pipe-folder)) + (elmo-flatten + (mapcar + 'elmo-folder-get-primitive-list + (list (elmo-pipe-folder-src-internal folder) + (elmo-pipe-folder-dst-internal folder))))) + +(luna-define-method elmo-folder-contains-type ((folder elmo-pipe-folder) + type) + (or (elmo-folder-contains-type (elmo-pipe-folder-src-internal folder) type) + (elmo-folder-contains-type (elmo-pipe-folder-dst-internal folder) type))) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-pipe-folder) + numlist new-mark already-mark + seen-mark important-mark + seen-list) + (elmo-folder-msgdb-create (elmo-pipe-folder-dst-internal folder) + numlist new-mark already-mark + seen-mark important-mark seen-list)) + +(luna-define-method elmo-folder-append-messages ((folder elmo-pipe-folder) + src-folder numbers + unread-marks + &optional same-number) + (elmo-folder-append-messages (elmo-pipe-folder-dst-internal folder) + src-folder numbers + unread-marks + same-number)) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-pipe-folder) + unread &optional number) + (elmo-folder-append-buffer (elmo-pipe-folder-dst-internal folder) + unread number)) + +(luna-define-method elmo-message-fetch ((folder elmo-pipe-folder) + number strategy + &optional section outbuf unseen) + (elmo-message-fetch (elmo-pipe-folder-dst-internal folder) + number strategy section outbuf unseen)) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-pipe-folder) + numbers) + (elmo-folder-delete-messages (elmo-pipe-folder-dst-internal folder) + numbers)) (defvar elmo-pipe-drained-hook nil "A hook called when the pipe is flushed.") (defun elmo-pipe-drain (src dst) "Move all messages of SRC to DST." - (let ((elmo-inhibit-read-cache t); Inhibit caching while moving messages. - elmo-pop3-use-uidl) ; No need to use UIDL - (message "Checking %s..." src) - (let ((srclist (elmo-list-folder src)) - (msgdb (elmo-msgdb-load src))) - (elmo-move-msgs src srclist dst msgdb) - ;; Don't save msgdb here. - ;; Because summary view of original folder is not updated yet. - ;; (elmo-msgdb-save src msgdb) - (elmo-commit src)) - (run-hooks 'elmo-pipe-drained-hook))) - -(defun elmo-pipe-list-folder (spec &optional nohide) - (elmo-pipe-drain (elmo-pipe-spec-src spec) - (elmo-pipe-spec-dst spec)) - (let ((killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - numbers) - (setq numbers (elmo-list-folder (elmo-pipe-spec-dst spec))) - (elmo-living-messages numbers killed))) - -(defun elmo-pipe-list-folder-unread (spec number-alist mark-alist unread-marks) - (elmo-list-folder-unread (elmo-pipe-spec-dst spec) - number-alist mark-alist unread-marks)) + (let ((elmo-inhibit-number-mapping t)) ; No need to use UIDL + (message "Checking %s..." (elmo-folder-name-internal src)) + (elmo-folder-open-internal src) + (elmo-folder-move-messages src (elmo-folder-list-messages src) dst)) + ;; Don't save msgdb here. + ;; Because summary view of original folder is not updated yet. + (elmo-folder-close-internal src) + (run-hooks 'elmo-pipe-drained-hook)) + +(luna-define-method elmo-folder-open-internal ((folder elmo-pipe-folder)) + (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder)) + (let ((src-folder (elmo-pipe-folder-src-internal folder)) + (dst-folder (elmo-pipe-folder-dst-internal folder))) + (when (and (elmo-folder-plugged-p src-folder) + (elmo-folder-plugged-p dst-folder)) + (elmo-pipe-drain src-folder dst-folder)))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-pipe-folder)) + (elmo-folder-close-internal(elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-pipe-folder) &optional nohide) + (elmo-folder-list-messages-internal (elmo-pipe-folder-dst-internal + folder) nohide)) + +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-pipe-folder) unread-marks &optional mark-alist) + (elmo-folder-list-unreads-internal (elmo-pipe-folder-dst-internal folder) + unread-marks mark-alist)) -(defun elmo-pipe-list-folder-important (spec number-alist) - (elmo-list-folder-important (elmo-pipe-spec-dst spec) number-alist)) - -(defun elmo-pipe-max-of-folder (spec) - (let* (elmo-pop3-use-uidl - (src-length (length (elmo-list-folder (elmo-pipe-spec-src spec)))) - (dst-list (elmo-list-folder (elmo-pipe-spec-dst spec)))) - (cons (+ src-length (elmo-max-of-list dst-list)) - (+ src-length (length dst-list))))) - -(defun elmo-pipe-folder-exists-p (spec) - (and (elmo-folder-exists-p (elmo-pipe-spec-src spec)) - (elmo-folder-exists-p (elmo-pipe-spec-dst spec)))) - -(defun elmo-pipe-folder-creatable-p (spec) - (or (elmo-folder-creatable-p (elmo-pipe-spec-src spec)) - (elmo-folder-creatable-p (elmo-pipe-spec-dst spec)))) - -(defun elmo-pipe-create-folder (spec) - (if (and (not (elmo-folder-exists-p (elmo-pipe-spec-src spec))) - (elmo-folder-creatable-p (elmo-pipe-spec-src spec))) - (elmo-create-folder (elmo-pipe-spec-src spec))) - (if (and (not (elmo-folder-exists-p (elmo-pipe-spec-dst spec))) - (elmo-folder-creatable-p (elmo-pipe-spec-dst spec))) - (elmo-create-folder (elmo-pipe-spec-dst spec)))) - -(defun elmo-pipe-search (spec condition &optional numlist) - (elmo-search (elmo-pipe-spec-dst spec) condition numlist)) - -(defun elmo-pipe-use-cache-p (spec number) - (elmo-use-cache-p (elmo-pipe-spec-dst spec) number)) - -(defun elmo-pipe-commit (spec) - (elmo-commit (elmo-pipe-spec-src spec)) - (elmo-commit (elmo-pipe-spec-dst spec))) - -(defun elmo-pipe-plugged-p (spec) - (and (elmo-folder-plugged-p (elmo-pipe-spec-src spec)) - (elmo-folder-plugged-p (elmo-pipe-spec-dst spec)))) - -(defun elmo-pipe-set-plugged (spec plugged add) - (elmo-folder-set-plugged (elmo-pipe-spec-src spec) plugged add) - (elmo-folder-set-plugged (elmo-pipe-spec-dst spec) plugged add)) - -(defun elmo-pipe-local-file-p (spec number) - (elmo-local-file-p (elmo-pipe-spec-dst spec) number)) - -(defun elmo-pipe-get-msg-filename (spec number &optional loc-alist) - (elmo-get-msg-filename (elmo-pipe-spec-dst spec) number loc-alist)) - -(defun elmo-pipe-sync-number-alist (spec number-alist) - (elmo-call-func (elmo-pipe-spec-src spec) - "sync-number-alist" number-alist)) ; ?? - -(defun elmo-pipe-server-diff (spec) - nil) - -(defalias 'elmo-pipe-folder-diff 'elmo-generic-folder-diff) +(luna-define-method elmo-folder-list-importants-internal + ((folder elmo-pipe-folder) important-mark) + (elmo-folder-list-importants-internal (elmo-pipe-folder-dst-internal folder) + important-mark)) + +(luna-define-method elmo-folder-status ((folder elmo-pipe-folder)) + (elmo-folder-open-internal (elmo-pipe-folder-src-internal folder)) + (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder)) + (let* ((elmo-inhibit-number-mapping t) + (src-length (length (elmo-folder-list-messages + (elmo-pipe-folder-src-internal folder)))) + (dst-list (elmo-folder-list-messages + (elmo-pipe-folder-dst-internal folder)))) + (prog1 (cons (+ src-length (elmo-max-of-list dst-list)) + (+ src-length (length dst-list))) + ;; No save. + (elmo-folder-close-internal (elmo-pipe-folder-src-internal folder)) + (elmo-folder-close-internal (elmo-pipe-folder-dst-internal folder))))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-pipe-folder)) + (and (elmo-folder-exists-p (elmo-pipe-folder-src-internal folder)) + (elmo-folder-exists-p (elmo-pipe-folder-dst-internal folder)))) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-pipe-folder)) + ;; Share with destination...OK? + (elmo-folder-expand-msgdb-path (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-pipe-folder)) + (and (elmo-folder-creatable-p (elmo-pipe-folder-src-internal folder)) + (elmo-folder-creatable-p (elmo-pipe-folder-dst-internal folder)))) + +(luna-define-method elmo-folder-create ((folder elmo-pipe-folder)) + (if (and (not (elmo-folder-exists-p (elmo-pipe-folder-src-internal folder))) + (elmo-folder-creatable-p (elmo-pipe-folder-src-internal folder))) + (elmo-folder-create (elmo-pipe-folder-src-internal folder))) + (if (and (not (elmo-folder-exists-p (elmo-pipe-folder-dst-internal folder))) + (elmo-folder-creatable-p (elmo-pipe-folder-dst-internal folder))) + (elmo-folder-create (elmo-pipe-folder-dst-internal folder)))) + +(luna-define-method elmo-folder-search ((folder elmo-pipe-folder) + condition &optional numlist) + (elmo-folder-search (elmo-pipe-folder-dst-internal folder) + condition numlist)) + +(luna-define-method elmo-message-use-cache-p ((folder elmo-pipe-folder) number) + (elmo-message-use-cache-p (elmo-pipe-folder-dst-internal folder) number)) + +(luna-define-method elmo-folder-check ((folder elmo-pipe-folder)) + (elmo-folder-close-internal folder) + (elmo-folder-open-internal folder)) + +(luna-define-method elmo-folder-plugged-p ((folder elmo-pipe-folder)) + (and (elmo-folder-plugged-p (elmo-pipe-folder-src-internal folder)) + (elmo-folder-plugged-p (elmo-pipe-folder-dst-internal folder)))) + +(luna-define-method elmo-message-file-p ((folder elmo-pipe-folder) number) + (elmo-message-file-p (elmo-pipe-folder-dst-internal folder) number)) + +(luna-define-method elmo-message-file-name ((folder elmo-pipe-folder) number) + (elmo-message-file-name (elmo-pipe-folder-dst-internal folder) number)) + +(luna-define-method elmo-folder-message-file-number-p ((folder + elmo-pipe-folder)) + (elmo-folder-message-file-number-p (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-message-file-directory ((folder + elmo-pipe-folder)) + (elmo-folder-message-file-directory + (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-message-make-temp-file-p + ((folder elmo-pipe-folder)) + (elmo-folder-message-make-temp-file-p + (elmo-pipe-folder-dst-internal folder))) + +(luna-define-method elmo-folder-message-make-temp-files ((folder + elmo-pipe-folder) + numbers + &optional + start-number) + (elmo-folder-message-make-temp-files + (elmo-pipe-folder-dst-internal folder) numbers start-number)) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-pipe-folder) + numbers) + (elmo-folder-mark-as-read (elmo-pipe-folder-dst-internal folder) + numbers)) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-pipe-folder) + numbers) + (elmo-folder-unmark-read (elmo-pipe-folder-dst-internal folder) + numbers)) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-pipe-folder) + numbers) + (elmo-folder-unmark-important (elmo-pipe-folder-dst-internal folder) + numbers)) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-pipe-folder) + numbers) + (elmo-folder-mark-as-important (elmo-pipe-folder-dst-internal folder) + numbers)) (require 'product) (product-provide (provide 'elmo-pipe) (require 'elmo-version)) diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 05033f2..13d69bd 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -40,6 +40,56 @@ (eval-and-compile (autoload 'md5 "md5")) +;; POP3 +(defcustom elmo-pop3-default-user (or (getenv "USER") + (getenv "LOGNAME") + (user-login-name)) + "*Default username for POP3." + :type 'string + :group 'elmo) + +(defcustom elmo-pop3-default-server "localhost" + "*Default POP3 server." + :type 'string + :group 'elmo) + +(defcustom elmo-pop3-default-authenticate-type 'user + "*Default Authentication type for POP3." + :type 'symbol + :group 'elmo) + +(defcustom elmo-pop3-default-port 110 + "*Default POP3 port." + :type 'integer + :group 'elmo) + +(defcustom elmo-pop3-default-stream-type nil + "*Default stream type for POP3. +Any symbol value of `elmo-network-stream-type-alist' or +`elmo-pop3-stream-type-alist'." + :type 'symbol + :group 'elmo) + +(defcustom elmo-pop3-default-use-uidl t + "If non-nil, use UIDL on POP3." + :type 'boolean + :group 'elmo) + +(defvar elmo-pop3-stream-type-alist nil + "*Stream bindings for POP3. +This is taken precedence over `elmo-network-stream-type-alist'.") + +(defvar elmo-pop3-use-uidl-internal t + "(Internal switch for using UIDL on POP3).") + +(defvar elmo-pop3-use-cache t + "Use cache in pop3 folder.") + +(defvar elmo-pop3-send-command-synchronously nil + "If non-nil, commands are send synchronously. +If server doesn't accept asynchronous commands, this variable should be +set as non-nil.") + (defvar elmo-pop3-exists-exactly t) (defvar sasl-mechanism-alist) @@ -61,7 +111,53 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (insert "NO LOGGING\n") (insert (apply 'format message args) "\n"))))) -(luna-define-class elmo-pop3-session (elmo-network-session)) +;;; ELMO POP3 folder +(eval-and-compile + (luna-define-class elmo-pop3-folder (elmo-net-folder) + (use-uidl location-alist)) + (luna-define-internal-accessors 'elmo-pop3-folder)) + +(luna-define-method elmo-folder-initialize :around ((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))) + (setq name (luna-call-next-method)) + ;; Setup slots for elmo-net-folder + (when (string-match "^\\([^:/!]*\\)\\(/[^/:@!]+\\)?\\(:[^/:@!]+\\)?" name) + (elmo-net-folder-set-user-internal folder + (if (match-beginning 1) + (elmo-match-string 1 name))) + (if (eq (length (elmo-net-folder-user-internal folder)) 0) + (elmo-net-folder-set-user-internal folder + elmo-pop3-default-user)) + (elmo-net-folder-set-auth-internal + folder + (if (match-beginning 2) + (intern (elmo-match-substring 2 name 1)) + elmo-pop3-default-authenticate-type)) + (elmo-pop3-folder-set-use-uidl-internal + folder + (if (match-beginning 3) + (string= (elmo-match-substring 3 name 1) "uidl") + elmo-pop3-default-use-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-pop3-default-stream-type)) + folder)) + +;;; POP3 session +(luna-define-class elmo-pop3-session (elmo-network-session) ()) ;; buffer-local (defvar elmo-pop3-read-point nil) @@ -85,25 +181,25 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (when (memq (process-status (elmo-network-session-process-internal session)) '(open run)) - (elmo-pop3-send-command (elmo-network-session-process-internal session) - "quit") - (or (elmo-pop3-read-response - (elmo-network-session-process-internal session) t) - (error "POP error: QUIT failed"))) + (let ((buffer (process-buffer + (elmo-network-session-process-internal session)))) + (elmo-pop3-send-command (elmo-network-session-process-internal session) + "quit") + ;; process is dead. + (or (elmo-pop3-read-response + (elmo-network-session-process-internal session) + t buffer) + (error "POP error: QUIT failed")))) (kill-buffer (process-buffer (elmo-network-session-process-internal session))) (delete-process (elmo-network-session-process-internal session)))) -(defun elmo-pop3-get-session (spec &optional if-exists) - (elmo-network-get-session - 'elmo-pop3-session - "POP3" - (elmo-pop3-spec-hostname spec) - (elmo-pop3-spec-port spec) - (elmo-pop3-spec-username spec) - (elmo-pop3-spec-auth spec) - (elmo-pop3-spec-stream-type spec) - if-exists)) +(defun elmo-pop3-get-session (folder &optional if-exists) + (let ((elmo-pop3-use-uidl-internal (if elmo-inhibit-number-mapping + nil + (elmo-pop3-folder-use-uidl-internal + folder)))) + (elmo-network-get-session 'elmo-pop3-session "POP3" folder if-exists))) (defun elmo-pop3-send-command (process command &optional no-erase) (with-current-buffer (process-buffer process) @@ -117,6 +213,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (process-send-string process "\r\n"))) (defun elmo-pop3-read-response (process &optional not-command keep-lock) + ;; buffer is in case for process is dead. (with-current-buffer (process-buffer process) (let ((case-fold-search nil) (response-string nil) @@ -153,8 +250,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (concat return-value "\n" response-string) response-string))) (setq elmo-pop3-read-point match-end))) - (unless keep-lock - (elmo-pop3-unlock)) + (unless keep-lock (elmo-pop3-unlock)) return-value))) (defun elmo-pop3-process-filter (process output) @@ -163,9 +259,15 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (goto-char (point-max)) (insert output) (elmo-pop3-debug "RECEIVED: %s\n" output) - (if elmo-pop3-total-size - (message "Retrieving...(%d/%d bytes)." - (buffer-size) elmo-pop3-total-size)))) + (if (and elmo-pop3-total-size + (> elmo-pop3-total-size + (min elmo-display-retrieval-progress-threshold 100))) + (elmo-display-progress + 'elmo-display-retrieval-progress + (format "Retrieving (%d/%d bytes)..." + (buffer-size) + elmo-pop3-total-size) + (/ (buffer-size) (/ elmo-pop3-total-size 100)))))) (defun elmo-pop3-auth-user (session) (let ((process (elmo-network-session-process-internal session))) @@ -269,7 +371,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") mechanism (elmo-network-session-user-internal session) "pop" - (elmo-network-session-host-internal session))) + (elmo-network-session-server-internal session))) ;;; (if elmo-pop3-auth-user-realm ;;; (sasl-client-set-property client 'realm elmo-pop3-auth-user-realm)) (setq name (sasl-mechanism-name mechanism)) @@ -335,7 +437,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") ;; POP server always returns a sequence of serial numbers. (setq count (elmo-pop3-parse-list-response response)) ;; UIDL - (when elmo-pop3-use-uidl + (when elmo-pop3-use-uidl-internal (setq elmo-pop3-uidl-number-hash (elmo-make-hash (* count 2))) (setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2))) ;; UIDL @@ -356,26 +458,29 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (accept-process-output process) (goto-char elmo-pop3-read-point)) (setq match-end (point)) - (elmo-pop3-unlock) + (elmo-pop3-unlock) (elmo-delete-cr (buffer-substring elmo-pop3-read-point (- match-end 3)))))) -;; dummy functions -(defun elmo-pop3-list-folders (spec &optional hierarchy) nil) -(defun elmo-pop3-append-msg (spec string) nil nil) -(defun elmo-pop3-folder-creatable-p (spec) nil) -(defun elmo-pop3-create-folder (spec) nil) +(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-pop3-folder)) + (convert-standard-filename + (expand-file-name + (elmo-safe-filename (elmo-net-folder-user-internal folder)) + (expand-file-name (elmo-net-folder-server-internal folder) + (expand-file-name + "pop" + elmo-msgdb-dir))))) -(defun elmo-pop3-folder-exists-p (spec) +(luna-define-method elmo-folder-exists-p ((folder elmo-pop3-folder)) (if (and elmo-pop3-exists-exactly - (elmo-pop3-plugged-p spec)) + (elmo-folder-plugged-p folder)) (save-excursion - (let (elmo-auto-change-plugged ; don't change plug status. - elmo-pop3-use-uidl ; No need to use uidl. + (let (elmo-auto-change-plugged ; don't change plug status. + (elmo-inhibit-number-mapping t) ; No need to use uidl. session) (prog1 - (setq session (elmo-pop3-get-session spec)) + (setq session (elmo-pop3-get-session folder)) (if session (elmo-network-close-session session))))) t)) @@ -422,10 +527,10 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq elmo-pop3-list-done t)) count))) -(defun elmo-pop3-list-location (spec) +(defun elmo-pop3-list-location (folder) (with-current-buffer (process-buffer (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) + (elmo-pop3-get-session folder))) (let (list) (if elmo-pop3-uidl-done (progn @@ -436,18 +541,46 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (nreverse list)) (error "POP3: Error in UIDL"))))) -(defun elmo-pop3-list-by-uidl-subr (spec &optional nonsort) - (let ((flist (elmo-list-folder-by-location - spec - (elmo-pop3-list-location spec)))) +(defun elmo-pop3-list-folder-by-location (folder locations) + (let* ((location-alist (elmo-pop3-folder-location-alist-internal folder)) + (locations-in-db (mapcar 'cdr location-alist)) + result new-locs new-alist deleted-locs i) + (setq new-locs + (elmo-delete-if (function + (lambda (x) (member x locations-in-db))) + locations)) + (setq deleted-locs + (elmo-delete-if (function + (lambda (x) (member x locations))) + locations-in-db)) + (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0)) + (mapcar + (function + (lambda (x) + (setq location-alist + (delq (rassoc x location-alist) location-alist)))) + deleted-locs) + (while new-locs + (setq i (1+ i)) + (setq new-alist (cons (cons i (car new-locs)) new-alist)) + (setq new-locs (cdr new-locs))) + (setq result (nconc location-alist new-alist)) + (setq result (sort result (lambda (x y) (< (car x)(car y))))) + (elmo-pop3-folder-set-location-alist-internal folder result) + (mapcar 'car result))) + +(defun elmo-pop3-list-by-uidl-subr (folder &optional nonsort) + (let ((flist (elmo-pop3-list-folder-by-location + folder + (elmo-pop3-list-location folder)))) (if nonsort (cons (elmo-max-of-list flist) (length flist)) (sort flist '<)))) -(defun elmo-pop3-list-by-list (spec) +(defun elmo-pop3-list-by-list (folder) (with-current-buffer (process-buffer (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) + (elmo-pop3-get-session folder))) (let (list) (if elmo-pop3-list-done (progn @@ -459,25 +592,23 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (sort list '<)) (error "POP3: Error in list"))))) -(defun elmo-pop3-list-folder (spec &optional nohide) - (let ((killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - numbers) - (elmo-pop3-commit spec) - (setq numbers (if elmo-pop3-use-uidl - (progn - (elmo-pop3-list-by-uidl-subr spec)) - (elmo-pop3-list-by-list spec))) - (elmo-living-messages numbers killed))) - -(defun elmo-pop3-max-of-folder (spec) - (elmo-pop3-commit spec) - (if elmo-pop3-use-uidl - (elmo-pop3-list-by-uidl-subr spec 'nonsort) +(defsubst elmo-pop3-folder-list-messages (folder) + (if (and (not elmo-inhibit-number-mapping) + (elmo-pop3-folder-use-uidl-internal folder)) + (elmo-pop3-list-by-uidl-subr folder) + (elmo-pop3-list-by-list folder))) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-pop3-folder) &optional nohide) + (elmo-pop3-folder-list-messages folder)) + +(luna-define-method elmo-folder-status ((folder elmo-pop3-folder)) + (elmo-folder-check folder) + (if (elmo-pop3-folder-use-uidl-internal folder) + (elmo-pop3-list-by-uidl-subr folder 'nonsort) (let* ((process (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) + (elmo-pop3-get-session folder))) (total 0) response) (with-current-buffer (process-buffer process) @@ -569,7 +700,22 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (replace-match "\n")) (copy-to-buffer tobuffer (point-min) (point-max))))) -(defalias 'elmo-pop3-msgdb-create 'elmo-pop3-msgdb-create-as-numlist) +(luna-define-method elmo-folder-msgdb-create ((folder elmo-pop3-folder) + numlist new-mark + already-mark seen-mark + important-mark seen-list) + (let ((process (elmo-network-session-process-internal + (elmo-pop3-get-session folder)))) + (with-current-buffer (process-buffer process) + (elmo-pop3-sort-msgdb-by-original-number + folder + (elmo-pop3-msgdb-create-by-header + process + numlist + new-mark already-mark + seen-mark seen-list + (if (elmo-pop3-folder-use-uidl-internal folder) + (elmo-pop3-folder-location-alist-internal folder))))))) (defun elmo-pop3-sort-overview-by-original-number (overview loc-alist) (if loc-alist @@ -583,33 +729,15 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") loc-alist)))))) overview)) -(defun elmo-pop3-sort-msgdb-by-original-number (msgdb) +(defun elmo-pop3-sort-msgdb-by-original-number (folder msgdb) (message "Sorting...") (let ((overview (elmo-msgdb-get-overview msgdb))) + (current-buffer) (setq overview (elmo-pop3-sort-overview-by-original-number overview - (elmo-msgdb-get-location msgdb))) + (elmo-pop3-folder-location-alist-internal folder))) (message "Sorting...done") - (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb)))) - -(defun elmo-pop3-msgdb-create-as-numlist (spec numlist new-mark - already-mark seen-mark - important-mark seen-list - &optional msgdb) - (when numlist - (let ((process (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) - loc-alist) - (if elmo-pop3-use-uidl - (setq loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load - (elmo-msgdb-expand-path spec))))) - (with-current-buffer (process-buffer process) - (elmo-pop3-sort-msgdb-by-original-number - (elmo-pop3-msgdb-create-by-header process numlist - new-mark already-mark - seen-mark seen-list - loc-alist)))))) + (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)))) (defun elmo-pop3-uidl-to-number (uidl) (string-to-number (elmo-get-hash-val uidl @@ -700,8 +828,8 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq message-id (car entity)) (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-cache-exists-p - message-id) ; XXX + (if (elmo-file-cache-status + (elmo-file-cache-get message-id)) (if seen nil already-mark) @@ -720,7 +848,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-display-progress 'elmo-pop3-msgdb-create-message "Creating msgdb..." (/ (* i 100) num))))) - (list overview number-alist mark-alist loc-alist)))) + (list overview number-alist mark-alist)))) (defun elmo-pop3-read-body (process outbuf) (with-current-buffer (process-buffer process) @@ -734,18 +862,31 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-pop3-unlock) (with-current-buffer outbuf (erase-buffer) - (insert-buffer-substring (process-buffer process) start (- end 3)) - (elmo-delete-cr-get-content-type))))) - -(defun elmo-pop3-read-msg (spec number outbuf &optional msgdb unread) - (let* ((loc-alist (if elmo-pop3-use-uidl - (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load - (elmo-msgdb-expand-path spec))))) + (insert-buffer-substring (process-buffer process) start (- end 3)))))) + +(luna-define-method elmo-folder-open-internal ((folder elmo-pop3-folder)) + (if (and (not elmo-inhibit-number-mapping) + (elmo-pop3-folder-use-uidl-internal folder)) + (elmo-pop3-folder-set-location-alist-internal + folder (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))) + +(luna-define-method elmo-folder-commit :after ((folder elmo-pop3-folder)) + (when (elmo-folder-persistent-p folder) + (elmo-msgdb-location-save (elmo-folder-msgdb-path folder) + (elmo-pop3-folder-location-alist-internal + folder)))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-pop3-folder)) + (elmo-folder-check folder)) + +(luna-define-method elmo-message-fetch-plugged ((folder elmo-pop3-folder) + number strategy + &optional section + outbuf unseen) + (let* ((loc-alist (elmo-pop3-folder-location-alist-internal folder)) (process (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) - size response errmsg msg) + (elmo-pop3-get-session folder))) + size response errmsg msg) (with-current-buffer (process-buffer process) (if loc-alist (setq number (elmo-pop3-uidl-to-number @@ -755,7 +896,6 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (when number (elmo-pop3-send-command process (format "retr %s" number)) - (setq elmo-pop3-total-size size) (unless elmo-inhibit-display-retrieval-progress (setq elmo-pop3-total-size size) (elmo-display-progress @@ -795,64 +935,30 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (error "Deleting message failed"))) (error "Deleting message failed"))))) -(defun elmo-pop3-delete-msgs (spec msgs &optional msgdb) - (let ((loc-alist (if elmo-pop3-use-uidl - (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load - (elmo-msgdb-expand-path spec))))) +(luna-define-method elmo-folder-delete-messages ((folder elmo-pop3-folder) + msgs) + (let ((loc-alist (elmo-pop3-folder-location-alist-internal folder)) (process (elmo-network-session-process-internal - (elmo-pop3-get-session spec)))) + (elmo-pop3-get-session folder)))) (mapcar '(lambda (msg) (elmo-pop3-delete-msg process msg loc-alist)) msgs))) -(defun elmo-pop3-search (spec condition &optional numlist) - (error "Searching in pop3 folder is not implemented yet")) - -(defun elmo-pop3-use-cache-p (spec number) +(luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number) elmo-pop3-use-cache) -(defun elmo-pop3-local-file-p (spec number) - nil) - -(defun elmo-pop3-port-label (spec) - (concat "pop3" - (if (elmo-pop3-spec-stream-type spec) - (concat "!" (symbol-name - (elmo-network-stream-type-symbol - (elmo-pop3-spec-stream-type spec))))))) - -(defsubst elmo-pop3-portinfo (spec) - (list (elmo-pop3-spec-hostname spec) - (elmo-pop3-spec-port spec))) - -(defun elmo-pop3-plugged-p (spec) - (apply 'elmo-plugged-p - (append (elmo-pop3-portinfo spec) - (list nil (quote (elmo-pop3-port-label spec)))))) - -(defun elmo-pop3-set-plugged (spec plugged add) - (apply 'elmo-set-plugged plugged - (append (elmo-pop3-portinfo spec) - (list nil nil (quote (elmo-pop3-port-label spec)) add)))) - -(defalias 'elmo-pop3-sync-number-alist - 'elmo-generic-sync-number-alist) -(defalias 'elmo-pop3-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-pop3-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-pop3-folder-diff 'elmo-generic-folder-diff) - -(defun elmo-pop3-commit (spec) - (if (elmo-pop3-plugged-p spec) - (let ((session (elmo-pop3-get-session spec 'if-exists))) +(luna-define-method elmo-folder-persistent-p ((folder elmo-pop3-folder)) + (and (elmo-folder-persistent-internal folder) + (elmo-pop3-folder-use-uidl-internal folder))) + +(luna-define-method elmo-folder-check ((folder elmo-pop3-folder)) + (if (elmo-folder-plugged-p folder) + (let ((session (elmo-pop3-get-session folder 'if-exists))) (when (and session (not (elmo-pop3-locked-p (elmo-network-session-process-internal session)))) + (elmo-pop3-folder-set-location-alist-internal folder nil) (elmo-network-close-session session))))) - (require 'product) (product-provide (provide 'elmo-pop3) (require 'elmo-version)) diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el new file mode 100644 index 0000000..c1d9922 --- /dev/null +++ b/elmo/elmo-shimbun.el @@ -0,0 +1,371 @@ +;;; elmo-shimbun.el -- Shimbun interface for ELMO. + +;; Copyright (C) 2001 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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: +;; +(require 'elmo) +(require 'elmo-map) +(require 'shimbun) + +(defcustom elmo-shimbun-check-interval 60 + "*Check interval for shimbun." + :type 'integer + :group 'elmo) + +(defcustom elmo-shimbun-default-index-range 2 + "*Default value for the range of header indices." + :type '(choice (const :tag "all" all) + (const :tag "last" last) + (integer :tag "number")) + :group 'elmo) + +(defcustom elmo-shimbun-index-range-alist nil + "*Alist of FOLDER and RANGE. +FOLDER is the shimbun folder name. +RANGE is the range of the header indices . +See `shimbun-headers' for more detail about RANGE." + :type '(repeat (cons (string :tag "Folder Name") + (choice (const :tag "all" all) + (const :tag "last" last) + (integer :tag "number")))) + :group 'elmo) + +;; Shimbun mua. +(eval-and-compile + (luna-define-class shimbun-elmo-mua (shimbun-mua) (folder)) + (luna-define-internal-accessors 'shimbun-elmo-mua)) + +(luna-define-method shimbun-mua-search-id ((mua shimbun-elmo-mua) id) + (elmo-msgdb-overview-get-entity id + (elmo-folder-msgdb + (shimbun-elmo-mua-folder-internal mua)))) + +(eval-and-compile + (luna-define-class elmo-shimbun-folder + (elmo-map-folder) (shimbun headers header-hash + group range last-check)) + (luna-define-internal-accessors 'elmo-shimbun-folder)) + +(defsubst elmo-shimbun-lapse-seconds (time) + (let ((now (current-time))) + (+ (* (- (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) + (> (elmo-shimbun-lapse-seconds + (elmo-shimbun-folder-last-check-internal folder)) + elmo-shimbun-check-interval)))) + +(defun elmo-shimbun-msgdb-to-headers (folder expire-days) + (let (headers) + (dolist (ov (elmo-msgdb-get-overview (elmo-folder-msgdb folder))) + (when (and (elmo-msgdb-overview-entity-get-extra-field ov "xref") + (if expire-days + (< (elmo-shimbun-lapse-seconds + (elmo-shimbun-parse-time-string + (elmo-msgdb-overview-entity-get-date ov))) + (* expire-days 86400 ; seconds per day + )) + t)) + (setq headers + (cons (shimbun-make-header + (elmo-msgdb-overview-entity-get-number ov) + (shimbun-mime-encode-string + (elmo-msgdb-overview-entity-get-subject ov)) + (shimbun-mime-encode-string + (elmo-msgdb-overview-entity-get-from ov)) + (elmo-msgdb-overview-entity-get-date ov) + (elmo-msgdb-overview-entity-get-id ov) + (elmo-msgdb-overview-entity-get-references ov) + 0 + 0 + (elmo-msgdb-overview-entity-get-extra-field ov "xref")) + headers)))) + (nreverse headers))) + +(defun elmo-shimbun-get-headers (folder) + (shimbun-open-group + (elmo-shimbun-folder-shimbun-internal folder) + (elmo-shimbun-folder-group-internal folder)) + (let* ((shimbun (elmo-shimbun-folder-shimbun-internal folder)) + (key (concat (shimbun-server-internal shimbun) + "." (shimbun-current-group-internal shimbun))) + (elmo-hash-minimum-size 0) + entry headers hash) + ;; new headers. + (setq headers + (delq nil + (mapcar + (lambda (x) + (unless (elmo-msgdb-overview-get-entity + (shimbun-header-id x) + (elmo-folder-msgdb folder)) + x)) + (shimbun-headers + (elmo-shimbun-folder-shimbun-internal folder) + (elmo-shimbun-folder-range-internal folder))))) + (elmo-shimbun-folder-set-headers-internal + folder + (nconc (elmo-shimbun-msgdb-to-headers + folder (shimbun-article-expiration-days + (elmo-shimbun-folder-shimbun-internal folder))) + headers)) + (setq hash + (elmo-shimbun-folder-set-header-hash-internal + folder + (elmo-make-hash + (length (elmo-shimbun-folder-headers-internal folder))))) + ;; Set up header hash. + (dolist (header (elmo-shimbun-folder-headers-internal folder)) + (elmo-set-hash-val + (shimbun-header-id header) header + (elmo-shimbun-folder-header-hash-internal folder))) + (elmo-shimbun-folder-set-last-check-internal folder (current-time)))) + +(luna-define-method elmo-folder-initialize ((folder + elmo-shimbun-folder) + name) + (let ((server-group (if (string-match "\\([^.]+\\)\\." name) + (list (elmo-match-string 1 name) + (substring name (match-end 0))) + (list name)))) + (when (nth 0 server-group) ; server + (elmo-shimbun-folder-set-shimbun-internal + folder + (shimbun-open (nth 0 server-group) + (luna-make-entity 'shimbun-elmo-mua :folder folder)))) + (when (nth 1 server-group) + (elmo-shimbun-folder-set-group-internal + folder + (nth 1 server-group))) + (elmo-shimbun-folder-set-range-internal + folder + (or (cdr (assoc (elmo-folder-name-internal folder) + elmo-shimbun-index-range-alist)) + elmo-shimbun-default-index-range)) + folder)) + +(luna-define-method elmo-folder-open-internal :before ((folder + elmo-shimbun-folder)) + (when (elmo-folder-plugged-p folder) + (if (elmo-shimbun-headers-check-p folder) + (elmo-shimbun-get-headers folder)))) + +(luna-define-method elmo-folder-reserve-status-p ((folder elmo-shimbun-folder)) + t) + +(luna-define-method elmo-folder-close-internal :after ((folder + elmo-shimbun-folder)) + (shimbun-close-group + (elmo-shimbun-folder-shimbun-internal folder)) + (elmo-shimbun-folder-set-headers-internal + folder nil) + (elmo-shimbun-folder-set-header-hash-internal + folder nil) + (elmo-shimbun-folder-set-last-check-internal + folder nil)) + +(luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder)) + (elmo-plugged-p + "shimbun" + (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder)) + nil nil + (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder)))) + +(luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder) + plugged &optional add) + (elmo-set-plugged plugged + "shimbun" + (shimbun-server-internal + (elmo-shimbun-folder-shimbun-internal folder)) + nil nil nil + (shimbun-server-internal + (elmo-shimbun-folder-shimbun-internal folder)) + add)) + +(luna-define-method elmo-folder-check :after ((folder elmo-shimbun-folder)) + (when (shimbun-current-group-internal + (elmo-shimbun-folder-shimbun-internal folder)) + (when (elmo-shimbun-headers-check-p folder) + ;; Discard current headers information. + (elmo-folder-close-internal folder) + (elmo-folder-open-internal folder)))) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder + elmo-shimbun-folder)) + (expand-file-name + (concat (shimbun-server-internal + (elmo-shimbun-folder-shimbun-internal folder)) + "/" + (elmo-shimbun-folder-group-internal folder)) + (expand-file-name "shimbun" elmo-msgdb-dir))) + +(defun elmo-shimbun-msgdb-create-entity (folder number) + (let ((header (elmo-get-hash-val + (elmo-map-message-location folder number) + (elmo-shimbun-folder-header-hash-internal folder))) + ov) + (when header + (with-temp-buffer + (shimbun-header-insert + (elmo-shimbun-folder-shimbun-internal folder) + header) + (setq ov (elmo-msgdb-create-overview-from-buffer number)) + (elmo-msgdb-overview-entity-set-extra + ov + (nconc + (elmo-msgdb-overview-entity-get-extra ov) + (list (cons "xref" (shimbun-header-xref header))))))))) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder) + numlist new-mark + already-mark seen-mark + important-mark + seen-list) + (let* (overview number-alist mark-alist entity + i percent num pair) + (setq num (length numlist)) + (setq i 0) + (message "Creating msgdb...") + (while numlist + (setq entity + (elmo-shimbun-msgdb-create-entity + folder (car numlist))) + (when entity + (setq overview + (elmo-msgdb-append-element + overview entity)) + (setq number-alist + (elmo-msgdb-number-add number-alist + (elmo-msgdb-overview-entity-get-number + entity) + (elmo-msgdb-overview-entity-get-id + entity))) + (setq mark-alist + (elmo-msgdb-mark-append + mark-alist + (elmo-msgdb-overview-entity-get-number + entity) + (or (elmo-msgdb-global-mark-get + (elmo-msgdb-overview-entity-get-id + entity)) + new-mark)))) + (when (> num elmo-display-progress-threshold) + (setq i (1+ i)) + (setq percent (/ (* i 100) num)) + (elmo-display-progress + 'elmo-folder-msgdb-create "Creating msgdb..." + percent)) + (setq numlist (cdr numlist))) + (message "Creating msgdb...done.") + (elmo-msgdb-sort-by-date + (list overview number-alist mark-alist)))) + +(luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder)) + nil) + +(luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder) + location strategy + &optional section unseen) + (shimbun-article (elmo-shimbun-folder-shimbun-internal folder) + (elmo-get-hash-val + location + (elmo-shimbun-folder-header-hash-internal folder)))) + +(luna-define-method elmo-folder-list-messages-internal :around + ((folder elmo-shimbun-folder) &optional nohide) + (if (elmo-folder-plugged-p folder) + (luna-call-next-method) + t)) + +(luna-define-method elmo-map-folder-list-message-locations + ((folder elmo-shimbun-folder)) + (mapcar + (function shimbun-header-id) + (elmo-shimbun-folder-headers-internal folder))) + +(luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder) + &optional one-level) + (unless (elmo-shimbun-folder-group-internal folder) + (mapcar + (lambda (x) + (concat (elmo-folder-prefix-internal folder) + (shimbun-server-internal + (elmo-shimbun-folder-shimbun-internal folder)) + "." + x)) + (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder))))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder)) + (if (elmo-shimbun-folder-group-internal folder) + (progn + (member + (elmo-shimbun-folder-group-internal folder) + (shimbun-groups (elmo-shimbun-folder-shimbun-internal + folder)))) + t)) + +(luna-define-method elmo-folder-search ((folder elmo-shimbun-folder) + condition &optional from-msgs) + nil) + +;;; To override elmo-map-folder methods. +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-shimbun-folder) unread-marks &optional mark-alist) + t) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder) + numbers) + t) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder) + numbers) + t) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder) + numbers) + t) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder) + numbers) + t) + +(require 'product) +(product-provide (provide 'elmo-shimbun) (require 'elmo-version)) + +;;; elmo-shimbun.el ends here \ No newline at end of file diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index e509e3d..f2b0e57 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -29,12 +29,15 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) (require 'elmo-vars) (require 'elmo-date) -(eval-when-compile (require 'cl)) +(require 'mcharset) +(require 'pces) (require 'std11) (require 'eword-decode) (require 'utf7) +(require 'poem) (defmacro elmo-set-buffer-multibyte (flag) "Set the multibyte flag of the current buffer to FLAG." @@ -72,19 +75,6 @@ (filename newname &optional ok-if-already-exists) (copy-file filename newname ok-if-already-exists t))) -(defsubst elmo-call-func (folder func-name &rest args) - (let* ((spec (if (stringp folder) - (elmo-folder-get-spec folder) - folder)) - (type (symbol-name (car spec))) - (backend-str (concat "elmo-" type)) - (backend-sym (intern backend-str))) - (unless (featurep backend-sym) - (require backend-sym)) - (apply (intern (format "%s-%s" backend-str func-name)) - spec - args))) - ;; Nemacs's `read' is different. (static-if (fboundp 'nemacs-version) (defun elmo-read (obj) @@ -101,31 +91,11 @@ (erase-buffer) (,@ body)))) -(defmacro elmo-match-substring (pos string from) - "Substring of POSth matched string of STRING." - (` (substring (, string) - (+ (match-beginning (, pos)) (, from)) - (match-end (, pos))))) - -(defmacro elmo-match-string (pos string) - "Substring POSth matched STRING." - (` (substring (, string) (match-beginning (, pos)) (match-end (, pos))))) - -(defmacro elmo-match-buffer (pos) - "Substring POSth matched from the current buffer." - (` (buffer-substring-no-properties - (match-beginning (, pos)) (match-end (, pos))))) - (defmacro elmo-bind-directory (dir &rest body) "Set current directory DIR and execute BODY." (` (let ((default-directory (file-name-as-directory (, dir)))) (,@ body)))) -(defmacro elmo-folder-get-type (folder) - "Get type of FOLDER." - (` (and (stringp (, folder)) - (cdr (assoc (string-to-char (, folder)) elmo-spec-alist))))) - (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." @@ -172,16 +142,6 @@ File content is encoded with MIME-CHARSET." ;;;(princ "\n" (current-buffer)) (elmo-save-buffer filename mime-charset))) -(defsubst elmo-imap4-decode-folder-string (string) - (if elmo-imap4-use-modified-utf7 - (utf7-decode-string string 'imap) - string)) - -(defsubst elmo-imap4-encode-folder-string (string) - (if elmo-imap4-use-modified-utf7 - (utf7-encode-string string 'imap) - string)) - (defun elmo-get-network-stream-type (stream-type stream-type-alist) (catch 'found (while stream-type-alist @@ -189,306 +149,6 @@ File content is encoded with MIME-CHARSET." (throw 'found (car stream-type-alist))) (setq stream-type-alist (cdr stream-type-alist))))) -(defun elmo-network-get-spec (folder server port stream-type stream-type-alist) - (setq stream-type (elmo-get-network-stream-type - stream-type stream-type-alist)) - (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" folder) - (if (match-beginning 1) - (setq server (elmo-match-substring 1 folder 1))) - (if (match-beginning 2) - (setq port (string-to-int (elmo-match-substring 2 folder 1)))) - (if (match-beginning 3) - (setq stream-type (assoc (elmo-match-string 3 folder) - stream-type-alist))) - (setq folder (substring folder 0 (match-beginning 0)))) - (cons folder (list server port stream-type))) - -(defun elmo-imap4-get-spec (folder) - (let ((default-user elmo-default-imap4-user) - (default-server elmo-default-imap4-server) - (default-port elmo-default-imap4-port) - (default-stream-type elmo-default-imap4-stream-type) - (stream-type-alist elmo-network-stream-type-alist) - spec mailbox user auth) - (when (string-match "\\(.*\\)@\\(.*\\)" default-server) - ;; case: default-imap4-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))) - (if elmo-imap4-stream-type-alist - (setq stream-type-alist - (append elmo-imap4-stream-type-alist stream-type-alist))) - (setq spec (elmo-network-get-spec - folder default-server default-port default-stream-type - stream-type-alist)) - (setq folder (car spec)) - (when (string-match - "^\\(%\\)\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?" - folder) - (progn - (setq mailbox (if (match-beginning 2) - (elmo-match-string 2 folder) - elmo-default-imap4-mailbox)) - (setq user (if (match-beginning 3) - (elmo-match-substring 3 folder 1) - default-user)) - (setq auth (if (match-beginning 4) - (intern (elmo-match-substring 4 folder 1)) - elmo-default-imap4-authenticate-type)) - (setq auth (or auth 'clear)) - (append (list 'imap4 - (elmo-imap4-encode-folder-string mailbox) - user auth) - (cdr spec)))))) - -(defsubst elmo-imap4-spec-mailbox (spec) - (nth 1 spec)) - -(defsubst elmo-imap4-spec-username (spec) - (nth 2 spec)) - -(defsubst elmo-imap4-spec-auth (spec) - (nth 3 spec)) - -(defsubst elmo-imap4-spec-hostname (spec) - (nth 4 spec)) - -(defsubst elmo-imap4-spec-port (spec) - (nth 5 spec)) - -(defsubst elmo-imap4-spec-stream-type (spec) - (nth 6 spec)) - -(defalias 'elmo-imap4-spec-folder 'elmo-imap4-spec-mailbox) -(make-obsolete 'elmo-imap4-spec-folder 'elmo-imap4-spec-mailbox) - -(defsubst elmo-imap4-connection-get-process (conn) - (nth 1 conn)) - -(defsubst elmo-imap4-connection-get-buffer (conn) - (nth 0 conn)) - -(defsubst elmo-imap4-connection-get-cwf (conn) - (nth 2 conn)) - -(defun elmo-nntp-get-spec (folder) - (let ((stream-type-alist elmo-network-stream-type-alist) - spec group user) - (if elmo-nntp-stream-type-alist - (setq stream-type-alist - (append elmo-nntp-stream-type-alist stream-type-alist))) - (setq spec (elmo-network-get-spec folder - elmo-default-nntp-server - elmo-default-nntp-port - elmo-default-nntp-stream-type - stream-type-alist)) - (setq folder (car spec)) - (when (string-match - "^\\(-\\)\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?" - folder) - (setq group - (if (match-beginning 2) - (elmo-match-string 2 folder))) - (setq user - (if (match-beginning 3) - (elmo-match-substring 3 folder 1) - elmo-default-nntp-user)) - (append (list 'nntp group user) - (cdr spec))))) - -(defsubst elmo-nntp-spec-group (spec) - (nth 1 spec)) - -(defsubst elmo-nntp-spec-username (spec) - (nth 2 spec)) - -;; future use? -;; (defsubst elmo-nntp-spec-auth (spec)) - -(defsubst elmo-nntp-spec-hostname (spec) - (nth 3 spec)) - -(defsubst elmo-nntp-spec-port (spec) - (nth 4 spec)) - -(defsubst elmo-nntp-spec-stream-type (spec) - (nth 5 spec)) - -(defun elmo-localdir-get-spec (folder) - (let (fld-name path) - (when (string-match - "^\\(\\+\\)\\(.*\\)$" - folder) - (if (eq (length (setq fld-name - (elmo-match-string 2 folder))) 0) - (setq fld-name "") - ) - (if (file-name-absolute-p fld-name) - (setq path (expand-file-name fld-name)) -;;; (setq path (expand-file-name fld-name -;;; elmo-localdir-folder-path)) - (setq path fld-name)) - (list (if (elmo-folder-maildir-p folder) - 'maildir - 'localdir) path)))) - -(defun elmo-maildir-get-spec (folder) - (let (fld-name path) - (when (string-match - "^\\(\\.\\)\\(.*\\)$" - folder) - (if (eq (length (setq fld-name - (elmo-match-string 2 folder))) 0) - (setq fld-name "")) - (if (file-name-absolute-p fld-name) - (setq path (expand-file-name fld-name)) - (setq path fld-name)) - (list 'maildir path)))) - -(defun elmo-folder-maildir-p (folder) - (catch 'found - (let ((li elmo-maildir-list)) - (while li - (if (string-match (car li) folder) - (throw 'found t)) - (setq li (cdr li)))))) - -(defun elmo-localnews-get-spec (folder) - (let (fld-name) - (when (string-match - "^\\(=\\)\\(.*\\)$" - folder) - (if (eq (length (setq fld-name - (elmo-match-string 2 folder))) 0) - (setq fld-name "") - ) - (list 'localnews - (elmo-replace-in-string fld-name "\\." "/"))))) - -(defun elmo-cache-get-spec (folder) - (let (fld-name) - (when (string-match - "^\\(!\\)\\(.*\\)$" - folder) - (if (eq (length (setq fld-name - (elmo-match-string 2 folder))) 0) - (setq fld-name "") - ) - (list 'cache - (elmo-replace-in-string fld-name "\\." "/"))))) - -;; Archive interface by OKUNISHI Fujikazu -(defun elmo-archive-get-spec (folder) - (require 'elmo-archive) - (let (fld-name type prefix) - (when (string-match - "^\\(\\$\\)\\([^;]*\\);?\\([^;]*\\);?\\([^;]*\\)$" - folder) - ;; Drive letter is OK! - (if (eq (length (setq fld-name - (elmo-match-string 2 folder))) 0) - (setq fld-name "") - ) - (if (eq (length (setq type - (elmo-match-string 3 folder))) 0) - (setq type (symbol-name elmo-archive-default-type))) - (if (eq (length (setq prefix - (elmo-match-string 4 folder))) 0) - (setq prefix "")) - (list 'archive fld-name (intern-soft type) prefix)))) - -(defun elmo-pop3-get-spec (folder) - (let ((stream-type-alist elmo-network-stream-type-alist) - spec user auth) - (if elmo-pop3-stream-type-alist - (setq stream-type-alist - (append elmo-pop3-stream-type-alist stream-type-alist))) - (setq spec (elmo-network-get-spec folder - elmo-default-pop3-server - elmo-default-pop3-port - elmo-default-pop3-stream-type - stream-type-alist)) - (setq folder (car spec)) - (when (string-match - "^\\(&\\)\\([^:/!]*\\)\\(/[^/:@!]+\\)?" - folder) - (setq user (if (match-beginning 2) - (elmo-match-string 2 folder))) - (if (eq (length user) 0) - (setq user elmo-default-pop3-user)) - (setq auth (if (match-beginning 3) - (intern (elmo-match-substring 3 folder 1)) - elmo-default-pop3-authenticate-type)) - (setq auth (or auth 'user)) - (append (list 'pop3 user auth) - (cdr spec))))) - -(defsubst elmo-pop3-spec-username (spec) - (nth 1 spec)) - -(defsubst elmo-pop3-spec-auth (spec) - (nth 2 spec)) - -(defsubst elmo-pop3-spec-hostname (spec) - (nth 3 spec)) - -(defsubst elmo-pop3-spec-port (spec) - (nth 4 spec)) - -(defsubst elmo-pop3-spec-stream-type (spec) - (nth 5 spec)) - -(defun elmo-internal-get-spec (folder) - (if (string-match "\\('\\)\\([^/]*\\)/?\\(.*\\)$" folder) - (let* ((item (downcase (elmo-match-string 2 folder))) - (sym (and (> (length item) 0) (intern item)))) - (cond ((or (null sym) - (eq sym 'mark)) - (list 'internal sym (elmo-match-string 3 folder))) - ((eq sym 'cache) - (list 'cache (elmo-match-string 3 folder))) - (t (error "Invalid internal folder spec")))))) - -(defun elmo-multi-get-spec (folder) - (save-match-data - (when (string-match - "^\\(\\*\\)\\(.*\\)$" - folder) - (append (list 'multi) - (split-string - (elmo-match-string 2 folder) - ","))))) - -(defun elmo-filter-get-spec (folder) - (when (string-match "^\\(/\\)\\(.*\\)$" folder) - (let ((folder (elmo-match-string 2 folder)) - pair) - (setq pair (elmo-parse-search-condition folder)) - (if (string-match "^ */\\(.*\\)$" (cdr pair)) - (list 'filter (car pair) (elmo-match-string 1 (cdr pair))) - (error "Folder syntax error `%s'" folder))))) - -(defun elmo-pipe-get-spec (folder) - (when (string-match "^\\(|\\)\\([^|]*\\)|\\(.*\\)$" folder) - (list 'pipe - (elmo-match-string 2 folder) - (elmo-match-string 3 folder)))) - -(defsubst elmo-pipe-spec-src (spec) - (nth 1 spec)) - -(defsubst elmo-pipe-spec-dst (spec) - (nth 2 spec)) - -(defun elmo-folder-get-spec (folder) - "Return spec of FOLDER." - (let ((type (elmo-folder-get-type folder))) - (if type - (save-match-data - (funcall (intern (concat "elmo-" (symbol-name type) "-get-spec")) - folder)) - (error "%s is not supported folder type" folder)))) - ;;; Search Condition (defconst elmo-condition-atom-regexp "[^/ \")|&]*") @@ -630,13 +290,6 @@ Return value is a cons cell of (STRUCTURE . REST)" (t (error "Syntax error '%s'" (buffer-string))))) ;;; -(defun elmo-multi-get-real-folder-number (folder number) - (let* ((spec (elmo-folder-get-spec folder)) - (flds (cdr spec)) - (num number) - (fld (nth (- (/ num elmo-multi-divide-number) 1) flds))) - (cons fld (% num elmo-multi-divide-number)))) - (defsubst elmo-buffer-replace (regexp &optional newtext) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -654,6 +307,13 @@ Return value is a cons cell of (STRUCTURE . REST)" (replace-match "")) (buffer-string))))) +(defsubst elmo-delete-cr-buffer () + "Delete CR from buffer." + (save-excursion + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n")) )) + (defsubst elmo-delete-cr-get-content-type () (save-excursion (goto-char (point-min)) @@ -868,49 +528,6 @@ Return value is a cons cell of (STRUCTURE . REST)" (message "") ans))) -;; from subr.el -(defun elmo-replace-in-string (str regexp newtext &optional literal) - "Replace all matches in STR for REGEXP with NEWTEXT string. -And returns the new string. -Optional LITERAL non-nil means do a literal replacement. -Otherwise treat \\ in NEWTEXT string as special: - \\& means substitute original matched text, - \\N means substitute match for \(...\) number N, - \\\\ means insert one \\." - (let ((rtn-str "") - (start 0) - (special) - match prev-start) - (while (setq match (string-match regexp str start)) - (setq prev-start start - start (match-end 0) - rtn-str - (concat - rtn-str - (substring str prev-start match) - (cond (literal newtext) - (t (mapconcat - (function - (lambda (c) - (if special - (progn - (setq special nil) - (cond ((eq c ?\\) "\\") - ((eq c ?&) - (elmo-match-string 0 str)) - ((and (>= c ?0) (<= c ?9)) - (if (> c (+ ?0 (length - (match-data)))) - ;; Invalid match num - (error "Invalid match num: %c" c) - (setq c (- c ?0)) - (elmo-match-string c str))) - (t (char-to-string c)))) - (if (eq c ?\\) (progn (setq special t) nil) - (char-to-string c))))) - newtext "")))))) - (concat rtn-str (substring str start)))) - (defun elmo-string-to-list (string) (elmo-set-work-buf (insert string) @@ -964,23 +581,27 @@ Otherwise treat \\ in NEWTEXT string as special: (setq alist (cdr alist))) (elmo-plug-on-by-servers alist other-servers))) -(defun elmo-plugged-p (&optional server port alist label-exp) +(defun elmo-plugged-p (&optional server port stream-type alist label-exp) (let ((alist (or alist elmo-plugged-alist)) plugged-info) (cond ((and (not port) (not server)) (cond ((eq elmo-plugged-condition 'one) - (catch 'plugged - (while alist - (if (nth 2 (car alist)) - (throw 'plugged t)) - (setq alist (cdr alist))))) + (if alist + (catch 'plugged + (while alist + (if (nth 2 (car alist)) + (throw 'plugged t)) + (setq alist (cdr alist)))) + elmo-plugged)) ((eq elmo-plugged-condition 'all) - (catch 'plugged - (while alist - (if (not (nth 2 (car alist))) - (throw 'plugged nil)) - (setq alist (cdr alist))) - t)) + (if alist + (catch 'plugged + (while alist + (if (not (nth 2 (car alist))) + (throw 'plugged nil)) + (setq alist (cdr alist))) + t) + elmo-plugged)) ((functionp elmo-plugged-condition) (funcall elmo-plugged-condition alist)) (t ;; independent @@ -993,11 +614,12 @@ Otherwise treat \\ in NEWTEXT string as special: (throw 'plugged t))) (setq alist (cdr alist))))) (t - (setq plugged-info (assoc (cons server port) alist)) + (setq plugged-info (assoc (list server port stream-type) alist)) (if (not plugged-info) ;; add elmo-plugged-alist automatically (progn - (elmo-set-plugged elmo-plugged server port nil nil label-exp) + (elmo-set-plugged elmo-plugged server port stream-type + nil nil nil label-exp) elmo-plugged) (if (and elmo-auto-change-plugged (> elmo-auto-change-plugged 0) @@ -1007,7 +629,7 @@ Otherwise treat \\ in NEWTEXT string as special: t (nth 2 plugged-info))))))) -(defun elmo-set-plugged (plugged &optional server port time +(defun elmo-set-plugged (plugged &optional server port stream-type time alist label-exp add) (let ((alist (or alist elmo-plugged-alist)) label plugged-info) @@ -1025,7 +647,7 @@ Otherwise treat \\ in NEWTEXT string as special: (setq alist (cdr alist)))) (t ;; set plugged one port of server - (setq plugged-info (assoc (cons server port) alist)) + (setq plugged-info (assoc (list server port stream-type) alist)) (setq label (if label-exp (eval label-exp) (nth 1 plugged-info))) @@ -1035,9 +657,11 @@ Otherwise treat \\ in NEWTEXT string as special: (setcdr plugged-info (list label plugged time))) (setq alist (setq elmo-plugged-alist - (nconc elmo-plugged-alist - (list - (list (cons server port) label plugged time)))))))) + (nconc + elmo-plugged-alist + (list + (list (list server port stream-type) + label plugged time)))))))) alist)) (defun elmo-delete-plugged (&optional server port alist) @@ -1105,6 +729,7 @@ Otherwise treat \\ in NEWTEXT string as special: (defun elmo-delete-directory (path &optional no-hierarchy) "Delete directory recursively." + (if (stringp path) ; nil is not permitted. (let ((dirent (directory-files path)) relpath abspath hierarchy) (while dirent @@ -1118,7 +743,7 @@ Otherwise treat \\ in NEWTEXT string as special: (elmo-delete-directory abspath no-hierarchy)) (delete-file abspath)))) (unless hierarchy - (delete-directory path)))) + (delete-directory path))))) (defun elmo-list-filter (l1 l2) "L1 is filter." @@ -1130,42 +755,6 @@ Otherwise treat \\ in NEWTEXT string as special: ;; filter is nil l2))) -(defun elmo-folder-local-p (folder) - "Return whether FOLDER is a local folder or not." - (let ((spec (elmo-folder-get-spec folder))) - (case (car spec) - (filter (elmo-folder-local-p (nth 2 spec))) - (pipe (elmo-folder-local-p (elmo-pipe-spec-dst spec))) - (t (memq (car spec) - '(localdir localnews archive maildir internal cache)))))) - -(defun elmo-folder-writable-p (folder) - (let ((type (elmo-folder-get-type folder))) - (memq type '(imap4 localdir archive)))) - -(defun elmo-multi-get-intlist-list (numlist &optional as-is) - (let ((numbers (sort numlist '<)) - (cur-number 0) - one-list int-list-list) - (while numbers - (setq cur-number (+ cur-number 1)) - (setq one-list nil) - (while (and numbers - (eq 0 - (/ (- (car numbers) - (* elmo-multi-divide-number cur-number)) - elmo-multi-divide-number))) - (setq one-list (nconc - one-list - (list - (if as-is - (car numbers) - (% (car numbers) - (* elmo-multi-divide-number cur-number)))))) - (setq numbers (cdr numbers))) - (setq int-list-list (nconc int-list-list (list one-list)))) - int-list-list)) - (defsubst elmo-list-delete-if-smaller (list number) (let ((ret-val (copy-sequence list))) (while list @@ -1217,68 +806,6 @@ Otherwise treat \\ in NEWTEXT string as special: (setq l1 (cdr l1))) (cons diff1 (list l2))))) -(defun elmo-multi-list-bigger-diff (list1 list2 &optional mes) - (let ((list1-list (elmo-multi-get-intlist-list list1 t)) - (list2-list (elmo-multi-get-intlist-list list2 t)) - result - dels news) - (while (or list1-list list2-list) - (setq result (elmo-list-bigger-diff (car list1-list) (car list2-list) - mes)) - (setq dels (append dels (car result))) - (setq news (append news (cadr result))) - (setq list1-list (cdr list1-list)) - (setq list2-list (cdr list2-list))) - (cons dels (list news)))) - -(defvar elmo-imap4-name-space-regexp-list nil) -(defun elmo-imap4-identical-name-space-p (fld1 fld2) - ;; only on UW? - (if (or (eq (string-to-char fld1) ?#) - (eq (string-to-char fld2) ?#)) - (string= (car (split-string fld1 "/")) - (car (split-string fld2 "/"))) - t)) - -(defun elmo-folder-identical-system-p (folder1 folder2) - "FOLDER1 and FOLDER2 should be real folder (not virtual)." - (cond ((eq (elmo-folder-get-type folder1) 'imap4) - (let ((spec1 (elmo-folder-get-spec folder1)) - (spec2 (elmo-folder-get-spec folder2))) - (and -;;; No use. -;;; (elmo-imap4-identical-name-space-p -;;; (nth 1 spec1) (nth 1 spec2)) - (string= (elmo-imap4-spec-hostname spec1) - (elmo-imap4-spec-hostname spec2)) ; hostname - (string= (elmo-imap4-spec-username spec1) - (elmo-imap4-spec-username spec2))))) ; username - (t - (elmo-folder-direct-copy-p folder1 folder2)))) - -(defun elmo-folder-get-store-type (folder) - (let ((spec (elmo-folder-get-spec folder))) - (case (car spec) - (filter (elmo-folder-get-store-type (nth 2 spec))) - (pipe (elmo-folder-get-store-type (elmo-pipe-spec-dst spec))) - (multi (elmo-folder-get-store-type (nth 1 spec))) - (t (car spec))))) - -(defconst elmo-folder-direct-copy-alist - '((localdir . (localdir localnews archive)) - (maildir . (maildir localdir localnews archive)) - (localnews . (localdir localnews archive)) - (archive . (localdir localnews archive)) - (cache . (localdir localnews archive)))) - -(defun elmo-folder-direct-copy-p (src-folder dst-folder) - (let ((src-type (elmo-folder-get-store-type src-folder)) - (dst-type (elmo-folder-get-store-type dst-folder)) - dst-copy-type) - (and (setq dst-copy-type - (cdr (assq src-type elmo-folder-direct-copy-alist))) - (memq dst-type dst-copy-type)))) - (defmacro elmo-filter-type (filter) (` (aref (, filter) 0))) @@ -1431,11 +958,23 @@ Emacs 19.28 or earlier does not have `unintern'." (static-if (fboundp 'unintern) (list 'unintern string))) -;; Make a hash table (default and minimum size is 1024). (defun elmo-make-hash (&optional hashsize) + "Make a new hash table which have HASHSIZE size." (make-vector - (if hashsize (max (min (elmo-create-hash-size hashsize) - elmo-hash-maximum-size) 1024) 1024) 0)) + (if hashsize + (max + ;; Prime numbers as lengths tend to result in good + ;; hashing; lengths one less than a power of two are + ;; also good. + (min + (let ((i 1)) + (while (< (- i 1) hashsize) + (setq i (* 2 i))) + (- i 1)) + elmo-hash-maximum-size) + elmo-hash-minimum-size) + elmo-hash-minimum-size) + 0)) (defsubst elmo-mime-string (string) "Normalize MIME encoded STRING." @@ -1484,12 +1023,6 @@ Emacs 19.28 or earlier does not have `unintern'." (setq dest (cons (cons name body) dest)))) dest))) -(defun elmo-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (setq i (* 2 i))) - i)) - (defun elmo-safe-filename (folder) (elmo-replace-in-string (elmo-replace-in-string @@ -1497,28 +1030,28 @@ Emacs 19.28 or earlier does not have `unintern'." ":" "__") "|" "_or_")) -(defvar elmo-msgid-replace-chars nil) +(defvar elmo-filename-replace-chars nil) -(defsubst elmo-replace-msgid-as-filename (msgid) - "Replace Message-ID string (MSGID) as filename." +(defsubst elmo-replace-string-as-filename (msgid) + "Replace string as filename." (setq msgid (elmo-replace-in-string msgid " " " ")) - (if (null elmo-msgid-replace-chars) - (setq elmo-msgid-replace-chars + (if (null elmo-filename-replace-chars) + (setq elmo-filename-replace-chars (regexp-quote (mapconcat - 'car elmo-msgid-replace-string-alist "")))) - (while (string-match (concat "[" elmo-msgid-replace-chars "]") + 'car elmo-filename-replace-string-alist "")))) + (while (string-match (concat "[" elmo-filename-replace-chars "]") msgid) (setq msgid (concat (substring msgid 0 (match-beginning 0)) (cdr (assoc (substring msgid (match-beginning 0) (match-end 0)) - elmo-msgid-replace-string-alist)) + elmo-filename-replace-string-alist)) (substring msgid (match-end 0))))) msgid) -(defsubst elmo-recover-msgid-from-filename (filename) - "Recover Message-ID from FILENAME." +(defsubst elmo-recover-string-from-filename (filename) + "Recover string from FILENAME." (let (tmp result) (while (string-match " " filename) (setq tmp (substring filename @@ -1527,7 +1060,7 @@ Emacs 19.28 or earlier does not have `unintern'." (if (string= tmp " ") (setq tmp " ") (setq tmp (car (rassoc tmp - elmo-msgid-replace-string-alist)))) + elmo-filename-replace-string-alist)))) (setq result (concat result (substring filename 0 (match-beginning 0)) @@ -1809,6 +1342,447 @@ NUMBER-SET is altered." (setq number-set-1 (nconc number-set-1 (list number)))) number-set-1)) +(defun elmo-number-set-to-number-list (number-set) + "Return a number list which corresponds to NUMBER-SET." + (let (number-list elem i) + (while number-set + (setq elem (car number-set)) + (cond + ((consp elem) + (setq i (car elem)) + (while (<= i (cdr elem)) + (setq number-list (cons i number-list)) + (incf i))) + ((integerp elem) + (setq number-list (cons elem number-list)))) + (setq number-set (cdr number-set))) + (nreverse number-list))) + +(defcustom elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|[0-9]+\\)$" + "*Regexp to filter subfolders." + :type 'regexp + :group 'elmo) + +(defun elmo-list-subdirectories-1 (basedir curdir one-level) + (let ((root (zerop (length curdir))) + (w32-get-true-file-link-count t) ; for Meadow + attr dirs dir) + (catch 'done + (dolist (file (directory-files (setq dir (expand-file-name curdir basedir)))) + (when (and (not (string-match + elmo-list-subdirectories-ignore-regexp + file)) + (car (setq attr (file-attributes + (expand-file-name file dir))))) + (when (eq one-level 'check) (throw 'done t)) + (let ((relpath + (concat curdir (and (not root) elmo-path-sep) file)) + subdirs) + (setq dirs (nconc dirs + (if (if elmo-have-link-count (< 2 (nth 1 attr)) + (setq subdirs + (elmo-list-subdirectories-1 + basedir + relpath + (if one-level 'check)))) + (if one-level + (list (list relpath)) + (cons relpath + (or subdirs + (elmo-list-subdirectories-1 + basedir + relpath + nil)))) + (list relpath))))))) + dirs))) + +(defun elmo-list-subdirectories (directory file one-level) + (let ((subdirs (elmo-list-subdirectories-1 directory file one-level))) + (if (zerop (length file)) + subdirs + (cons file subdirs)))) + +(defun elmo-mapcar-list-of-list (func list-of-list) + (mapcar + (lambda (x) + (cond ((listp x) (elmo-mapcar-list-of-list func x)) + (t (funcall func x)))) + list-of-list)) + +(defun elmo-parse (string regexp &optional matchn) + (or matchn (setq matchn 1)) + (let (list) + (store-match-data nil) + (while (string-match regexp string (match-end 0)) + (setq list (cons (substring string (match-beginning matchn) + (match-end matchn)) list))) + (nreverse list))) + +;;; File cache. +(defmacro elmo-make-file-cache (path status) + "PATH is the cache file name. +STATUS is one of 'section, 'entire or nil. + nil means no cache exists. +'section means partial section cache exists. +'entire means entire cache exists. +If the cache is partial file-cache, TYPE is 'partial." + (` (cons (, path) (, status)))) + +(defmacro elmo-file-cache-path (file-cache) + "Returns the file path of the FILE-CACHE." + (` (car (, file-cache)))) + +(defmacro elmo-file-cache-status (file-cache) + "Returns the status of the FILE-CACHE." + (` (cdr (, file-cache)))) + +(defsubst elmo-cache-to-msgid (filename) + (concat "<" (elmo-recover-string-from-filename filename) ">")) + +(defsubst elmo-cache-get-path-subr (msgid) + (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F)) + (clist (string-to-char-list msgid)) + (sum 0)) + (while clist + (setq sum (+ sum (car clist))) + (setq clist (cdr clist))) + (format "%c%c" + (nth (% (/ sum 16) 2) chars) + (nth (% sum 16) chars)))) + +(defun elmo-file-cache-get-path (msgid &optional section) + "Get cache path for MSGID. +If optional argument SECTION is specified, partial cache path is returned." + (if (setq msgid (elmo-msgid-to-cache msgid)) + (expand-file-name + (if section + (format "%s/%s/%s/%s/%s" + elmo-msgdb-dir + elmo-cache-dirname + (elmo-cache-get-path-subr msgid) + msgid + section) + (format "%s/%s/%s/%s" + elmo-msgdb-dir + elmo-cache-dirname + (elmo-cache-get-path-subr msgid) + msgid))))) + +(defmacro elmo-file-cache-expand-path (path section) + "Return file name for the file-cache corresponds to the section. +PATH is the file-cache path. +SECTION is the section string." + (` (expand-file-name (or (, section) "") (, path)))) + +(defun elmo-file-cache-delete (path) + "Delete a cache on PATH." + (let (files) + (when (file-exists-p path) + (if (file-directory-p path) + (progn + (setq files (directory-files path t "^[^\\.]")) + (while files + (delete-file (car files)) + (setq files (cdr files))) + (delete-directory path)) + (delete-file path))))) + +(defun elmo-file-cache-exists-p (msgid) + "Returns 'section or 'entire if a cache which corresponds to MSGID exists." + (elmo-file-cache-status (elmo-file-cache-get msgid))) + +(defun elmo-file-cache-save (cache-path section) + "Save current buffer as cache on PATH. +Return t if cache is saved successfully." + (condition-case nil + (let ((path (if section (expand-file-name section cache-path) + cache-path)) + files dir) + (if (and (null section) + (file-directory-p path)) + (progn + (setq files (directory-files path t "^[^\\.]")) + (while files + (delete-file (car files)) + (setq files (cdr files))) + (delete-directory path)) + (if (and section + (not (file-directory-p cache-path))) + (delete-file cache-path))) + (when path + (setq dir (directory-file-name (file-name-directory path))) + (if (not (file-exists-p dir)) + (elmo-make-directory dir)) + (write-region-as-binary (point-min) (point-max) + path nil 'no-msg) + t)) + ;; ignore error + (error))) + +(defun elmo-cache-path-section-p (path) + "Return non-nil when PATH is `section' cache path." + (file-directory-p path)) + +(defun elmo-file-cache-get (msgid &optional section) + "Returns the current file-cache object associated with MSGID. +MSGID is the message-id of the message. +If optional argument SECTION is specified, get partial file-cache object +associated with SECTION." + (if msgid + (let ((path (elmo-cache-get-path msgid))) + (if (and path (file-exists-p path)) + (if (elmo-cache-path-section-p path) + (if section + (if (file-exists-p (setq path (expand-file-name + section path))) + (cons path 'section)) + ;; section is not specified but sectional. + (cons path 'section)) + ;; not directory. + (unless section + (cons path 'entire))) + ;; no cache. + (cons path nil))))) + +;;; +;; Expire cache. + +(defun elmo-cache-expire () + (interactive) + (let* ((completion-ignore-case t) + (method (completing-read (format "Expire by (%s): " + elmo-cache-expire-default-method) + '(("size" . "size") + ("age" . "age"))))) + (if (string= method "") + (setq method elmo-cache-expire-default-method)) + (funcall (intern (concat "elmo-cache-expire-by-" method))))) + +(defun elmo-read-float-value-from-minibuffer (prompt &optional initial) + (let ((str (read-from-minibuffer prompt initial))) + (cond + ((string-match "[0-9]*\\.[0-9]+" str) + (string-to-number str)) + ((string-match "[0-9]+" str) + (string-to-number (concat str ".0"))) + (t (error "%s is not number" str))))) + +(defun elmo-cache-expire-by-size (&optional kbytes) + "Expire cache file by size. +If KBYTES is kilo bytes (This value must be float)." + (interactive) + (let ((size (or kbytes + (and (interactive-p) + (elmo-read-float-value-from-minibuffer + "Enter cache disk size (Kbytes): " + (number-to-string + (if (integerp elmo-cache-expire-default-size) + (float elmo-cache-expire-default-size) + elmo-cache-expire-default-size)))) + (if (integerp elmo-cache-expire-default-size) + (float elmo-cache-expire-default-size)))) + (count 0) + (Kbytes 1024) + total beginning) + (message "Checking disk usage...") + (setq total (/ (elmo-disk-usage + (expand-file-name + elmo-cache-dirname elmo-msgdb-dir)) Kbytes)) + (setq beginning total) + (message "Checking disk usage...done") + (let ((cfl (elmo-cache-get-sorted-cache-file-list)) + (deleted 0) + oldest + cur-size cur-file) + (while (and (<= size total) + (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl))) + (setq cur-file (expand-file-name (car (cdr oldest)) (car oldest))) + (setq cur-size (/ (elmo-disk-usage cur-file) Kbytes)) + (when (elmo-file-cache-delete cur-file) + (setq count (+ count 1)) + (message "%d cache(s) are expired." count)) + (setq deleted (+ deleted cur-size)) + (setq total (- total cur-size))) + (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)." + count deleted beginning)))) + +(defun elmo-cache-make-file-entity (filename path) + (cons filename (elmo-get-last-accessed-time filename path))) + +(defun elmo-cache-get-oldest-cache-file-entity (cache-file-list) + (let ((cfl cache-file-list) + flist firsts oldest-entity wonlist) + (while cfl + (setq flist (cdr (car cfl))) + (setq firsts (append firsts (list + (cons (car (car cfl)) + (car flist))))) + (setq cfl (cdr cfl))) +;;; (prin1 firsts) + (while firsts + (if (and (not oldest-entity) + (cdr (cdr (car firsts)))) + (setq oldest-entity (car firsts))) + (if (and (cdr (cdr (car firsts))) + (cdr (cdr oldest-entity)) + (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts))))) + (setq oldest-entity (car firsts))) + (setq firsts (cdr firsts))) + (setq wonlist (assoc (car oldest-entity) cache-file-list)) + (and wonlist + (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist)))) + oldest-entity)) + +(defun elmo-cache-get-sorted-cache-file-list () + (let ((dirs (directory-files + (expand-file-name elmo-cache-dirname elmo-msgdb-dir) + t "^[^\\.]")) + (i 0) num + elist + ret-val) + (setq num (length dirs)) + (message "Collecting cache info...") + (while dirs + (setq elist (mapcar (lambda (x) + (elmo-cache-make-file-entity x (car dirs))) + (directory-files (car dirs) nil "^[^\\.]"))) + (setq ret-val (append ret-val + (list (cons + (car dirs) + (sort + elist + (lambda (x y) + (< (cdr x) + (cdr y)))))))) + (when (> num elmo-display-progress-threshold) + (setq i (+ i 1)) + (elmo-display-progress + 'elmo-cache-get-sorted-cache-file-list "Collecting cache info..." + (/ (* i 100) num))) + (setq dirs (cdr dirs))) + (message "Collecting cache info...done") + ret-val)) + +(defun elmo-cache-expire-by-age (&optional days) + (let ((age (or (and days (int-to-string days)) + (and (interactive-p) + (read-from-minibuffer + (format "Enter days (%s): " + elmo-cache-expire-default-age))) + (int-to-string elmo-cache-expire-default-age))) + (dirs (directory-files + (expand-file-name elmo-cache-dirname elmo-msgdb-dir) + t "^[^\\.]")) + (count 0) + curtime) + (if (string= age "") + (setq age elmo-cache-expire-default-age) + (setq age (string-to-int age))) + (setq curtime (current-time)) + (setq curtime (+ (* (nth 0 curtime) + (float 65536)) (nth 1 curtime))) + (while dirs + (let ((files (directory-files (car dirs) t "^[^\\.]")) + (limit-age (* age 86400))) + (while files + (when (> (- curtime (elmo-get-last-accessed-time (car files))) + limit-age) + (when (elmo-file-cache-delete (car files)) + (setq count (+ 1 count)) + (message "%d cache file(s) are expired." count))) + (setq files (cdr files)))) + (setq dirs (cdr dirs))))) + +;;; +;; msgid to path. +(defun elmo-msgid-to-cache (msgid) + (when (and msgid + (string-match "<\\(.+\\)>$" msgid)) + (elmo-replace-string-as-filename (elmo-match-string 1 msgid)))) + +(defun elmo-cache-get-path (msgid &optional folder number) + "Get path for cache file associated with MSGID, FOLDER, and NUMBER." + (if (setq msgid (elmo-msgid-to-cache msgid)) + (expand-file-name + (expand-file-name + (if folder + (format "%s/%s/%s@%s" + (elmo-cache-get-path-subr msgid) + msgid + (or number "") + (elmo-safe-filename folder)) + (format "%s/%s" + (elmo-cache-get-path-subr msgid) + msgid)) + (expand-file-name elmo-cache-dirname + elmo-msgdb-dir))))) + +;;; +;; Warnings. + +(defconst elmo-warning-buffer-name "*elmo warning*") + +(defun elmo-warning (&rest args) + "Display a warning, making warning message by passing all args to `insert'." + (with-current-buffer (get-buffer-create elmo-warning-buffer-name) + (goto-char (point-max)) + (apply 'insert (append args '("\n"))) + (recenter 1)) + (display-buffer elmo-warning-buffer-name)) + +(defvar elmo-obsolete-variable-alist nil) +(defvar elmo-obsolete-variable-show-warnings nil) + +(defun elmo-define-obsolete-variable (obsolete var) + "Define obsolete variable. +OBSOLETE is a symbol for obsolete variable. +VAR is a symbol for new variable. +Definition is stored in `elmo-obsolete-variable-alist'." + (let ((pair (assq var elmo-obsolete-variable-alist))) + (if pair + (setcdr pair obsolete) + (setq elmo-obsolete-variable-alist + (cons (cons var obsolete) + elmo-obsolete-variable-alist))))) + +(defun elmo-resque-obsolete-variable (obsolete var) + "Resque obsolete variable OBSOLETE as VAR. +If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message." + (when (boundp obsolete) + (static-if (and (fboundp 'defvaralias) + (subrp (symbol-function 'defvaralias))) + (defvaralias var obsolete) + (set var (symbol-value obsolete))) + (if elmo-obsolete-variable-show-warnings + (elmo-warning (format "%s is obsolete. Use %s instead." + (symbol-name obsolete) + (symbol-name var)))))) + +(defun elmo-resque-obsolete-variables (&optional alist) + "Resque obsolete variables in ALIST. +ALIST is a list of cons cell of +\(OBSOLETE-VARIABLE-SYMBOL . NEW-VARIABLE-SYMBOL\). +If ALIST is nil, `elmo-obsolete-variable-alist' is used." + (dolist (pair elmo-obsolete-variable-alist) + (elmo-resque-obsolete-variable (cdr pair) + (car pair)))) + +;;; Queue. +(defvar elmo-dop-queue-filename "queue" + "*Disconnected operation queue is saved in this file.") + +(defun elmo-dop-queue-load () + (setq elmo-dop-queue + (elmo-object-load + (expand-file-name elmo-dop-queue-filename + elmo-msgdb-dir)))) + +(defun elmo-dop-queue-save () + (elmo-object-save + (expand-file-name elmo-dop-queue-filename + elmo-msgdb-dir) + elmo-dop-queue)) + (require 'product) (product-provide (provide 'elmo-util) (require 'elmo-version)) diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index bc9900e..cb4d666 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -30,67 +30,18 @@ ;; (require 'poe) +;; silence byte compiler (eval-when-compile (defun-maybe dynamic-link (a)) (defun-maybe dynamic-call (a b))) -;; IMAP4 -(defvar elmo-default-imap4-mailbox "inbox" - "*Default IMAP4 mailbox.") -(defvar elmo-default-imap4-server "localhost" - "*Default IMAP4 server.") -(defvar elmo-default-imap4-authenticate-type 'login - "*Default Authentication type for IMAP4.") -(defvar elmo-default-imap4-user (or (getenv "USER") - (getenv "LOGNAME") - (user-login-name)) - "*Default username for IMAP4.") -(defvar elmo-default-imap4-port 143 - "*Default Port number of IMAP.") -(defvar elmo-default-imap4-stream-type nil - "*Default stream type for IMAP4. -Any symbol value of `elmo-network-stream-type-alist'.") -(defvar elmo-imap4-stream-type-alist nil - "*Stream bindings for IMAP4. -This is taken precedence over `elmo-network-stream-type-alist'.") - -;; POP3 -(defvar elmo-default-pop3-user (or (getenv "USER") - (getenv "LOGNAME") - (user-login-name)) - "*Default username for POP3.") -(defvar elmo-default-pop3-server "localhost" - "*Default POP3 server.") -(defvar elmo-default-pop3-authenticate-type 'user - "*Default Authentication type for POP3.") -(defvar elmo-default-pop3-port 110 - "*Default POP3 port.") -(defvar elmo-default-pop3-stream-type nil - "*Default stream type for POP3. -Any symbol value of `elmo-network-stream-type-alist'.") -(defvar elmo-pop3-stream-type-alist nil - "*Stream bindings for POP3. -This is taken precedence over `elmo-network-stream-type-alist'.") -(defvar elmo-pop3-use-uidl t - "*If non-nil, use UIDL.") - -;; NNTP -(defvar elmo-default-nntp-server "localhost" - "*Default NNTP server.") -(defvar elmo-default-nntp-user nil - "*Default User of NNTP. nil means no user authentication.") -(defvar elmo-default-nntp-port 119 - "*Default Port number of NNTP.") -(defvar elmo-default-nntp-stream-type nil - "*Default stream type for NNTP. -Any symbol value of `elmo-network-stream-type-alist'.") -(defvar elmo-nntp-stream-type-alist nil - "*Stream bindings for NNTP. -This is taken precedence over `elmo-network-stream-type-alist'.") +(defgroup elmo nil + "ELMO, Elisp Library for Message Orchestration." + :tag "ELMO" + :group 'news + :group 'mail) ;; Local -(defvar elmo-localdir-folder-path "~/Mail" - "*Local mail folder path.") (defvar elmo-localnews-folder-path "~/News" "*Local news folder path.") (defvar elmo-maildir-folder-path "~/Maildir" @@ -99,14 +50,19 @@ This is taken precedence over `elmo-network-stream-type-alist'.") "*All Folders that match this list will be treated as Maildir. Each elements are regexp of folder name (This is obsolete).") +(defvar elmo-msgdb-file-header-chop-length 2048 + "*Number of bytes to get header in one reading from file.") + (defvar elmo-msgdb-dir "~/.elmo" "*ELMO Message Database path.") (defvar elmo-passwd-alist-file-name "passwd" "*ELMO Password filename.") (defvar elmo-passwd-life-time nil "*Duration of ELMO Password in seconds. nil means infinity.") + (defvar elmo-warning-threshold 30000 "*Display warning when the bytes of message exceeds this value.") + (defvar elmo-msg-appended-hook nil "A hook called when message is appended to database.") (defvar elmo-msg-deleted-hook nil @@ -135,11 +91,6 @@ Each elements are regexp of folder name (This is obsolete).") "Folder list cache (for access folder).") (defvar elmo-msgdb-finfo-filename "finfo" "Folder information cache...list of '(filename . '(new unread all)).") -(defvar elmo-msgdb-append-list-filename "append" - "Appended messages...Structure is same as number-alist. -For disconnected operations.") -(defvar elmo-msgdb-resume-list-filename "resume" - "Resumed messages. For disconnected operations.") (defvar elmo-msgdb-lock-list-filename "lock" "Locked messages...list of message-id. For disconnected operations.") @@ -153,32 +104,15 @@ For disconnected operations.") (defvar elmo-use-server-diff t "Non-nil forces to get unread message information on server.") -(defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd - "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored. -(Except `\\Deleted' flag).") +(defvar elmo-strict-diff-folder-list nil + "List of regexps of folder name which should be checked its diff strictly.") (defvar elmo-msgdb-extra-fields nil "Extra fields for msgdb.") -(defvar elmo-queue-filename "queue" - "*IMAP pending event queue is saved in this file.") -(defvar elmo-enable-disconnected-operation nil +(defvar elmo-enable-disconnected-operation t "*Enable disconnected operations.") -(defvar elmo-imap4-overview-fetch-chop-length 200 - "*Number of overviews to fetch in one request in imap4.") -(defvar elmo-nntp-overview-fetch-chop-length 200 - "*Number of overviews to fetch in one request in nntp.") -(defvar elmo-localdir-header-chop-length 2048 - "*Number of bytes to get header in one reading from file.") -(defvar elmo-imap4-force-login nil - "*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.") -(defvar elmo-imap4-use-select-to-update-status nil - "*Some imapd have to send select command to update status. -(ex. UW imapd 4.5-BETA?). For these imapd, you must set this variable t.") -(defvar elmo-imap4-use-modified-utf7 nil - "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.") - (defvar elmo-auto-change-plugged 600 "*Time to expire change plugged state automatically, as the number of seconds. Don't change plugged state automatically if nil.") @@ -205,18 +139,12 @@ If function, return value of function.") "*Path separator.") (defvar elmo-plugged t) (defvar elmo-use-semi nil) + (defvar elmo-no-subject "(No Subject in original.)" "*A string used when no subject field exists.") (defvar elmo-no-from "nobody@nowhere?" "*A string used when no from field exists.") -(defvar elmo-multi-divide-number 100000 - "*Multi divider number.") - -;;; User variables for elmo-archive. -(defvar elmo-archive-default-type 'zip - "*Default archiver type. The value must be a symbol.") - ;; database dynamic linking (defvar elmo-database-dl-module (expand-file-name "database.so" exec-directory)) @@ -243,19 +171,6 @@ If function, return value of function.") (defvar elmo-date-match (not (boundp 'nemacs-version)) "Date match is available or not.") -(defconst elmo-spec-alist - '((?% . imap4) - (?- . nntp) - (?\+ . localdir) - (?\* . multi) - (?\/ . filter) - (?\$ . archive) - (?& . pop3) - (?= . localnews) - (?' . internal) - (?| . pipe) - (?. . maildir))) - (defvar elmo-network-stream-type-alist '(("!" ssl ssl open-ssl-stream) ("!!" starttls starttls starttls-open-stream) @@ -268,9 +183,6 @@ FEATURE is a symbol of the feature for OPEN-STREAM-FUNCTION. OPEN-STREAM-FUNCTION is a function to open network stream. Arguments for this function are NAME, BUFFER, HOST and SERVICE.") -(defvar elmo-debug nil) -(defconst mmelmo-entity-buffer-name "*MMELMO-BUFFER*") - (defvar elmo-folder-info-hashtb nil "Array of folder database information '(max length new unread).") @@ -285,15 +197,10 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") (defvar elmo-cache-expire-default-age 50 "Cache expiration age (days).") + (defvar elmo-cache-dirname "cache" "Directory name for cache storage.") -(defvar elmo-use-buffer-cache t - "Use buffer cache.") - -(defvar elmo-buffer-cache-size 10 - "*Number of buffer for message cache.") - (defvar elmo-pack-number-check-strict t "Pack number strictly.") @@ -310,7 +217,7 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") (defvar elmo-weekday-name-fr '["Dim" "Lun" "Mar" "Mer" "Jeu" "Ven" "Sam"]) (defvar elmo-weekday-name-de '["Son" "Mon" "Die" "Mit" "Don" "Fre" "Sam"]) -(defvar elmo-msgid-replace-string-alist +(defvar elmo-filename-replace-string-alist '((":" . " c") ("*" . " a") ("?" . " q") @@ -321,34 +228,10 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") ("/" . " s") ("\\" . " b"))) -(defvar elmo-archive-use-cache nil - "Use cache in archive folder.") - -(defvar elmo-nntp-use-cache t - "Use cache in nntp folder.") - -(defvar elmo-imap4-use-cache t - "Use cache in imap4 folder.") - -(defvar elmo-pop3-use-cache t - "Use cache in pop3 folder.") - -(defvar elmo-localdir-lockfile-list nil) - -(defvar elmo-nntp-max-number-precedes-list-active nil - "Non-nil means max number of msgdb is set as the max number of `list active'. -(Needed for inn 2.3 or later?).") - -(defvar elmo-use-killed-list t - "If non-nil, deleted messages are saved as `killed' -and do not appear again.") +(defvar elmo-hash-minimum-size 1023 + "Minimum size of hash table.") -(defvar elmo-pop3-send-command-synchronously nil - "If non-nil, commands are send synchronously. -If server doesn't accept asynchronous commands, this variable should be -set as non-nil.") - -(defvar elmo-hash-maximum-size 4096 +(defvar elmo-hash-maximum-size 4095 "Maximum size of hash table.") (defvar elmo-use-decoded-cache (featurep 'xemacs) @@ -360,14 +243,17 @@ set as non-nil.") (defvar elmo-display-progress-threshold 20 "*Displaying progress gauge if number of messages are more than this value.") -(defvar elmo-inhibit-read-cache nil - "*Global switch to inhibit reading cache.") +(defvar elmo-inhibit-number-mapping nil + "Global switch to inhibit number mapping (e.g. Inhibit UIDL on POP3).") + +(defvar elmo-display-retrieval-progress-threshold 30000 + "*Don't display progress if the message size is smaller than this value.") (defvar elmo-inhibit-display-retrieval-progress nil "Global switch to inhibit display progress of each message's retrieval.") -(defvar elmo-display-retrieval-progress-threshold 30000 - "*Don't display progress if the message size is smaller than this value.") +(defvar elmo-dop-queue nil + "Global variable for storing disconnected operation queues.") (require 'product) (product-provide (provide 'elmo-vars) (require 'elmo-version)) diff --git a/elmo/elmo-version.el b/elmo/elmo-version.el index bfb88a4..8830364 100644 --- a/elmo/elmo-version.el +++ b/elmo/elmo-version.el @@ -40,7 +40,7 @@ ;; 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 5 8))) + (product-define "ELMO" nil '(2 7 0))) ;; For APEL 10.2 or earlier. (defun-maybe product-version-as-string (product) diff --git a/elmo/elmo.el b/elmo/elmo.el new file mode 100644 index 0000000..0ceebdd --- /dev/null +++ b/elmo/elmo.el @@ -0,0 +1,1438 @@ +;;; elmo.el -- Elisp Library for Message Orchestration + +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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: +;; + +(require 'luna) + +(require 'elmo-version) ; reduce recursive-load-depth +(require 'elmo-vars) +(require 'elmo-util) +(require 'elmo-msgdb) + +(eval-when-compile (require 'cl)) + +(if (or (featurep 'dbm) + (featurep 'gnudbm) + (featurep 'berkdb) + (featurep 'berkeley-db)) + (require 'elmo-database)) + +(defcustom elmo-message-fetch-threshold 30000 + "Fetch threshold." + :type 'integer + :group 'elmo) + +(defcustom elmo-message-fetch-confirm t + "If non-nil, confirm fetching if message size is larger than +`elmo-message-fetch-threshold'. +Otherwise, entire fetching of the message is aborted without confirmation." + :type 'boolean + :group 'elmo) + +(defcustom elmo-folder-update-threshold 500 + "Update threshold." + :type 'integer + :group 'elmo) + +(defcustom elmo-folder-update-confirm t + "Confirm if update number exceeds `elmo-folder-update-threshold'." + :type 'boolean + :group 'elmo) + +;;; internal +(defvar elmo-folder-type-alist nil) + +(defvar elmo-newsgroups-hashtb nil) + +(elmo-define-error 'elmo-error "Error" 'error) +(elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error) +(elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error) +(elmo-define-error 'elmo-imap4-bye-error "IMAP4 BYE response" 'elmo-open-error) + +(defun elmo-define-folder (prefix backend) + "Define a folder. +If a folder name begins with PREFIX, use BACKEND." + (let ((pair (assq prefix elmo-folder-type-alist))) + (if pair + (progn + (setcar pair prefix) + (setcdr pair backend)) + (setq elmo-folder-type-alist (cons (cons prefix backend) + elmo-folder-type-alist))))) + +(defmacro elmo-folder-type (name) + "Get folder type from NAME string." + (` (and (stringp (, name)) + (cdr (assoc (string-to-char (, name)) elmo-folder-type-alist))))) + +;;; ELMO folder +;; A elmo folder provides uniformed (orchestrated) access +;; to the internet messages. +(eval-and-compile + (luna-define-class elmo-folder () (type ; folder type symbol. + name ; orignal folder name string. + prefix ; prefix for folder name + path ; directory path for msgdb. + msgdb ; msgdb (may be nil). + killed-list ; killed list. + persistent ; non-nil if persistent. + message-modified ; message is modified. + mark-modified ; mark is modified. + process-duplicates ; read or hide + )) + (luna-define-internal-accessors 'elmo-folder)) + +(luna-define-generic elmo-folder-initialize (folder name) + ;; Initialize a FOLDER structure with NAME." + ) + +(defmacro elmo-folder-send (folder message &rest args) + "Let FOLDER receive the MESSAGE with ARGS." + (` (luna-send (, folder) (, message) (, folder) (,@ args)))) + +;;;###autoload +(defun elmo-make-folder (name &optional non-persistent) + "Make an ELMO folder structure specified by NAME. +If optional argument NON-PERSISTENT is non-nil, folder is treated as + non-persistent." + (let ((type (elmo-folder-type name)) + prefix split class folder original) + (setq original (elmo-string name)) + (if type + (progn + (setq prefix (substring name 0 1)) + (setq name (substring name 1))) + (setq type (intern (car (setq split (split-string name ":"))))) + (setq name (substring name (+ 1 (length (car split))))) + (setq prefix (concat (car split) ":"))) + (setq class (format "elmo-%s" (symbol-name type))) + (require (intern class)) + (setq folder (luna-make-entity (intern (concat class "-folder")) + :type type + :prefix prefix + :name original + :persistent (not non-persistent))) + (save-match-data + (elmo-folder-send folder 'elmo-folder-initialize name)))) + +(defmacro elmo-folder-msgdb (folder) + "Return the msgdb of FOLDER (on-demand loading)." + (` (or (elmo-folder-msgdb-internal (, folder)) + (elmo-folder-set-msgdb-internal (, folder) + (elmo-msgdb-load (, folder)))))) + +(luna-define-generic elmo-folder-open (folder &optional load-msgdb) + "Open and setup (load saved status) FOLDER. +If optional LOAD-MSGDB is non-nil, msgdb is loaded. +(otherwise, msgdb is loaded on-demand)") + +(luna-define-generic elmo-folder-open-internal (folder) + "Open FOLDER (without loading saved folder status).") + +(luna-define-generic elmo-folder-check (folder) + "Check the FOLDER to obtain newest information at the next list operation.") + +(luna-define-generic elmo-folder-commit (folder) + "Save current status of FOLDER.") + +(luna-define-generic elmo-folder-close (folder) + "Close, save and clearnup FOLDER.") + +(luna-define-generic elmo-folder-close-internal (folder) + "Close FOLDER (without saving folder status).") + +(luna-define-generic elmo-folder-plugged-p (folder) + "Returns t if FOLDER is plugged.") + +(luna-define-generic elmo-folder-set-plugged (folder plugged &optional add) + "Set FOLDER as plugged.") + +(luna-define-generic elmo-folder-use-flag-p (folder) + "Returns t if FOLDER treats unread/important flag itself.") + +(luna-define-generic elmo-folder-diff (folder &optional numbers) + "Get diff of FOLDER. +If optional NUMBERS is set, it is used as current NUMBERS. +Otherwise, saved status for folder is used for comparison. +Return value is a cons cell of NEWS and MESSAGES.") + +(luna-define-generic elmo-folder-status (folder) + "Returns a cons cell of (MAX-NUMBER . MESSAGES) in the FOLDER.") + +(luna-define-generic elmo-folder-reserve-status-p (folder) + "If non-nil, the folder should not close folder after `elmo-folder-status'.") + +(defun elmo-folder-list-messages (folder &optional visible-only) + "Return a list of message numbers contained in FOLDER. +If optional VISIBLE-ONLY is non-nil, killed messages are not listed." + (let ((list (elmo-folder-list-messages-internal folder visible-only)) + (killed (elmo-folder-killed-list-internal folder)) + numbers) + (setq numbers + (if (listp list) + list + ;; Not available, use current list. + (mapcar + 'car + (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder))))) + (elmo-living-messages numbers killed))) + +(defun elmo-folder-list-unreads (folder unread-marks) + "Return a list of unread message numbers contained in FOLDER. +UNREAD-MARKS is the unread marks." + (let ((list (elmo-folder-list-unreads-internal folder + unread-marks))) + (if (listp list) + list + ;; Not available, use current mark. + (delq nil + (mapcar + (function + (lambda (x) + (if (member (cadr x) unread-marks) + (car x)))) + (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))))) + +(defun elmo-folder-list-importants (folder important-mark) + "Returns a list of important message numbers contained in FOLDER. +IMPORTANT-MARK is the important mark." + (let ((importants (elmo-folder-list-importants-internal folder important-mark)) + (number-alist (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder))) + num-pair result) + (dolist (mark-pair (or elmo-msgdb-global-mark-alist + (setq elmo-msgdb-global-mark-alist + (elmo-object-load + (expand-file-name + elmo-msgdb-global-mark-filename + elmo-msgdb-dir))))) + (if (and (string= important-mark (cdr mark-pair)) + (setq num-pair (rassoc (car mark-pair) number-alist))) + (setq result (cons (car num-pair) result)))) + (if (listp importants) + (elmo-uniq-list (nconc result importants)) + result))) + +(luna-define-generic elmo-folder-list-messages-internal (folder &optional + visible-only) + ;; Return a list of message numbers contained in FOLDER. + ;; Return t if the message list is not available. + ) + +(luna-define-generic elmo-folder-list-unreads-internal (folder + unread-marks + &optional mark-alist) + ;; Return a list of unread message numbers contained in FOLDER. + ;; If optional MARK-ALIST is set, it is used as mark-alist. + ;; Return t if this feature is not available. + ) + +(luna-define-generic elmo-folder-list-importants-internal (folder + important-mark) + ;; Return a list of important message numbers contained in FOLDER. + ;; Return t if this feature is not available. + ) + +(luna-define-generic elmo-folder-list-subfolders (folder &optional one-level) + "Returns a list of subfolders contained in FOLDER. +If optional argument ONE-LEVEL is non-nil, only children of FOLDER is returned. +(a folder which have children is returned as a list) +Otherwise, all descendent folders are returned.") + +(luna-define-generic elmo-folder-have-subfolder-p (folder) + "Return non-nil when FOLDER has subfolders.") + +(luna-define-generic elmo-folder-exists-p (folder) + "Returns non-nil when FOLDER exists.") + +(luna-define-generic elmo-folder-creatable-p (folder) + "Returns non-nil when FOLDER is creatable.") + +(luna-define-generic elmo-folder-writable-p (folder) + "Returns non-nil when FOLDER is writable.") + +(luna-define-generic elmo-folder-persistent-p (folder) + "Return non-nil when FOLDER is persistent.") + +(luna-define-generic elmo-folder-create (folder) + "Create a FOLDER.") + +(luna-define-generic elmo-message-deletable-p (folder number) + "Returns non-nil when the message in the FOLDER with NUMBER is deletable.") + +(luna-define-generic elmo-folder-delete (folder) + "Delete FOLDER completely.") + +(luna-define-generic elmo-folder-rename (folder new-name) + "Rename FOLDER to NEW-NAME (string).") + +(luna-define-generic elmo-folder-delete-messages (folder numbers) + "Delete messages. +FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to be deleted.") + +(luna-define-generic elmo-folder-search (folder condition &optional numbers) + "Search and return list of message numbers. +FOLDER is the ELMO folder structure. +CONDITION is a condition string for searching. +If optional argument NUMBERS is specified and is a list of message numbers, +messages are searched from the list.") + +(luna-define-generic elmo-folder-msgdb-create + (folder numbers new-mark already-mark seen-mark important-mark seen-list) + "Create a message database (implemented in each backends). +FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to create msgdb. +NEW-MARK, ALREADY-MARK, SEEN-MARK, and IMPORTANT-MARK are mark string for +new message, unread but cached message, read message and important message. +SEEN-LIST is a list of message-id string which should be treated as read.") + +(luna-define-generic elmo-folder-unmark-important (folder numbers) + "Un-mark messages as important. +FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to be processed.") + +(luna-define-generic elmo-folder-mark-as-important (folder numbers) + "Mark messages as important. +FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to be processed.") + +(luna-define-generic elmo-folder-unmark-read (folder numbers) + "Un-mark messages as read. +FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to be processed.") + +(luna-define-generic elmo-folder-mark-as-read (folder numbers) + "Mark messages as read. +FOLDER is the ELMO folder structure. +NUMBERS is a list of message numbers to be processed.") + +(luna-define-generic elmo-folder-append-buffer (folder unread &optional number) + "Append current buffer as a new message. +FOLDER is the destination folder(ELMO folder structure). +If UNREAD is non-nil, message is appended as unread. +If optional argument NUMBER is specified, the new message number is set +(if possible).") + +(luna-define-generic elmo-folder-append-messages (folder + src-folder + numbers + unread-marks + &optional + same-number) + "Append messages from folder. +FOLDER is the ELMO folder structure. +Caller should make sure FOLDER is `writable'. +(Can be checked with `elmo-folder-writable-p'). +SRC-FOLDER is the source ELMO folder structure. +NUMBERS is the message numbers to be appended in the SRC-FOLDER. +UNREAD-MARKS is a list of unread mark string. +If second optional argument SAME-NUMBER is specified, +message number is preserved (if possible).") + +(luna-define-generic elmo-folder-pack-numbers (folder) + "Pack message numbers of FOLDER.") + +(luna-define-generic elmo-folder-update-number (folder) + "Update number of FOLDER.") + +(luna-define-generic elmo-folder-diff-async (folder) + "Get diff of FOLDER asynchronously.") + +(luna-define-generic elmo-folder-expand-msgdb-path (folder) + "Expand path for FOLDER.") + +(luna-define-generic elmo-folder-get-primitive-list (folder) + "Get primitive folder structure list contained in FOLDER.") + +(luna-define-generic elmo-folder-contains-type (folder type) + "Returns t if FOLDER contains TYPE.") + +(luna-define-generic elmo-folder-local-p (folder) + "Returns t if FOLDER is local.") + +(luna-define-generic elmo-folder-message-file-p (folder) + "Returns t if all messages in the FOLDER are files.") + +;;; Message methods. +(luna-define-generic elmo-message-use-cache-p (folder number) + "Returns t if the message in the FOLDER with NUMBER uses cache.") + +(luna-define-generic elmo-message-file-name (folder number) + "Return the file name of a message specified by FOLDER and NUMBER.") + +;;; For archive + +;;; Use original file +(luna-define-generic elmo-folder-message-file-number-p (folder) + "Return t if the file name in the FOLDER is the message number.") + +(luna-define-generic elmo-folder-message-file-directory (folder) + "Return the directory of the message files of FOLDER.") + +;;; Use temporary file +(luna-define-generic elmo-folder-message-make-temp-file-p (folder) + "Return t if the messages in the FOLDER makes local temporary file.") + +(luna-define-generic elmo-folder-message-make-temp-files (folder + numbers + &optional + start-number) + "Make a new temporary files from the messages in the FOLDER with NUMBERS. +If START-NUMBER is specified, temporary files begin from the number. +Otherwise, same number is used for temporary files. +Return newly created temporary directory name which contains temporary files.") + +(luna-define-generic elmo-message-file-p (folder number) + "Return t if message in the FOLDER with NUMBER is a file.") + +(luna-define-generic elmo-find-fetch-strategy + (folder entity &optional ignore-cache) +;; Returns the message fetching strategy suitable for the message. +;; FOLDER is the ELMO folder structure. +;; ENTITY is the overview entity of the message in the folder. +;; If optional argument IGNORE-CACHE is non-nil, cache is ignored. +;; Returned value is a elmo-fetch-strategy object. +;; If return value is nil, message should not be nil. + ) + +(defmacro elmo-make-fetch-strategy (entireness + &optional + use-cache + save-cache + cache-path) +;; Make elmo-message-fetching strategy. +;; ENTIRENESS is 'entire or 'section. +;; 'entire means fetch message entirely at once. +;; 'section means fetch message section by section. +;; If optional USE-CACHE is non-nil, existing cache is used and otherwise, +;; existing cache is thrown away. +;; If SAVE-CACHE is non-nil, fetched message is saved. +;; CACHE-PATH is the cache path to be used as a message cache file. + (` (vector (, entireness) + (, use-cache) (, save-cache) (, cache-path)))) + +(defmacro elmo-fetch-strategy-entireness (strategy) + ;; Return entireness of STRATEGY. + (` (aref (, strategy) 0))) + +(defmacro elmo-fetch-strategy-use-cache (strategy) + ;; Return use-cache of STRATEGY. + (` (aref (, strategy) 1))) + +(defmacro elmo-fetch-strategy-save-cache (strategy) + ;; Return save-cache of STRATEGY. + (` (aref (, strategy) 2))) + +(defmacro elmo-fetch-strategy-cache-path (strategy) + ;; Return cache-path of STRATEGY. + (` (aref (, strategy) 3))) + +(luna-define-method elmo-find-fetch-strategy + ((folder elmo-folder) entity &optional ignore-cache) + (let (cache-file size message-id number) + (setq size (elmo-msgdb-overview-entity-get-size entity)) + (setq message-id (elmo-msgdb-overview-entity-get-id entity)) + (setq number (elmo-msgdb-overview-entity-get-number entity)) + (setq cache-file (elmo-file-cache-get message-id)) + (if (or ignore-cache + (null (elmo-file-cache-status cache-file))) + ;; No cache or ignore-cache. + (if (and (not (elmo-folder-local-p folder)) + elmo-message-fetch-threshold + (integerp size) + (>= size elmo-message-fetch-threshold) + (or (not elmo-message-fetch-confirm) + (not (prog1 (y-or-n-p + (format "Fetch entire message(%dbytes)? " + size)) + (message ""))))) + ;; Don't fetch message at all. + nil + ;; Don't use existing cache and fetch entire message at once. + (elmo-make-fetch-strategy + 'entire nil + (elmo-message-use-cache-p folder number) + (elmo-file-cache-path cache-file))) + ;; Cache exists. + (if (not ignore-cache) + (elmo-make-fetch-strategy + 'entire + ;; ...But ignore current section cache and re-fetch + ;; if section cache. + (not (eq (elmo-file-cache-status cache-file) 'section)) + ;; Save cache. + (elmo-message-use-cache-p folder number) + (elmo-file-cache-path cache-file)))))) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-folder) &optional visible-only) + t) + +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-folder) unread-marks &optional mark-alist) + t) + +(luna-define-method elmo-folder-list-importants-internal + ((folder elmo-folder) important-mark) + t) + +(defun elmo-folder-encache (folder numbers) + "Encache messages in the FOLDER with NUMBERS." + (dolist (number numbers) + (elmo-message-encache folder number))) + +(luna-define-generic elmo-message-encache (folder number) + "Encache message in the FOLDER with NUMBER.") + +(luna-define-method elmo-message-encache ((folder elmo-folder) number) + (elmo-message-fetch + folder number + (elmo-make-fetch-strategy 'entire + nil ;use-cache + t ;save-cache + (elmo-file-cache-get-path + (elmo-message-field + folder number 'message-id))))) + +(luna-define-generic elmo-message-fetch (folder number strategy + &optional + section + outbuf + unread) + "Fetch a message and return as a string. +FOLDER is the ELMO folder structure. +NUMBER is the number of the message in the FOLDER. +STRATEGY is the message fetching strategy. +If optional argument SECTION is specified, only the SECTION of the message +is fetched (if possible). +If second optional argument OUTBUF is specified, fetched message is +inserted to the buffer and returns t if fetch was ended successfully. +If third optional argument UNREAD is non-nil, message is not marked as read. +Returns non-nil if fetching was succeed.") + +(luna-define-generic elmo-message-fetch-with-cache-process (folder + number strategy + &optional + section + unread) + "Fetch a message into current buffer with cache process. +FOLDER is the ELMO folder structure. +NUMBER is the number of the message in the FOLDER. +STRATEGY is the message fetching strategy. +If optional argument SECTION is specified, only the SECTION of the message +is fetched (if possible). +If second optional argument UNREAD is non-nil, message is not marked as read. +Returns non-nil if fetching was succeed.") + +(luna-define-generic elmo-message-fetch-internal (folder number strategy + &optional + section + unread) + "Fetch a message into current buffer. +FOLDER is the ELMO folder structure. +NUMBER is the number of the message in the FOLDER. +STRATEGY is the message fetching strategy. +If optional argument SECTION is specified, only the SECTION of the message +is fetched (if possible). +If second optional argument UNREAD is non-nil, message is not marked as read. +Returns non-nil if fetching was succeed.") + +(luna-define-generic elmo-message-fetch-field (folder number field) + "Fetch a message field value. +FOLDER is the ELMO folder structure. +NUMBER is the number of the message in the FOLDER. +FIELD is a symbol of the field name.") + +(luna-define-generic elmo-message-folder (folder number) + "Get primitive folder of the message.") + +(luna-define-generic elmo-folder-process-crosspost (folder + &optional + number-alist) + "Process crosspost for FOLDER. +If NUMBER-ALIST is set, it is used as number-alist. +Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") + +(luna-define-generic elmo-folder-append-msgdb (folder append-msgdb) + "Append APPEND-MSGDB to the current msgdb of the folder.") + +(luna-define-method elmo-folder-open ((folder elmo-folder) + &optional load-msgdb) + (elmo-generic-folder-open folder load-msgdb)) + +(defun elmo-generic-folder-open (folder load-msgdb) + (if load-msgdb + (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder))) + (elmo-folder-set-killed-list-internal + folder + (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))) + (elmo-folder-open-internal folder)) + +(luna-define-method elmo-folder-open-internal ((folder elmo-folder)) + nil ; default is do nothing. + ) + +(luna-define-method elmo-folder-check ((folder elmo-folder)) + nil) ; default is noop. + +(luna-define-method elmo-folder-commit ((folder elmo-folder)) + (elmo-generic-folder-commit folder)) + +(defun elmo-generic-folder-commit (folder) + (when (elmo-folder-persistent-p folder) + (when (elmo-folder-message-modified-internal folder) + (elmo-msgdb-overview-save + (elmo-folder-msgdb-path folder) + (elmo-msgdb-get-overview (elmo-folder-msgdb folder))) + (elmo-msgdb-number-save + (elmo-folder-msgdb-path folder) + (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder))) + (elmo-folder-set-info-max-by-numdb + folder + (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder))) + (elmo-folder-set-message-modified-internal folder nil) + (elmo-msgdb-killed-list-save + (elmo-folder-msgdb-path folder) + (elmo-folder-killed-list-internal folder))) + (when (elmo-folder-mark-modified-internal folder) + (elmo-msgdb-mark-save + (elmo-folder-msgdb-path folder) + (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) + (elmo-folder-set-mark-modified-internal folder nil)))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-folder)) + ;; do nothing. + ) + +(luna-define-method elmo-folder-close ((folder elmo-folder)) + (elmo-generic-folder-close folder) + (elmo-folder-close-internal folder)) + +(defun elmo-generic-folder-close (folder) + (elmo-folder-commit folder) + (elmo-folder-set-msgdb-internal folder nil) + (elmo-folder-set-killed-list-internal folder nil)) + +(luna-define-method elmo-folder-plugged-p ((folder elmo-folder)) + t) ; default is plugged. + +(luna-define-method elmo-folder-set-plugged ((folder elmo-folder) plugged + &optional add) + nil) ; default is do nothing. + +(luna-define-method elmo-folder-use-flag-p ((folder elmo-folder)) + nil) ; default is no flag. + +(luna-define-method elmo-folder-persistent-p ((folder elmo-folder)) + (elmo-folder-persistent-internal folder)) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-folder)) + t) ; default is creatable. + +(luna-define-method elmo-folder-writable-p ((folder elmo-folder)) + t) ; default is writable. + +(luna-define-method elmo-folder-rename ((folder elmo-folder) new-name) + (let* ((new-folder (elmo-make-folder new-name))) + (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)) + (elmo-folder-send folder 'elmo-folder-rename-internal new-folder) + (elmo-msgdb-rename-path folder new-folder))) + +(luna-define-method elmo-folder-pack-numbers ((folder elmo-folder)) + nil) ; default is noop. + +(luna-define-method elmo-folder-update-number ((folder elmo-folder)) + nil) ; default is noop. + +(luna-define-method elmo-folder-message-file-p ((folder elmo-folder)) + nil) ; default is not file. + +(luna-define-method elmo-folder-message-file-number-p ((folder elmo-folder)) + nil) ; default is not number. + +(luna-define-method elmo-folder-message-make-temp-file-p ((folder elmo-folder)) + nil) ; default is not make temp file. + +(luna-define-method elmo-message-file-name ((folder elmo-folder) + number) + nil) ; default is no name. + +(luna-define-method elmo-folder-local-p ((folder elmo-folder)) + t) ; default is local. + +(luna-define-method elmo-folder-have-subfolder-p ((folder elmo-folder)) + t) + +;;; Folder info +;; Folder info is a message number information cache (hashtable) +(defsubst elmo-folder-get-info (folder &optional hashtb) + "Return FOLDER info from HASHTB (default is `elmo-folder-info-hashtb')." + (elmo-get-hash-val (elmo-folder-name-internal folder) + (or hashtb elmo-folder-info-hashtb))) + +(defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread) + "Set FOLDER info (means MAX, NUMBERS, NEW and UNREAD)." + (let ((info (elmo-folder-get-info folder))) + (when info + (or new (setq new (nth 0 info))) + (or unread (setq unread (nth 1 info))) + (or numbers (setq numbers (nth 2 info))) + (or max (setq max (nth 3 info)))) + (elmo-set-hash-val (elmo-folder-name-internal folder) + (list new unread numbers max) + elmo-folder-info-hashtb))) + +(defun elmo-folder-set-info-max-by-numdb (folder msgdb-number) + "Set FOLDER info by MSGDB-NUMBER in msgdb." + (let ((num-db (sort (mapcar 'car msgdb-number) '<))) + (elmo-folder-set-info-hashtb + folder + (or (nth (max 0 (1- (length num-db))) num-db) 0) + nil ;;(length num-db) + ))) + +(defun elmo-folder-get-info-max (folder) + "Return max number of FODLER from folder info." + (nth 3 (elmo-folder-get-info folder))) + +(defun elmo-folder-get-info-length (folder) + "Return length of FODLER from folder info." + (nth 2 (elmo-folder-get-info folder))) + +(defun elmo-folder-get-info-unread (folder) + "Return unread of FODLER from folder info." + (nth 1 (elmo-folder-get-info folder))) + +(defun elmo-folder-info-make-hashtb (info-alist hashtb) + "Setup folder info hashtable by INFO-ALIST on HASHTB." + (let* ((hashtb (or hashtb + (elmo-make-hash (length info-alist))))) + (mapcar + (lambda (x) + (let ((info (cadr x))) + (and (intern-soft (car x) hashtb) + (elmo-set-hash-val (car x) + (list (nth 2 info) ;; new + (nth 3 info) ;; unread + (nth 1 info) ;; length + (nth 0 info)) ;; max + hashtb)))) + info-alist) + (setq elmo-folder-info-hashtb hashtb))) + +(defsubst elmo-strict-folder-diff (folder) + "Return folder diff information strictly from FOLDER." + (let* ((dir (elmo-folder-msgdb-path folder)) + (nalist (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder))) + (in-db (sort (mapcar 'car nalist) '<)) + (in-folder (elmo-folder-list-messages folder)) + append-list delete-list diff) + (cons (if (equal in-folder in-db) + 0 + (setq diff (elmo-list-diff + in-folder in-db + nil + )) + (setq append-list (car diff)) + (setq delete-list (cadr diff)) + (if append-list + (length append-list) + (if delete-list + (- 0 (length delete-list)) + 0))) + (length in-folder)))) + +(luna-define-method elmo-folder-diff ((folder elmo-folder) + &optional numbers) + (elmo-generic-folder-diff folder numbers)) + +(defun elmo-generic-folder-diff (folder numbers) + (if (elmo-string-match-member (elmo-folder-name-internal folder) + elmo-strict-diff-folder-list) + (elmo-strict-folder-diff folder) + (let ((cached-in-db-max (elmo-folder-get-info-max folder)) + (in-folder (elmo-folder-status folder)) + (in-db t) + unsync messages + in-db-max) + (if numbers + (setq in-db-max (or (nth (max 0 (1- (length numbers))) numbers) + 0)) + (if (not cached-in-db-max) + (let ((number-list (mapcar 'car + (elmo-msgdb-number-load + (elmo-folder-msgdb-path folder))))) + ;; No info-cache. + (setq in-db (sort number-list '<)) + (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db) + 0)) + (elmo-folder-set-info-hashtb folder in-db-max nil)) + (setq in-db-max cached-in-db-max))) + (setq unsync (if (and in-db + (car in-folder)) + (- (car in-folder) in-db-max) + (if (and in-folder + (null in-db)) + (cdr in-folder) + (if (null (car in-folder)) + nil)))) + (setq messages (cdr in-folder)) + (if (and unsync messages (> unsync messages)) + (setq unsync messages)) + (cons (or unsync 0) (or messages 0))))) + +(defvar elmo-folder-diff-async-callback nil) +(defvar elmo-folder-diff-async-callback-data nil) + +(luna-define-method elmo-folder-diff-async ((folder elmo-folder)) + (and elmo-folder-diff-async-callback + (funcall elmo-folder-diff-async-callback + folder + (elmo-folder-diff folder)))) + +(luna-define-method elmo-folder-get-primitive-list ((folder elmo-folder)) + (list folder)) + +(luna-define-method elmo-folder-contains-type ((folder elmo-folder) type) + (eq (elmo-folder-type-internal folder) type)) + +(luna-define-method elmo-folder-append-messages ((folder elmo-folder) + src-folder + numbers + unread-marks + &optional + same-number) + (elmo-generic-folder-append-messages folder src-folder numbers + unread-marks same-number)) + +(defun elmo-generic-folder-append-messages (folder src-folder numbers + unread-marks same-number) + (let (unseen seen-list succeed-numbers failure) + (with-temp-buffer + (while numbers + (setq failure nil) + (condition-case nil + (progn + (elmo-message-fetch src-folder (car numbers) + (elmo-make-fetch-strategy + 'entire) + nil (current-buffer) + 'unread) + (unless (eq (buffer-size) 0) + (elmo-folder-append-buffer + folder + (setq unseen (member (elmo-message-mark + src-folder (car numbers)) + unread-marks)) + (if same-number (car numbers))))) + (error (setq failure t))) + ;; FETCH & APPEND finished + (unless failure + (unless unseen + (setq seen-list (cons (elmo-message-field + src-folder (car numbers) + 'message-id) + seen-list))) + (setq succeed-numbers (cons (car numbers) succeed-numbers))) + (setq numbers (cdr numbers))) + (if (and seen-list (elmo-folder-persistent-p folder)) + (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder) + (nconc (elmo-msgdb-seen-load + (elmo-folder-msgdb-path folder)) + seen-list))) + succeed-numbers))) + +;; Arguments should be reduced. +(defun elmo-folder-move-messages (src-folder msgs dst-folder + &optional msgdb all done + no-delete-info + no-delete + same-number + unread-marks + save-unread) + (save-excursion + (let* ((messages msgs) + (elmo-inhibit-display-retrieval-progress t) + (len (length msgs)) + (all-msg-num (or all len)) + (done-msg-num (or done 0)) + (progress-message (if no-delete + "Copying messages..." + "Moving messages...")) + succeeds i result) + (if (eq dst-folder 'null) + (setq succeeds messages) + ;; src is already opened. + (when messages + (elmo-folder-open-internal dst-folder) + (unless (setq succeeds (elmo-folder-append-messages dst-folder + src-folder + messages + unread-marks + same-number)) + (error "move: append message to %s failed" + (elmo-folder-name-internal dst-folder))) + (elmo-folder-close dst-folder)) + (when (and (elmo-folder-persistent-p dst-folder) + save-unread) + ;; Save to seen list. + (let* ((dir (elmo-folder-msgdb-path dst-folder)) + (seen-list (elmo-msgdb-seen-load dir))) + (setq seen-list + (elmo-msgdb-add-msgs-to-seen-list + msgs (elmo-folder-msgdb src-folder) + unread-marks seen-list)) + (elmo-msgdb-seen-save dir seen-list)))) + (when (and done + (> all-msg-num elmo-display-progress-threshold)) + (elmo-display-progress + 'elmo-folder-move-messages progress-message + (/ (* done-msg-num 100) all-msg-num))) + (if (and (not no-delete) succeeds) + (progn + (if (not no-delete-info) + (message "Cleaning up src folder...")) + (if (and (elmo-folder-delete-messages src-folder succeeds) + (elmo-msgdb-delete-msgs + (elmo-folder-msgdb src-folder) succeeds)) + (setq result t) + (message "move: delete messages from %s failed." + (elmo-folder-name-internal src-folder)) + (setq result nil)) + (if (and result + (not no-delete-info)) + (message "Cleaning up src folder...done")) + result) + (if no-delete + (progn + (message "Copying messages...done") + t) + (if (eq len 0) + (message "No message was moved.") + (message "Moving messages failed.") + nil ; failure + )))))) + +(defun elmo-folder-msgdb-path (folder) + "Return the msgdb path for FOLDER." + (or (elmo-folder-path-internal folder) + (elmo-folder-set-path-internal + folder + (elmo-folder-expand-msgdb-path folder)))) + +(defun elmo-message-mark (folder number) + "Get mark of the message. +FOLDER is the ELMO folder structure. +NUMBER is a number of the message." + (cadr (assq number (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))) + +(defun elmo-folder-list-messages-mark-match (folder mark-regexp) + "List messages in the FOLDER which have a mark that matches MARK-REGEXP" + (let ((case-fold-search nil) + matched) + (if mark-regexp + (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) + (if (string-match mark-regexp (cadr elem)) + (setq matched (cons (car elem) matched))))) + matched)) + +(defun elmo-message-field (folder number field) + "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." + (case field + (message-id (elmo-msgdb-overview-entity-get-id + (elmo-msgdb-overview-get-entity + number (elmo-folder-msgdb folder)))) + (subject (elmo-msgdb-overview-entity-get-subject + (elmo-msgdb-overview-get-entity + number (elmo-folder-msgdb folder)))) + (size (elmo-msgdb-overview-entity-get-size + (elmo-msgdb-overview-get-entity + number (elmo-folder-msgdb folder)))) + (date (elmo-msgdb-overview-entity-get-date + (elmo-msgdb-overview-get-entity + number (elmo-folder-msgdb folder)))) + (to (elmo-msgdb-overview-entity-get-to + (elmo-msgdb-overview-get-entity + number (elmo-folder-msgdb folder)))) + (cc (elmo-msgdb-overview-entity-get-cc + (elmo-msgdb-overview-get-entity + number (elmo-folder-msgdb folder)))))) + +(defun elmo-message-set-mark (folder number mark) + "Set mark for the message in the FOLDER with NUMBER as MARK." + (elmo-msgdb-set-mark-alist + (elmo-folder-msgdb folder) + (elmo-msgdb-mark-set + (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)) + number mark))) + +(luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number) + nil) ; default is not use cache. + +(luna-define-method elmo-message-folder ((folder elmo-folder) number) + folder) ; default is folder + +(luna-define-method elmo-folder-unmark-important ((folder elmo-folder) numbers) + t) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-folder) + numbers) + t) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-folder) numbers) + t) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) numbers) + t) + +(luna-define-method elmo-folder-process-crosspost ((folder elmo-folder) + &optional + number-alist) + ;; Do nothing. + ) + +(defun elmo-generic-folder-append-msgdb (folder append-msgdb) + (if append-msgdb + (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb)) + (all-alist (copy-sequence (append + (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder)) + number-alist))) + (cur number-alist) + pair overview + to-be-deleted + mark-alist) + (while cur + (setq all-alist (delq (car cur) all-alist)) + ;; same message id exists. + (if (setq pair (rassoc (cdr (car cur)) all-alist)) + (setq to-be-deleted (nconc to-be-deleted (list (car pair))))) + (setq cur (cdr cur))) + (cond ((eq (elmo-folder-process-duplicates-internal folder) + 'hide) + ;; Hide duplicates. + (setq overview (elmo-delete-if + (lambda (x) + (memq (elmo-msgdb-overview-entity-get-number + x) + to-be-deleted)) + (elmo-msgdb-get-overview append-msgdb))) + ;; Should be mark as read. + (elmo-folder-mark-as-read folder to-be-deleted) + (elmo-msgdb-set-overview append-msgdb overview)) + ((eq (elmo-folder-process-duplicates-internal folder) + 'read) + ;; Mark as read duplicates. + (elmo-folder-mark-as-read folder to-be-deleted)) + (t + ;; Do nothing. + (setq to-be-deleted nil))) + (elmo-folder-set-msgdb-internal folder + (elmo-msgdb-append + (elmo-folder-msgdb folder) + append-msgdb t)) + (length to-be-deleted)) + 0)) + +(luna-define-method elmo-folder-append-msgdb ((folder elmo-folder) + append-msgdb) + (elmo-generic-folder-append-msgdb folder append-msgdb)) + +(defun elmo-folder-confirm-appends (appends) + (let ((len (length appends)) + in) + (if (and (> len elmo-folder-update-threshold) + elmo-folder-update-confirm) + (if (y-or-n-p (format "Too many messages(%d). Continue? " len)) + appends + (setq in elmo-folder-update-threshold) + (catch 'end + (while t + (setq in (read-from-minibuffer "Update number: " + (int-to-string in)) + in (string-to-int in)) + (if (< len in) + (throw 'end len)) + (if (y-or-n-p (format "%d messages are disappeared. OK? " + (max (- len in) 0))) + (throw 'end in)))) + (nthcdr (max (- len in) 0) appends)) + (if (and (> len elmo-folder-update-threshold) + (not elmo-folder-update-confirm)) + (nthcdr (max (- len elmo-folder-update-threshold) 0) appends) + appends)))) + +(luna-define-method elmo-message-fetch ((folder elmo-folder) + number strategy + &optional + section + outbuf + unread) + (if outbuf + (with-current-buffer outbuf + (erase-buffer) + (elmo-message-fetch-with-cache-process folder number + strategy section unread) + t) + (with-temp-buffer + (elmo-message-fetch-with-cache-process folder number + strategy section unread) + (buffer-string)))) + +(luna-define-method elmo-message-fetch-with-cache-process ((folder elmo-folder) + number strategy + &optional + section unread) + (let (cache-file) + (if (and (elmo-fetch-strategy-use-cache strategy) + (setq cache-file (elmo-file-cache-expand-path + (elmo-fetch-strategy-cache-path strategy) + section)) + (file-exists-p cache-file)) + (if (and (elmo-cache-path-section-p cache-file) + (eq (elmo-fetch-strategy-entireness strategy) 'entire)) + (error "Entire message is not cached.") + (insert-file-contents-as-binary cache-file)) + (elmo-message-fetch-internal folder number strategy section unread) + (elmo-delete-cr-buffer) + (when (and (> (buffer-size) 0) + (elmo-fetch-strategy-save-cache strategy) + (elmo-fetch-strategy-cache-path strategy)) + (elmo-file-cache-save + (elmo-fetch-strategy-cache-path strategy) + section))))) + +(defun elmo-folder-synchronize (folder + new-mark ;"N" + unread-uncached-mark ;"U" + unread-cached-mark ;"!" + read-uncached-mark ;"u" + important-mark ;"$" + &optional ignore-msgdb + no-check) + "Synchronize the folder data to the newest status. +FOLDER is the ELMO folder structure. +NEW-MARK, UNREAD-CACHED-MARK, READ-UNCACHED-MARK, and IMPORTANT-MARK +are mark strings for new messages, unread but cached messages, +read but not cached messages, and important messages. +If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except +read mark status. If IGNORE-MSGDB is 'visible-only, only visible messages +are thrown away and synchronized. +If NO-CHECK is non-nil, recheck folder is skipped. + +Return a list of +\(NEW-MSGDB DELETE-LIST CROSSED\) +NEW-MSGDB is the newly appended msgdb. +DELETE-LIST is a list of deleted message number. +CROSSED is cross-posted message number." + (let ((killed-list (elmo-folder-killed-list-internal folder)) + (before-append t) + number-alist mark-alist + old-msgdb diff diff-2 delete-list new-list new-msgdb mark + seen-list crossed after-append) + (setq old-msgdb (elmo-folder-msgdb folder)) + ;; Load seen-list. + (setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder))) + (setq number-alist (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder))) + (setq mark-alist (elmo-msgdb-get-mark-alist + (elmo-folder-msgdb folder))) + (if ignore-msgdb + (progn + (setq seen-list (nconc + (elmo-msgdb-mark-alist-to-seen-list + number-alist mark-alist + (concat important-mark read-uncached-mark)) + seen-list)) + ;; Make killed list as nil. + (unless (eq ignore-msgdb 'visible-only) + (elmo-folder-set-killed-list-internal folder nil)) + (elmo-folder-set-msgdb-internal folder + (elmo-msgdb-clear)))) + (unless no-check (elmo-folder-check folder)) + (condition-case nil + (progn + (message "Checking folder diff...") + ;; TODO: killed list is loaded in elmo-folder-open and + ;; list-messages use internal killed-list-folder. + (setq diff (elmo-list-diff (elmo-folder-list-messages + folder + (eq 'visible-only ignore-msgdb)) + (unless ignore-msgdb + (sort (mapcar + 'car + number-alist) + '<)))) + (message "Checking folder diff...done") + (setq new-list (elmo-folder-confirm-appends (car diff))) + ;; Set killed list. + (when (and (not (eq (length (car diff)) + (length new-list))) + (setq diff-2 (elmo-list-diff (car diff) new-list))) + (elmo-msgdb-append-to-killed-list folder (car diff-2))) + ;; Don't delete important marked messages. + (setq delete-list + (if (eq (elmo-folder-type-internal folder) 'mark) + (cadr diff) + (elmo-delete-if + (lambda (x) + (and (setq mark (cadr (assq x mark-alist))) + (string= mark important-mark))) + ;; delete message list + (cadr diff)))) + (if (or (equal diff '(nil nil)) + (equal diff '(nil)) + (and (eq (length (car diff)) 0) + (eq (length (cadr diff)) 0))) + (progn + (elmo-folder-update-number folder) + (elmo-folder-process-crosspost folder) + nil ; no update. + ) + (if delete-list (elmo-msgdb-delete-msgs + (elmo-folder-msgdb folder) delete-list)) + (when new-list + (setq new-msgdb (elmo-folder-msgdb-create + folder + new-list + new-mark unread-cached-mark + read-uncached-mark important-mark + seen-list)) + (elmo-msgdb-change-mark (elmo-folder-msgdb folder) + new-mark unread-uncached-mark) + ;; Clear seen-list. + (if (elmo-folder-persistent-p folder) + (setq seen-list (elmo-msgdb-seen-save + (elmo-folder-msgdb-path folder) nil))) + (setq before-append nil) + (setq crossed (elmo-folder-append-msgdb folder new-msgdb)) + ;; process crosspost. + ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST). + (elmo-folder-process-crosspost folder) + (elmo-folder-set-message-modified-internal folder t) + (elmo-folder-set-mark-modified-internal folder t)) + ;; return value. + (list new-msgdb delete-list crossed))) + (quit + ;; Resume to the original status. + (if before-append + (elmo-folder-set-msgdb-internal folder old-msgdb)) + (elmo-folder-set-killed-list-internal folder killed-list) + nil)))) + +(defun elmo-folder-messages (folder) + "Return number of messages in the FOLDER." + (length + (elmo-msgdb-get-number-alist + (elmo-folder-msgdb folder)))) + +;;; +(defun elmo-msgdb-search (folder condition msgdb) + "Search messages which satisfy CONDITION from FOLDER with MSGDB." + (let* ((condition (car (elmo-parse-search-condition condition))) + (overview (elmo-msgdb-get-overview msgdb)) + (number-alist (elmo-msgdb-get-number-alist msgdb)) + (number-list (mapcar 'car number-alist)) + (length (length overview)) + (i 0) + result) + (if (elmo-condition-find-key condition "body") + (elmo-folder-search folder condition number-list) + (while overview + (if (elmo-msgdb-search-internal condition (car overview) + number-list) + (setq result + (cons + (elmo-msgdb-overview-entity-get-number (car overview)) + result))) + (setq i (1+ i)) + (elmo-display-progress + 'elmo-msgdb-search "Searching..." (/ (* i 100) length)) + (setq overview (cdr overview))) + (nreverse result)))) + +(defun elmo-msgdb-load (folder) + (message "Loading msgdb for %s..." (elmo-folder-name-internal folder)) + (let* ((path (elmo-folder-msgdb-path folder)) + (overview (elmo-msgdb-overview-load path)) + (msgdb (list overview + (elmo-msgdb-number-load path) + (elmo-msgdb-mark-load path) + (elmo-msgdb-make-overview-hashtb overview)))) + (message "Loading msgdb for %s...done" (elmo-folder-name-internal folder)) + (elmo-folder-set-info-max-by-numdb folder + (elmo-msgdb-get-number-alist msgdb)) + msgdb)) + +(defun elmo-msgdb-delete-path (folder) + (let ((path (elmo-folder-msgdb-path folder))) + (if (file-directory-p path) + (elmo-delete-directory path t)))) + +(defun elmo-msgdb-rename-path (old-folder new-folder) + (let* ((old (directory-file-name (elmo-folder-msgdb-path old-folder))) + (new (directory-file-name (elmo-folder-msgdb-path new-folder))) + (new-dir (directory-file-name (file-name-directory new)))) + (if (not (file-directory-p old)) + () + (if (file-exists-p new) + (error "Already exists directory: %s" new) + (if (not (file-exists-p new-dir)) + (elmo-make-directory new-dir)) + (rename-file old new))))) + +(defun elmo-setup-subscribed-newsgroups (groups) + "Setup subscribed newsgroups. +GROUPS is a list of newsgroup name string. +Return a hashtable for newsgroups." + (let ((hashtb (or elmo-newsgroups-hashtb + (setq elmo-newsgroups-hashtb + (elmo-make-hash (length groups)))))) + (dolist (group groups) + (or (elmo-get-hash-val group hashtb) + (elmo-set-hash-val group nil hashtb))) + (setq elmo-newsgroups-hashtb hashtb))) + +(defvar elmo-crosspost-message-alist-modified nil) +(defun elmo-crosspost-message-alist-load () + "Load crosspost message alist." + (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load)) + (setq elmo-crosspost-message-alist-modified nil)) + +(defun elmo-crosspost-message-alist-save () + "Save crosspost message alist." + (when elmo-crosspost-message-alist-modified + (let ((alist elmo-crosspost-message-alist) + newsgroups) + (while alist + (setq newsgroups + (elmo-delete-if + '(lambda (x) + (not (intern-soft x elmo-newsgroups-hashtb))) + (nth 1 (car alist)))) + (if newsgroups + (setcar (cdar alist) newsgroups) + (setq elmo-crosspost-message-alist + (delete (car alist) elmo-crosspost-message-alist))) + (setq alist (cdr alist))) + (elmo-crosspost-alist-save elmo-crosspost-message-alist) + (setq elmo-crosspost-message-alist-modified nil)))) + +(defun elmo-folder-make-temp-dir (folder) + ;; Make a temporary directory for FOLDER. + (let ((temp-dir (make-temp-name + (concat + (file-name-as-directory (elmo-folder-msgdb-path folder)) + "elmo")))) + (elmo-make-directory temp-dir) + temp-dir)) + +(defun elmo-init () + "Initialize ELMO module." + (elmo-crosspost-message-alist-load) + (elmo-resque-obsolete-variables) + (elmo-dop-queue-load)) + +(defun elmo-quit () + "Quit and cleanup ELMO." +; (setq elmo-newsgroups-hashtb nil) + (elmo-crosspost-message-alist-save) + ;; Not implemented yet. + (let ((types elmo-folder-type-alist) + class) + (while types + (setq class + (luna-find-class + (intern (format "elmo-%s-folder" (symbol-name (cdr (car types))))))) + ;; Call all folder's `elmo-quit' method. + (if class + (dolist (func (luna-class-find-functions class 'elmo-quit)) + (funcall func nil))) + (setq types (cdr types))))) + + +;;; Define folders. +(elmo-define-folder ?% 'imap4) +(elmo-define-folder ?- 'nntp) +(elmo-define-folder ?\+ 'localdir) +(elmo-define-folder ?\* 'multi) +(elmo-define-folder ?\/ 'filter) +(elmo-define-folder ?\$ 'archive) +(elmo-define-folder ?& 'pop3) +(elmo-define-folder ?= 'localnews) +(elmo-define-folder ?| 'pipe) +(elmo-define-folder ?. 'maildir) +(elmo-define-folder ?' 'internal) +(elmo-define-folder ?\[ 'nmz) +(elmo-define-folder ?@ 'shimbun) + +;;; Obsolete variables. +(elmo-define-obsolete-variable 'elmo-default-imap4-mailbox + 'elmo-imap4-default-mailbox) +(elmo-define-obsolete-variable 'elmo-default-imap4-server + 'elmo-imap4-default-server) +(elmo-define-obsolete-variable 'elmo-default-imap4-authenticate-type + 'elmo-imap4-default-authenticate-type) +(elmo-define-obsolete-variable 'elmo-default-imap4-user + 'elmo-imap4-default-user) +(elmo-define-obsolete-variable 'elmo-default-imap4-port + 'elmo-imap4-default-port) +(elmo-define-obsolete-variable 'elmo-default-nntp-server + 'elmo-nntp-default-server) +(elmo-define-obsolete-variable 'elmo-default-nntp-user + 'elmo-nntp-default-user) +(elmo-define-obsolete-variable 'elmo-default-nntp-port + 'elmo-nntp-default-port) +(elmo-define-obsolete-variable 'elmo-default-pop3-server + 'elmo-pop3-default-server) +(elmo-define-obsolete-variable 'elmo-default-pop3-user + 'elmo-pop3-default-user) +(elmo-define-obsolete-variable 'elmo-default-pop3-authenticate-type + 'elmo-pop3-default-authenticate-type) +(elmo-define-obsolete-variable 'elmo-default-pop3-port + 'elmo-pop3-default-port) + +;; autoloads +(autoload 'elmo-dop-queue-flush "elmo-dop") + +(require 'product) +(product-provide (provide 'elmo) (require 'elmo-version)) + +;;; elmo.el ends here diff --git a/elmo/elmo2.el b/elmo/elmo2.el deleted file mode 100644 index b018394..0000000 --- a/elmo/elmo2.el +++ /dev/null @@ -1,945 +0,0 @@ -;;; elmo2.el -- ELMO main file (I don't remember why this is 2). - -;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi - -;; Author: Yuuichi Teranishi -;; 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: -;; - -(require 'elmo-version) ; reduce recursive-load-depth -(require 'elmo-vars) -(require 'elmo-msgdb) -(require 'elmo-cache) -(require 'elmo-util) -(require 'elmo-dop) -;;;(provide 'elmo2) ; circular dependency - -(eval-when-compile - (require 'elmo-localdir) - (require 'elmo-imap4) - (require 'elmo-nntp) - (require 'elmo-pop3) - (require 'elmo-pipe) -; (require 'elmo-multi) - (require 'elmo-filter) - (require 'elmo-archive) - ;(require 'elmo-cache2) - ) - -(if (or (featurep 'dbm) - (featurep 'gnudbm) - (featurep 'berkdb) - (featurep 'berkeley-db)) - (require 'elmo-database)) - -(elmo-define-error 'elmo-error "Error" 'error) -(elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error) -(elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error) -(elmo-define-error 'elmo-imap4-bye-error "IMAP4 BYE response" 'elmo-open-error) - -(defun elmo-quit () - (interactive) - (if (featurep 'elmo-net) - (elmo-network-clear-session-cache)) - (if (get-buffer elmo-work-buf-name) - (kill-buffer elmo-work-buf-name))) - -(defun elmo-cleanup-variables () - (setq elmo-folder-info-hashtb nil - elmo-nntp-groups-hashtb nil - elmo-nntp-list-folders-cache nil - )) - -;; (cons of max . estimated message number) elmo-max-of-folder (folder) -(defun elmo-max-of-folder (folder) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "max-of-folder") - (elmo-dop-max-of-folder folder))) - -;; list elmo-list-folder (folder) -(defun elmo-list-folder (folder &optional nohide) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "list-folder" nohide) - (elmo-dop-list-folder folder nohide))) - -;; list elmo-list-folders (folder) -(defun elmo-list-folders (folder &optional hierarchy) - (elmo-call-func folder "list-folders" hierarchy)) - -;; bool elmo-folder-exists-p (folder) -(defun elmo-folder-exists-p (folder) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "folder-exists-p") - (elmo-dop-folder-exists-p folder))) - -;; bool elmo-folder-creatable-p (folder) -(defun elmo-folder-creatable-p (folder) - (elmo-call-func folder "folder-creatable-p")) - -;; bool elmo-create-folder (folder) -;; create folder -(defun elmo-create-folder (folder) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "create-folder") - (elmo-dop-create-folder folder))) - -(defun elmo-delete-folder (folder) - (let ((type (elmo-folder-get-type folder))) - (if (or (not (memq type '(localdir localnews archive imap4 maildir))) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "delete-folder") - (elmo-dop-delete-folder folder))) - ;; If folder doesn't support delete folder, delete msgdb path only. - (elmo-msgdb-delete-path folder)))) - -(defun elmo-rename-folder (old-folder new-folder) - (let ((old-type (elmo-folder-get-type old-folder)) - (new-type (elmo-folder-get-type new-folder))) - (if (not (eq old-type new-type)) - (error "not same folder type") - (unless (and (memq old-type '(localdir localnews archive imap4)) - (elmo-folder-identical-system-p old-folder new-folder)) - (error "rename folder not supported")) - (if (elmo-folder-plugged-p old-folder) - (and - (if (or (file-exists-p (elmo-msgdb-expand-path new-folder)) - (elmo-folder-exists-p new-folder)) - (error "already exists folder: %s" new-folder) - t) - (elmo-call-func old-folder "rename-folder" - (elmo-folder-get-spec new-folder)) - (elmo-msgdb-rename-path old-folder new-folder)) - (elmo-dop-rename-folder old-folder new-folder))))) - -(defun elmo-read-msg-no-cache (folder msg outbuf &optional unread) - "Read messsage specified by FOLDER and MSG(number) into OUTBUF -without cacheing. -If optional UNREAD is non-nil, message is keeped as unread." - (elmo-call-func folder "read-msg" msg outbuf nil unread)) - -(defun elmo-force-cache-msg (folder number msgid &optional loc-alist) - "Force cache message." - (let* ((cache-file (elmo-cache-get-path msgid)) - dir) - (when cache-file - (setq dir (directory-file-name (file-name-directory cache-file))) - (if (not (file-exists-p dir)) - (elmo-make-directory dir)) - (if (elmo-local-file-p folder number) - (elmo-copy-file (elmo-get-msg-filename folder number loc-alist) - cache-file) - (with-temp-buffer - (elmo-call-func folder "read-msg" number (current-buffer)) - (as-binary-output-file - (write-region (point-min) (point-max) cache-file nil 'no-msg))))))) - -(defun elmo-prefetch-msg (folder msg outbuf msgdb) - "Read message into outbuf with cacheing." - (save-excursion - (let* ((number-alist (elmo-msgdb-get-number-alist - (or msgdb (elmo-msgdb-load folder)))) - (dir (elmo-msgdb-expand-path folder)) - (message-id (cdr (assq msg number-alist))) - type - cache-status - ret-val part-num real-fld-num) - (set-buffer outbuf) - (if (elmo-cache-exists-p message-id) - t - ;; cache doesn't exist. - (setq real-fld-num (elmo-get-real-folder-number - folder msg)) - (setq type (elmo-folder-get-type (car real-fld-num))) - (cond ((eq type 'imap4) - (setq ret-val (elmo-imap4-prefetch-msg - (elmo-folder-get-spec (car real-fld-num)) - (cdr real-fld-num) - outbuf))) - ((elmo-folder-local-p (car real-fld-num))) - (t (setq ret-val (elmo-call-func (car real-fld-num) - "read-msg" - (cdr real-fld-num) - outbuf - nil 'unread)))) - (if ret-val - (elmo-cache-save message-id - (elmo-string-partial-p ret-val) - folder msg)) - (and ret-val t))))) - -(defun elmo-prefetch-msgs (folder msgs) - "prefetch messages for queueing." - (let* ((msgdb (elmo-msgdb-load folder)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (len (length msgs)) - (count 0) - msgid msg) - (while msgs - (setq msg (car msgs)) - (setq msgid (cdr (assq msg number-alist))) - (message "%s:Prefetching... %d/%d message(s)" - folder - (setq count (+ 1 count)) len) - (elmo-force-cache-msg folder msg msgid) - (setq msgs (cdr msgs))))) - -;; elmo-read-msg (folder msg outbuf msgdb) -;;; read message -(defun elmo-read-msg (folder msg outbuf msgdb &optional force-reload unread) - "Read message into outbuf." - (let ((inhibit-read-only t)) - (if elmo-inhibit-read-cache - ;;Only use elmo-read-msg-with-cache, because if folder is network and - ;;elmo-use-cache-p is nil, cannot read important msg. (by muse) - ;;(if (not (elmo-use-cache-p folder msg)) - (elmo-read-msg-no-cache folder msg outbuf unread) - (elmo-read-msg-with-cache folder msg outbuf msgdb force-reload unread)))) - -(defun elmo-read-msg-with-cache (folder msg outbuf msgdb - &optional force-reload unread) - "Read message into outbuf with cacheing." - (let* ((number-alist (elmo-msgdb-get-number-alist - (or msgdb (elmo-msgdb-load folder)))) - (dir (elmo-msgdb-expand-path folder)) - (message-id (cdr (assq msg number-alist))) - (type (elmo-folder-number-get-type folder msg)) - cache-status - ret-val part-num real-fld-num) - (set-buffer outbuf) - (if (and (not force-reload) - (not (elmo-local-file-p folder msg))) - (setq ret-val (elmo-cache-read message-id folder msg))) - (if ret-val - t - ;; cache doesn't exist. - (setq real-fld-num (elmo-get-real-folder-number - folder msg)) - (if (setq ret-val (elmo-call-func (car real-fld-num) - "read-msg" - (cdr real-fld-num) outbuf - nil unread)) - (if (and message-id - (not (elmo-local-file-p folder msg)) - (elmo-use-cache-p folder msg)) - (elmo-cache-save message-id - (elmo-string-partial-p ret-val) - folder msg))) - (and ret-val t)))) - -(defun elmo-copy-msgs (src-folder msgs dst-folder &optional msgdb same-number) - (let* ((src-spec (elmo-folder-get-spec src-folder)) - (loc-alist (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load - (elmo-msgdb-expand-path src-spec))))) - (if (eq (car src-spec) 'archive) - (elmo-archive-copy-msgs-froms - (elmo-folder-get-spec dst-folder) - msgs src-spec loc-alist same-number) - (elmo-call-func dst-folder "copy-msgs" - msgs src-spec loc-alist same-number)))) - -(defun elmo-move-msgs (src-folder msgs dst-folder - &optional msgdb all done - no-delete-info - no-delete - same-number - unread-marks) - (save-excursion - (let* ((db (or msgdb (elmo-msgdb-load src-folder))) - (number-alist (elmo-msgdb-get-number-alist db)) - (mark-alist (elmo-msgdb-get-mark-alist db)) - (messages msgs) - (elmo-inhibit-display-retrieval-progress t) - (len (length msgs)) - (all-msg-num (or all len)) - (done-msg-num (or done 0)) - (progress-message (if no-delete - "Copying messages..." - "Moving messages...")) - (tmp-buf (get-buffer-create " *elmo-move-msg*")) - ;elmo-no-cache-flag - ret-val real-fld-num done-copy dir pair - mes-string message-id src-cache i unseen seen-list) - (setq i done-msg-num) - (set-buffer tmp-buf) - (when (and (not (eq dst-folder 'null)) - (elmo-folder-direct-copy-p src-folder dst-folder)) - (message (concat (if no-delete "Copying" "Moving") - " %d message(s)...") (length messages)) - (unless (elmo-copy-msgs src-folder - messages - dst-folder - db - same-number) - (error "Copy message to %s failed" dst-folder)) - (setq done-copy t)) - (while messages - (setq real-fld-num (elmo-get-real-folder-number src-folder - (car messages))) - (setq message-id (cdr (setq pair (assq (car messages) number-alist)))) - ;; seen-list. - (if (and (not (eq dst-folder 'null)) - (not (and unread-marks - (setq unseen - (member - (cadr (assq (car messages) mark-alist)) - unread-marks))))) - (setq seen-list (cons message-id seen-list))) - (unless (or (eq dst-folder 'null) done-copy) - (if (and (elmo-folder-plugged-p src-folder) - (elmo-folder-plugged-p dst-folder) - (elmo-folder-identical-system-p (car real-fld-num) - dst-folder)) - ;; online and identical system...so copy 'em! - (unless - (elmo-copy-msgs (car real-fld-num) - (list (cdr real-fld-num)) - dst-folder - db - same-number) - (error "Copy message to %s failed" dst-folder)) - ;; use cache if exists. - ;; if there's other message with same message-id, - ;; don't use cache. - (elmo-read-msg src-folder (car messages) - tmp-buf msgdb - (and (elmo-folder-plugged-p src-folder) - (and pair - (or - (rassoc - message-id - (cdr (memq pair number-alist))) - (not (eq pair - (rassoc message-id - number-alist))))))) - (unless (eq (buffer-size) 0) - (unless (elmo-append-msg dst-folder (buffer-string) message-id - (if same-number (car messages)) - ;; null means all unread. - (or (null unread-marks) - unseen)) - (error "move: append message to %s failed" dst-folder))))) - ;; delete src cache if it is partial. - (elmo-cache-delete-partial message-id src-folder (car messages)) - (setq ret-val (nconc ret-val (list (car messages)))) - (when (> all-msg-num elmo-display-progress-threshold) - (setq i (+ i 1)) - (elmo-display-progress - 'elmo-move-msgs progress-message - (/ (* i 100) all-msg-num))) - (setq messages (cdr messages))) - ;; Save seen-list. - (unless (eq dst-folder 'null) - (setq dir (elmo-msgdb-expand-path dst-folder)) - (elmo-msgdb-seen-save dir - (append (elmo-msgdb-seen-load dir) seen-list))) - (kill-buffer tmp-buf) - (if (and (not no-delete) ret-val) - (progn - (if (not no-delete-info) - (message "Cleaning up src folder...")) - (if (and (elmo-delete-msgs src-folder ret-val db) - (elmo-msgdb-delete-msgs src-folder ret-val db t)) - (setq ret-val t) - (message "move: delete messages from %s failed." src-folder) - (setq ret-val nil) - ) - (if (and ret-val - (not no-delete-info)) - (message "Cleaning up src folder...done") - ) - ret-val) - (if no-delete - (progn - (message "Copying messages...done") - t) - (if (eq len 0) - (message "No message was moved.") - (message "Moving messages failed.") - nil ; failure - )))))) - -;; boolean elmo-delete-msgs (folder msgs) -(defun elmo-delete-msgs (folder msgs &optional msgdb) - ;; remove from real folder. - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "delete-msgs" msgs) - (elmo-dop-delete-msgs folder msgs msgdb))) - -(defun elmo-search (folder condition &optional from-msgs) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "search" condition from-msgs) - (elmo-cache-search-all folder condition from-msgs))) - -(defun elmo-msgdb-search (folder condition msgdb) - "Search messages which satisfy CONDITION from FOLDER with MSGDB." - (let* ((condition (car (elmo-parse-search-condition condition))) - (overview (elmo-msgdb-get-overview msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (number-list (mapcar 'car number-alist)) - (length (length overview)) - (i 0) - result) - (if (elmo-condition-find-key condition "body") - (elmo-search folder condition number-list) - (while overview - (if (elmo-msgdb-search-internal condition (car overview) - number-list) - (setq result - (cons - (elmo-msgdb-overview-entity-get-number (car overview)) - result))) - (setq i (1+ i)) - (elmo-display-progress - 'elmo-msgdb-search "Searching..." (/ (* i 100) length)) - (setq overview (cdr overview))) - (nreverse result)))) - -(defun elmo-msgdb-create (folder numlist new-mark already-mark - seen-mark important-mark seen-list) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "msgdb-create" numlist new-mark already-mark - seen-mark important-mark seen-list) - (elmo-dop-msgdb-create folder numlist new-mark already-mark - seen-mark important-mark seen-list))) - -(defun elmo-make-folder-numbers-list (folder msgs) - (let ((msg-list msgs) - pair fld-list - ret-val) - (while msg-list - (when (and (numberp (car msg-list)) - (> (car msg-list) 0)) - (setq pair (elmo-get-real-folder-number folder (car msg-list))) - (if (setq fld-list (assoc (car pair) ret-val)) - (setcdr fld-list (cons (cdr pair) (cdr fld-list))) - (setq ret-val (cons (cons (car pair) (list (cdr pair))) ret-val)))) - (setq msg-list (cdr msg-list))) - ret-val)) - -(defun elmo-call-func-on-markable-msgs (folder func-name msgs msgdb) - "Returns t if marked." - (save-match-data - (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs)) - type error) - (while folder-numbers - (if (or (eq - (setq type (car - (elmo-folder-get-spec - (car (car folder-numbers))))) - 'imap4) - (memq type '(maildir internal))) - (if (elmo-folder-plugged-p folder) - (elmo-call-func (car (car folder-numbers)) func-name - (cdr (car folder-numbers))) - (if elmo-enable-disconnected-operation - (elmo-dop-call-func-on-msgs - (car (car folder-numbers)) ; real folder - func-name - (cdr (car folder-numbers)) ; real number - msgdb) - (setq error t)))) - (setq folder-numbers (cdr folder-numbers))) - (not error)))) - -(defun elmo-unmark-important (folder msgs msgdb) - (elmo-call-func-on-markable-msgs folder "unmark-important" msgs msgdb)) - -(defun elmo-mark-as-important (folder msgs msgdb) - (elmo-call-func-on-markable-msgs folder "mark-as-important" msgs msgdb)) - -(defun elmo-mark-as-read (folder msgs msgdb) - (elmo-call-func-on-markable-msgs folder "mark-as-read" msgs msgdb)) - -(defun elmo-mark-as-unread (folder msgs msgdb) - (elmo-call-func-on-markable-msgs folder "mark-as-unread" msgs msgdb)) - -(defun elmo-msgdb-create-as-numlist (folder numlist new-mark already-mark - seen-mark important-mark seen-list) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "msgdb-create-as-numlist" numlist - new-mark already-mark seen-mark important-mark seen-list) - (elmo-dop-msgdb-create-as-numlist - folder numlist new-mark already-mark - seen-mark important-mark seen-list))) - -;; msgdb elmo-msgdb-load (folder) -(defun elmo-msgdb-load (folder) - (message "Loading msgdb for %s..." folder) - (let* ((path (elmo-msgdb-expand-path folder)) - (overview (elmo-msgdb-overview-load path)) - (ret-val - (list overview - (elmo-msgdb-number-load path) - (elmo-msgdb-mark-load path) - (elmo-msgdb-location-load path) - (elmo-msgdb-make-overview-hashtb overview) - ))) - (message "Loading msgdb for %s...done" folder) - (elmo-folder-set-info-max-by-numdb folder (nth 1 ret-val)) - ret-val)) - -;; boolean elmo-msgdb-save (folder msgdb) -(defun elmo-msgdb-save (folder msgdb) - (message "Saving msgdb for %s..." folder) - (save-excursion - (let ((path (elmo-msgdb-expand-path folder))) - (elmo-msgdb-overview-save path (car msgdb)) - (elmo-msgdb-number-save path (cadr msgdb)) - (elmo-msgdb-mark-save path (caddr msgdb)) - (elmo-msgdb-location-save path (cadddr msgdb)) - ;(elmo-sync-validity folder);; for validity check!! - )) - (message "Saving msgdb for %s...done" folder) - (elmo-folder-set-info-max-by-numdb folder (cadr msgdb))) - -(defun elmo-msgdb-add-msgs-to-seen-list-subr (msgs msgdb seen-marks seen-list) - "Add to seen list." - (let* ((seen-mark-list (string-to-char-list seen-marks)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - ent) - (while msgs - (if (setq ent (assq (car msgs) mark-alist)) - (if (memq (string-to-char (cadr ent)) seen-mark-list) - (setq seen-list - (cons (cdr (assq (car msgs) number-alist)) seen-list))) - ;; no mark ... seen... - (setq seen-list - (cons (cdr (assq (car msgs) number-alist)) seen-list))) - (setq msgs (cdr msgs))) - seen-list)) - -(defun elmo-msgdb-add-msgs-to-seen-list (folder msgs msgdb seen-marks) - "Add to seen list." - (unless (eq folder 'null) ;; black hole - (let* ((dir (elmo-msgdb-expand-path folder)) - (seen-list (elmo-msgdb-seen-load dir))) - (setq seen-list - (elmo-msgdb-add-msgs-to-seen-list-subr - msgs msgdb seen-marks seen-list)) - (elmo-msgdb-seen-save dir seen-list)))) - -;; msgdb elmo-append-msg (folder string) -(defun elmo-append-msg (folder string &optional message-id msg no-see) - (let ((type (elmo-folder-get-type folder)) - filename) - (cond ((eq type 'imap4) - (if (elmo-folder-plugged-p folder) - (elmo-call-func folder "append-msg" string msg no-see) - (elmo-dop-append-msg folder string message-id))) - ((eq type 'cache) - (if message-id - (elmo-cache-append-msg - (elmo-folder-get-spec folder) - string message-id msg no-see) - (error "elmo-cache-append-msg require message-id"))) - (t - (elmo-call-func folder "append-msg" string msg no-see))))) - -(defun elmo-check-validity (folder) - (elmo-call-func folder "check-validity" - (expand-file-name - elmo-msgdb-validity-filename - (elmo-msgdb-expand-path folder)))) - -(defun elmo-pack-number (folder msgdb arg) - (let ((type (elmo-folder-get-type folder))) - (if (memq type '(localdir localnews maildir)) - (elmo-call-func folder "pack-number" msgdb arg) - (error "pack-number not supported")))) - -(defun elmo-sync-validity (folder) - (elmo-call-func folder "sync-validity" - (expand-file-name - elmo-msgdb-validity-filename - (elmo-msgdb-expand-path folder)))) - -(defun elmo-use-cache-p (folder number) - (elmo-call-func folder "use-cache-p" number) - ) - -(defun elmo-local-file-p (folder number) - (elmo-call-func folder "local-file-p" number)) - -(defun elmo-folder-portinfo (folder) - (condition-case nil - (elmo-call-func folder "portinfo") - (error))) - -(defun elmo-folder-plugged-p (folder) - (and folder - (or (elmo-folder-local-p folder) - (elmo-call-func folder "plugged-p")))) - -(defun elmo-folder-set-plugged (folder plugged &optional add) - (if (elmo-folder-local-p folder) - nil ;; nop - (elmo-call-func folder "set-plugged" plugged add))) - -(defun elmo-generic-sync-number-alist (spec number-alist) - "Just return number-alist." - number-alist) - -(defun elmo-generic-list-folder-important (spec number-alist) - nil) - -(defun elmo-update-number (folder msgdb) - (when (elmo-folder-plugged-p folder) - (message "Synchronize number...") - (let* ((numlist (elmo-msgdb-get-number-alist msgdb)) - (len (length numlist)) - new-numlist) - (if (eq (length (setq - new-numlist - (elmo-call-func folder "sync-number-alist" numlist))) - len) - nil - (elmo-msgdb-set-number-alist msgdb new-numlist) - (message "Synchronize number...done") - new-numlist)))) - -(defun elmo-get-msg-filename (folder number &optional loc-alist) - "Available if elmo-local-file-p is t." - (elmo-call-func folder "get-msg-filename" number loc-alist)) - -(defun elmo-strict-folder-diff (fld &optional number-alist) - (interactive) - (let* ((dir (elmo-msgdb-expand-path fld)) - (nalist (or number-alist - (elmo-msgdb-number-load dir))) - (in-db (sort (mapcar 'car nalist) '<)) - (in-folder (elmo-list-folder fld)) - append-list delete-list diff) - (cons (if (equal in-folder in-db) - 0 - (setq diff (elmo-list-diff - in-folder in-db - nil - )) - (setq append-list (car diff)) - (setq delete-list (cadr diff)) - (if append-list - (length append-list) - (if delete-list - (- 0 (length delete-list)) - 0))) - (length in-folder)))) - -(defun elmo-list-folder-unread (folder number-alist mark-alist unread-marks) - (elmo-call-func folder "list-folder-unread" - number-alist mark-alist unread-marks)) - -(defun elmo-list-folder-important (folder number-alist) - (let (importants) - ;; Server side importants...(append only.) - (if (elmo-folder-plugged-p folder) - (setq importants (elmo-call-func folder "list-folder-important" - number-alist))) - (or elmo-msgdb-global-mark-alist - (setq elmo-msgdb-global-mark-alist - (elmo-object-load (expand-file-name - elmo-msgdb-global-mark-filename - elmo-msgdb-dir)))) - (while number-alist - (if (assoc (cdr (car number-alist)) - elmo-msgdb-global-mark-alist) - (setq importants (cons (car (car number-alist)) importants))) - (setq number-alist (cdr number-alist))) - importants)) - -(defun elmo-generic-commit (folder) - nil) - -(defun elmo-commit (folder) - (elmo-call-func folder "commit")) - -(defun elmo-clear-killed (folder) - (elmo-msgdb-killed-list-save (elmo-msgdb-expand-path folder) nil)) - -(defvar elmo-folder-diff-async-callback nil) -(defvar elmo-folder-diff-async-callback-data nil) - -(defun elmo-folder-diff-async (folder) - "Get diff of FOLDER asynchronously. -`elmo-folder-diff-async-callback' is called with arguments of -FOLDER and DIFF (cons cell of UNSEEN and MESSAGES). -Currently works on IMAP4 folder only." - (if (eq (elmo-folder-get-type folder) 'imap4) - ;; Only works on imap4 with server diff. - (progn - (setq elmo-imap4-server-diff-async-callback - elmo-folder-diff-async-callback) - (setq elmo-imap4-server-diff-async-callback-data - elmo-folder-diff-async-callback-data) - (elmo-imap4-server-diff-async (elmo-folder-get-spec folder))) - (and elmo-folder-diff-async-callback - (funcall elmo-folder-diff-async-callback - folder - (elmo-folder-diff folder))))) - -(defun elmo-folder-diff (folder &optional number-list) - "Get diff of FOLDER. -Return value is a cons cell of NEW and MESSAGES. -If optional argumnet NUMBER-LIST is set, it is used as a -message list in msgdb. Otherwise, number-list is load from msgdb." - (elmo-call-func folder "folder-diff" folder number-list)) - -(defun elmo-crosspost-message-set (message-id folders &optional type) - (if (assoc message-id elmo-crosspost-message-alist) - (setcdr (assoc message-id elmo-crosspost-message-alist) - (list folders type)) - (setq elmo-crosspost-message-alist - (nconc elmo-crosspost-message-alist - (list (list message-id folders type)))))) - -(defun elmo-crosspost-message-delete (message-id folders) - (let* ((id-fld (assoc message-id elmo-crosspost-message-alist)) - (folder-list (nth 1 id-fld))) - (when id-fld - (if (setq folder-list (elmo-list-delete folders folder-list)) - (setcar (cdr id-fld) folder-list) - (setq elmo-crosspost-message-alist - (delete id-fld elmo-crosspost-message-alist)))))) - - -(defun elmo-get-msgs-with-mark (mark-alist mark) - (let (ret-val) - (while mark-alist - (if (string= (cadr (car mark-alist)) mark) - (cons (car (car mark-alist)) ret-val)) - (setq mark-alist (cdr mark-alist))) - (nreverse ret-val))) - -(defun elmo-buffer-cache-message (fld msg &optional msgdb force-reload unread) - (let* ((msg-id (cdr (assq msg (elmo-msgdb-get-number-alist msgdb)))) - (hit (elmo-buffer-cache-hit (list fld msg msg-id))) - (read nil)) - (if hit - (elmo-buffer-cache-sort - (elmo-buffer-cache-entry-make (list fld msg msg-id) hit)) - (setq hit (elmo-buffer-cache-add (list fld msg msg-id))) - (setq read t)) - (if (or force-reload read) - (condition-case err - (save-excursion - (set-buffer hit) - (elmo-read-msg fld msg - (current-buffer) - msgdb force-reload - unread)) - (quit - (elmo-buffer-cache-delete) - (error "read message %s/%s is quitted" fld msg)) - (error - (elmo-buffer-cache-delete) - (signal (car err) (cdr err)) - nil))) ;; will not be used - hit)) ;; retrun value - -(defun elmo-read-msg-with-buffer-cache (fld msg outbuf msgdb &optional force-reload) - (if elmo-use-buffer-cache - (let (hit start end) - (when (setq hit (elmo-buffer-cache-message - (elmo-string fld) msg - msgdb force-reload)) - (erase-buffer) - (save-excursion - (set-buffer hit) - (setq start (point-min) end (point-max))) - (insert-buffer-substring hit start end))) - (elmo-read-msg fld msg outbuf msgdb force-reload))) - -(defun elmo-folder-pipe-p (folder) - (let ((type (elmo-folder-get-type folder))) - (cond - ((eq type 'multi) - (let ((flds (cdr (elmo-folder-get-spec folder)))) - (catch 'done - (while flds - (if (elmo-folder-pipe-p (car flds)) - (throw 'done t))) - nil))) - ((eq type 'pipe) - t) - ((eq type 'filter) - (elmo-folder-pipe-p - (nth 2 (elmo-folder-get-spec folder)))) - (t - nil - )))) - -(defun elmo-multi-p (folder) - (let ((type (elmo-folder-get-type folder))) - (cond - ((eq type 'multi) - t) - ((eq type 'pipe) - (elmo-multi-p - (elmo-pipe-spec-dst (elmo-folder-get-spec folder)))) - ((eq type 'filter) - (elmo-multi-p - (nth 2 (elmo-folder-get-spec folder)))) - (t - nil - )))) - -(defun elmo-get-real-folder-number (folder number) - (let ((type (elmo-folder-get-type folder))) - (cond - ((eq type 'multi) - (elmo-multi-get-real-folder-number folder number)) - ((eq type 'pipe) - (elmo-get-real-folder-number - (elmo-pipe-spec-dst (elmo-folder-get-spec folder) ) - number)) - ((eq type 'filter) - (elmo-get-real-folder-number - (nth 2 (elmo-folder-get-spec folder)) number)) - (t - (cons folder number) - )))) - -(defun elmo-folder-get-primitive-spec-list (folder &optional spec-list) - (let ((type (elmo-folder-get-type folder)) - specs) - (cond - ((or (eq type 'multi) - (eq type 'pipe)) - (let ((flds (cdr (elmo-folder-get-spec folder))) - spec) - (while flds - (setq spec (elmo-folder-get-primitive-spec-list (car flds))) - (if (not (memq (car spec) specs)) - (setq specs (append specs spec))) - (setq flds (cdr flds))))) - ((eq type 'filter) - (setq specs - (elmo-folder-get-primitive-spec-list - (nth 2 (elmo-folder-get-spec folder))))) - (t - (setq specs (list (elmo-folder-get-spec folder))) - )) - specs)) - -(defun elmo-folder-get-primitive-folder-list (folder) - (let* ((type (elmo-folder-get-type folder))) - (cond - ((or (eq type 'multi) - (eq type 'pipe)) - (let ((flds (cdr (elmo-folder-get-spec folder))) - ret-val) - (while flds - (setq ret-val (append ret-val - (elmo-folder-get-primitive-folder-list - (car flds)))) - (setq flds (cdr flds))) - ret-val)) - ((eq type 'filter) - (elmo-folder-get-primitive-folder-list - (nth 2 (elmo-folder-get-spec folder)))) - (t - (list folder) - )))) - -(defun elmo-folder-contains-multi (folder) - (let ((cur-spec (elmo-folder-get-spec folder))) - (catch 'done - (while cur-spec - (cond - ((eq (car cur-spec) 'filter) - (setq cur-spec (elmo-folder-get-spec (nth 2 cur-spec)))) - ((eq (car cur-spec) 'pipe) - (setq cur-spec (elmo-folder-get-spec (elmo-pipe-spec-src cur-spec)))) - ((eq (car cur-spec) 'multi) - (throw 'done nil)) - (t (setq cur-spec nil))))) - cur-spec)) - -(defun elmo-folder-contains-type (folder type) - (let ((spec (elmo-folder-get-spec folder))) - (cond - ((eq (car spec) 'filter) - (elmo-folder-contains-type (nth 2 spec) type)) - ((eq (car spec) 'pipe) - (elmo-folder-contains-type (elmo-pipe-spec-dst spec) type)) - ((eq (car spec) 'multi) - (let ((folders (cdr spec))) - (catch 'done - (while folders - (if (elmo-folder-contains-type (car folders) type) - (throw 'done t)) - (setq folders (cdr folders)))))) - ((eq (car spec) type) - t) - (t nil)))) - -(defun elmo-folder-number-get-spec (folder number) - (let ((type (elmo-folder-get-type folder))) - (cond - ((eq type 'multi) - (elmo-multi-folder-number-get-spec folder number)) - ((eq type 'pipe) - (elmo-folder-number-get-spec - (elmo-pipe-spec-dst (elmo-folder-get-spec folder)) number)) - ((eq type 'filter) - (elmo-folder-number-get-spec - (nth 2 (elmo-folder-get-spec folder)) number)) - (t - (elmo-folder-get-spec folder) - )))) - -(defun elmo-folder-number-get-type (folder number) - (car (elmo-folder-number-get-spec folder number))) - -(defun elmo-multi-folder-number-get-spec (folder number) - (let* ((spec (elmo-folder-get-spec folder)) - (flds (cdr spec)) - (fld (nth (- (/ number elmo-multi-divide-number) 1) flds))) - (elmo-folder-number-get-spec fld number))) - -(defun elmo-msgdb-list-messages-mark-match (msgdb mark-regexp) - "List messages in the FOLDER which have a mark that matches MARK-REGEXP" - (let ((case-fold-search nil) - matched) - (if mark-regexp - (dolist (elem (elmo-msgdb-get-mark-alist msgdb)) - (if (string-match mark-regexp (cadr elem)) - (setq matched (cons (car elem) matched))))) - matched)) - -;; autoloads -(autoload 'elmo-nntp-make-groups-hashtb "elmo-nntp") -(autoload 'elmo-nntp-post "elmo-nntp") -(autoload 'elmo-localdir-max-of-folder "elmo-localdir") -(autoload 'elmo-localdir-msgdb-create-overview-entity-from-file "elmo-localdir") -(autoload 'elmo-archive-copy-msgs-froms "elmo-archive") - -(require 'product) -(product-provide (provide 'elmo2) (require 'elmo-version)) - -;;; elmo2.el ends here diff --git a/elmo/mmelmo-imap4.el b/elmo/mmelmo-imap4.el deleted file mode 100644 index c351cb9..0000000 --- a/elmo/mmelmo-imap4.el +++ /dev/null @@ -1,359 +0,0 @@ -;;; mmelmo-imap4.el -- MM backend of IMAP4 for ELMO. - -;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi - -;; Author: Yuuichi Teranishi -;; 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: -;; - -(require 'mmbuffer) - -(require 'mmelmo) - -(defvar mmelmo-imap4-threshold nil) -(defvar mmelmo-imap4-skipped-parts nil) -(defvar mmelmo-imap4-current-message-structure nil) - -;; Buffer local variable. -(defvar mmelmo-imap4-fetched nil) -(make-variable-buffer-local 'mmelmo-imap4-fetched) - -(defun mmelmo-imap4-node-id-to-string (node-id) - (let ((i (length node-id)) - result) - (while (> i 0) - (setq result - (concat result - (if result - (concat "." (int-to-string - (+ 1 (nth (- i 1) node-id)))) - (int-to-string (or - (+ 1 (nth (- i 1) node-id)) - 0))))) - (setq i (- i 1))) - (or result "0"))) - -;; parse IMAP4 body structure entity recursively. -(defun mmelmo-imap4-parse-bodystructure-object (folder - number msgdb - node-id object parent) - (cond - ((listp (car object));; multipart - (let (cur-obj children content-type ret-val (num 0)) - (setq ret-val - (luna-make-entity - (mm-expand-class-name 'elmo-imap4) - :folder folder - :number number - :msgdb msgdb - :parent parent - :node-id node-id)) - (while (and (setq cur-obj (car object)) - (listp cur-obj)) - (setq children - (append children - (list - (mmelmo-imap4-parse-bodystructure-object - folder number msgdb - (append (list num) node-id) - cur-obj - ret-val ; myself as parent - )))) - (setq num (+ num 1)) - (setq object (cdr object))) - (mime-entity-set-children-internal ret-val children) - (setq content-type (list (cons 'type 'multipart))) - (if (elmo-imap4-nth 0 object) - (setq content-type (append content-type - (list (cons 'subtype - (intern - (downcase - (elmo-imap4-nth - 0 - object)))))))) - (setq content-type (append content-type - (mime-parse-parameters-from-list - (elmo-imap4-nth 1 object)))) - (mime-entity-set-content-type-internal ret-val content-type) - ret-val)) - (t ;; singlepart - (let (content-type ret-val) - ;; append size information into location - (setq content-type (list (cons 'type (intern (downcase (car object)))))) - (if (elmo-imap4-nth 1 object) - (setq content-type (append content-type - (list - (cons 'subtype - (intern - (downcase - (elmo-imap4-nth 1 object)))))))) - (if (elmo-imap4-nth 2 object) - (setq content-type (append content-type - (mime-parse-parameters-from-list - (elmo-imap4-nth 2 object))))) - (setq ret-val - (luna-make-entity - (mm-expand-class-name 'elmo-imap4) - :folder folder - :number number - :size (nth 6 object) - :content-type content-type - :parent parent - :node-id node-id)) - (mime-entity-set-encoding-internal ret-val - (and (elmo-imap4-nth 5 object) - (downcase - (elmo-imap4-nth 5 object)))) - ret-val)))) - -(defun mmelmo-imap4-multipart-p (entity) - (eq (cdr (assq 'type (mime-entity-content-type entity))) 'multipart)) - -(defun mmelmo-imap4-rfc822part-p (entity) - (eq (cdr (assq 'type (mime-entity-content-type entity))) 'rfc822)) - -(defun mmelmo-imap4-textpart-p (entity) - (eq (cdr (assq 'type (mime-entity-content-type entity))) 'text)) - -(defun mmelmo-imap4-get-mime-entity (folder number msgdb) - (let* ((spec (elmo-folder-get-spec folder)) - (session (elmo-imap4-get-session spec))) - (elmo-imap4-session-select-mailbox session (elmo-imap4-spec-mailbox spec)) - (with-current-buffer (elmo-network-session-buffer session) - (setq elmo-imap4-fetch-callback nil) - (setq elmo-imap4-fetch-callback-data nil)) - (mmelmo-imap4-parse-bodystructure-object - folder - number - msgdb - nil ; node-id - (elmo-imap4-response-value - (elmo-imap4-response-value - (elmo-imap4-send-command-wait - session - (format - (if elmo-imap4-use-uid - "uid fetch %s bodystructure" - "fetch %s bodystructure") - number)) 'fetch) 'bodystructure) - nil ; parent - ))) - -(defun mmelmo-imap4-read-part (entity) - (if (or (not mmelmo-imap4-threshold) - (not (mime-elmo-entity-size-internal entity)) - (and (mime-elmo-entity-size-internal entity) - mmelmo-imap4-threshold - (<= (mime-elmo-entity-size-internal entity) - mmelmo-imap4-threshold))) - (progn - (cond ((mmelmo-imap4-multipart-p entity)) ; noop - (t (insert (elmo-imap4-read-part - (mime-elmo-entity-folder-internal entity) - (mime-elmo-entity-number-internal entity) - (mmelmo-imap4-node-id-to-string - (mime-entity-node-id-internal entity)))))) - (setq mmelmo-imap4-fetched t) - (mime-buffer-entity-set-body-start-internal entity (point-min)) - (mime-buffer-entity-set-body-end-internal entity (point-max))) - (setq mmelmo-imap4-fetched nil) - (mime-buffer-entity-set-body-start-internal entity (point-min)) - (mime-buffer-entity-set-body-end-internal entity (point-min)) - (setq mmelmo-imap4-skipped-parts - (append - mmelmo-imap4-skipped-parts - (list (mmelmo-imap4-node-id-to-string - (mime-entity-node-id-internal entity))))))) - -(defun mmelmo-imap4-insert-body (entity) - (mime-buffer-entity-set-body-start-internal entity (- (point) 1)) - (if (or (not mmelmo-imap4-threshold) - (not (mime-elmo-entity-size-internal entity)) - (and (mime-elmo-entity-size-internal entity) - mmelmo-imap4-threshold - (<= (mime-elmo-entity-size-internal entity) - mmelmo-imap4-threshold))) - (insert (elmo-imap4-read-part - (mime-elmo-entity-folder-internal entity) - (mime-elmo-entity-number-internal entity) "1")) - (setq mmelmo-imap4-skipped-parts - (append - mmelmo-imap4-skipped-parts - (list (mmelmo-imap4-node-id-to-string - (mime-entity-node-id-internal entity))))))) - -;;; mime-elmo-imap4-entity class definitions. -(luna-define-class mime-elmo-imap4-entity (mime-buffer-entity) - (imap folder number msgdb size)) -(luna-define-internal-accessors 'mime-elmo-imap4-entity) - -(luna-define-method initialize-instance ((entity mime-elmo-imap4-entity) - &rest init-args) - "The initialization method for elmo-imap4. -mime-elmo-entity has its own instance variable -`imap', `folder', `msgdb', and `size'. -These value must be specified as argument for `luna-make-entity'." - (apply (car (luna-class-find-functions - (luna-find-class 'standard-object) - 'initialize-instance)) - entity init-args)) - -(defun mmelmo-imap4-mime-entity-buffer (entity) - (if (mime-buffer-entity-buffer-internal entity) - (save-excursion - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (unless (mime-root-entity-p entity) - (unless mmelmo-imap4-fetched - (setq mmelmo-imap4-skipped-parts nil) ; No need? - (let ((mmelmo-imap4-threshold - (mime-elmo-entity-size-internal entity))) - (mime-buffer-entity-set-buffer-internal entity nil) - (message "Fetching skipped part...") - (mmelmo-imap4-mime-entity-buffer entity) - (message "Fetching skipped part...done.")) - (setq mmelmo-imap4-fetched t))) - (mime-buffer-entity-buffer-internal entity)) - ;; No buffer exist. - (save-excursion - (set-buffer (get-buffer-create - (concat mmelmo-entity-buffer-name - (mmelmo-imap4-node-id-to-string - (mime-entity-node-id-internal entity))))) - (mmelmo-original-mode) - (mime-buffer-entity-set-buffer-internal entity (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (mime-entity-node-id entity) - (if (mime-root-entity-p entity) - (progn - ;; root entity - (setq mmelmo-imap4-current-message-structure entity) - (setq mime-message-structure entity) - (setq mmelmo-imap4-skipped-parts nil) - ;; insert header - (insert (elmo-imap4-read-part - (mime-elmo-entity-folder-internal entity) - (mime-elmo-entity-number-internal entity) - "header")) - (mime-buffer-entity-set-header-start-internal - entity (point-min)) - (mime-buffer-entity-set-header-end-internal - entity (max (- (point) 1) 1)) - (if (null (mime-entity-children-internal entity)) - (progn - (mime-buffer-entity-set-body-start-internal - entity (point)) - ;; insert body if size is OK. - (mmelmo-imap4-insert-body entity) - (mime-buffer-entity-set-body-end-internal - entity (point))))) - (setq mime-message-structure - mmelmo-imap4-current-message-structure) - (mmelmo-imap4-read-part entity))) - (current-buffer)))) - -; mime-entity-children -(luna-define-method mime-entity-children ((entity - mime-elmo-imap4-entity)) - (mime-entity-children-internal entity)) - -;; override generic function for dynamic body fetching. -(luna-define-method mime-entity-body ((entity - mime-elmo-imap4-entity)) - (save-excursion - (set-buffer (mmelmo-imap4-mime-entity-buffer entity)) - (buffer-substring (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity)))) - -(luna-define-method mime-entity-content ((entity - mime-elmo-imap4-entity)) - (save-excursion - (set-buffer (mmelmo-imap4-mime-entity-buffer entity)) - (mime-decode-string - (buffer-substring (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity)) - (mime-entity-encoding entity)))) - -(luna-define-method mime-entity-fetch-field ((entity mime-elmo-imap4-entity) - field-name) - (save-excursion - (save-restriction - (when (mime-buffer-entity-buffer-internal entity) - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (if (and (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-header-end-internal entity)) - (progn - (narrow-to-region - (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-header-end-internal entity)) - (std11-fetch-field field-name)) - nil))))) - -(luna-define-method mime-insert-header ((entity mime-elmo-imap4-entity) - &optional invisible-fields - visible-fields) - (mmelmo-insert-sorted-header-from-buffer - (mmelmo-imap4-mime-entity-buffer entity) - (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-header-end-internal entity) - invisible-fields visible-fields)) - -(luna-define-method mime-entity-header-buffer ((entity mime-elmo-imap4-entity)) - (mime-buffer-entity-buffer-internal entity)) - -(luna-define-method mime-entity-body-buffer ((entity mime-elmo-imap4-entity)) - (mime-buffer-entity-buffer-internal entity)) - -(luna-define-method mime-write-entity-content ((entity mime-elmo-imap4-entity) - filename) - (let ((mmelmo-imap4-threshold (mime-elmo-entity-size-internal entity))) - (if (mime-buffer-entity-buffer-internal entity) - (save-excursion - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (unless mmelmo-imap4-fetched - (setq mmelmo-imap4-skipped-parts nil) ; No need? - (mime-buffer-entity-set-buffer-internal entity nil) ; To re-fetch. - )) - (unless mmelmo-imap4-fetched - (setq mmelmo-imap4-skipped-parts nil) ; No need? - (let ((mmelmo-imap4-threshold (mime-elmo-entity-size-internal entity))) - (mime-buffer-entity-set-buffer-internal entity nil) ; To re-fetch. - (message "Fetching skipped part...") - (mime-buffer-entity-set-buffer-internal - entity - (mmelmo-imap4-mime-entity-buffer entity)) - (message "Fetching skipped part...done."))) - (with-current-buffer (mime-buffer-entity-buffer-internal entity) - (mime-write-decoded-region - (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity) - filename - (or (mime-entity-encoding entity) "7bit")))))) - -(require 'product) -(product-provide (provide 'mmelmo-imap4) (require 'elmo-version)) - -;;; mmelmo-imap4.el ends here diff --git a/elmo/mmelmo.el b/elmo/mmelmo.el deleted file mode 100644 index 0e54dd8..0000000 --- a/elmo/mmelmo.el +++ /dev/null @@ -1,265 +0,0 @@ -;;; mmelmo.el -- mm-backend by ELMO. - -;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi - -;; Author: Yuuichi Teranishi -;; 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: -;; -(require 'elmo-vars) -(require 'elmo-util) -(require 'mime-parse) -(require 'mmbuffer) - -(provide 'mmelmo) ; circular dependency -(require 'mmelmo-imap4) - -(eval-and-compile - (luna-define-class mime-elmo-entity (mime-buffer-entity) - (imap folder number msgdb size)) - (luna-define-internal-accessors 'mime-elmo-entity)) - -(defvar mmelmo-force-reload nil) -(defvar mmelmo-sort-field-list nil) - -(defvar mmelmo-header-max-column fill-column - "*Inserted header is folded with this value. -If function is specified, its return value is used.") - -(defvar mmelmo-header-inserted-hook nil - "*A hook called when header is inserted.") - -(defvar mmelmo-entity-content-inserted-hook nil - "*A hook called when entity-content is inserted.") - -(defun mmelmo-get-original-buffer () - (let ((ret-val (get-buffer (concat mmelmo-entity-buffer-name "0")))) - (if (not ret-val) - (save-excursion - (set-buffer (setq ret-val - (get-buffer-create - (concat mmelmo-entity-buffer-name "0")))) - (mmelmo-original-mode))) - ret-val)) - -(defun mmelmo-cleanup-entity-buffers () - "Cleanup entity buffers of mmelmo." - (mapcar (lambda (x) - (if (string-match mmelmo-entity-buffer-name x) - (kill-buffer x))) - (mapcar 'buffer-name (buffer-list)))) - -;; For FLIM 1-13.x -(defun-maybe mime-entity-body (entity) - (luna-send entity 'mime-entity-body)) - -(defun mmelmo-insert-sorted-header-from-buffer (buffer - start end - &optional invisible-fields - visible-fields - sorted-fields) - (let ((the-buf (current-buffer)) - (mode-obj (mime-find-field-presentation-method 'wide)) - field-decoder - f-b p f-e field-name field field-body - vf-alist (sl sorted-fields)) - (save-excursion - (set-buffer buffer) - (save-restriction - (narrow-to-region start end) - (goto-char start) - (while (re-search-forward std11-field-head-regexp nil t) - (setq f-b (match-beginning 0) - p (match-end 0) - field-name (buffer-substring f-b p) - f-e (std11-field-end)) - (when (mime-visible-field-p field-name - visible-fields invisible-fields) - (setq field (intern - (capitalize (buffer-substring f-b (1- p)))) - field-body (buffer-substring p f-e) - field-decoder (inline (mime-find-field-decoder-internal - field mode-obj))) - (setq vf-alist (append (list - (cons field-name - (list field-body field-decoder))) - vf-alist)))) - (and vf-alist - (setq vf-alist - (sort vf-alist - (function (lambda (s d) - (let ((n 0) re - (sf (car s)) - (df (car d))) - (catch 'done - (while (setq re (nth n sl)) - (setq n (1+ n)) - (and (string-match re sf) - (throw 'done t)) - (and (string-match re df) - (throw 'done nil))) - t))))))) - (with-current-buffer the-buf - (while vf-alist - (let* ((vf (car vf-alist)) - (field-name (car vf)) - (field-body (car (cdr vf))) - (field-decoder (car (cdr (cdr vf))))) - (insert field-name) - (insert (if field-decoder - (funcall field-decoder field-body - (string-width field-name) - (if (functionp mmelmo-header-max-column) - (funcall mmelmo-header-max-column) - mmelmo-header-max-column)) - ;; Don't decode - field-body)) - (insert "\n")) - (setq vf-alist (cdr vf-alist))) - (run-hooks 'mmelmo-header-inserted-hook)))))) - -(defun mmelmo-original-mode () - (setq major-mode 'mmelmo-original-mode) - (setq buffer-read-only t) - (elmo-set-buffer-multibyte nil) - (setq mode-name "MMELMO-Original")) - -;; For FLIMs without rfc2231 feature . -(if (not (fboundp 'mime-parse-parameters-from-list)) - (defun mime-parse-parameters-from-list (attrlist) - (let (ret-val) - (if (not (eq (% (length attrlist) 2) 0)) - (message "Invalid attributes.")) - (while attrlist - (setq ret-val (append ret-val - (list (cons (downcase (car attrlist)) - (car (cdr attrlist)))))) - (setq attrlist (cdr (cdr attrlist)))) - ret-val))) - -(luna-define-method initialize-instance :after ((entity mime-elmo-entity) - &rest init-args) - "The initialization method for elmo. -mime-elmo-entity has its own member variable, -`imap', `folder', `msgdb' and `size'. -imap: boolean. if non-nil, entity becomes mime-elmo-imap4-entity class. -folder: string. folder name. -msgdb: msgdb of elmo. -size: size of the entity." - (if (mime-elmo-entity-imap-internal entity) - ;; use imap part fetching. - ;; child mime-entity's class becomes `mime-elmo-imap4-entity' - ;; which implements `entity-buffer' method. - (progn - (let (new-entity) - (mime-buffer-entity-set-buffer-internal entity nil) - (setq new-entity - (mmelmo-imap4-get-mime-entity - (mime-elmo-entity-folder-internal entity) ; folder - (mime-elmo-entity-number-internal entity) ; number - (mime-elmo-entity-msgdb-internal entity) ; msgdb - )) - (mime-entity-set-content-type-internal - entity - (mime-entity-content-type-internal new-entity)) - (mime-entity-set-encoding-internal - entity - (mime-entity-encoding-internal new-entity)) - (mime-entity-set-children-internal - entity - (mime-entity-children-internal new-entity)) - (mime-elmo-entity-set-size-internal - entity - (mime-elmo-entity-size-internal new-entity)) - (mime-entity-set-representation-type-internal - entity 'mime-elmo-imap4-entity) - entity)) - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (mmelmo-original-mode) - (when (mime-root-entity-p entity) - (let ((buffer-read-only nil) - header-end body-start) - (erase-buffer) - (elmo-read-msg-with-buffer-cache - (mime-elmo-entity-folder-internal entity) - (mime-elmo-entity-number-internal entity) - (current-buffer) - (mime-elmo-entity-msgdb-internal entity) - mmelmo-force-reload) - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$\\|^$" ) - nil t) - (setq header-end (match-beginning 0) - body-start (if (= (match-end 0) (point-max)) - (point-max) - (1+ (match-end 0)))) - (setq header-end (point-min) - body-start (point-min))) - (mime-buffer-entity-set-header-start-internal entity (point-min)) - (mime-buffer-entity-set-header-end-internal entity header-end) - (mime-buffer-entity-set-body-start-internal entity body-start) - (mime-buffer-entity-set-body-end-internal entity (point-max)) - (save-restriction - (narrow-to-region (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-header-end-internal entity)) - (mime-entity-set-content-type-internal - entity - (let ((str (std11-fetch-field "Content-Type"))) - (if str - (mime-parse-Content-Type str) - )))))) - entity)) - -(luna-define-method mime-insert-header ((entity mime-elmo-entity) - &optional invisible-fields - visible-fields) - (mmelmo-insert-sorted-header-from-buffer - (mime-buffer-entity-buffer-internal entity) - (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-header-end-internal entity) - invisible-fields visible-fields mmelmo-sort-field-list)) - -(luna-define-method mime-insert-text-content :around ((entity - mime-elmo-entity)) - (luna-call-next-method) - (run-hooks 'mmelmo-entity-content-inserted-hook)) - -(luna-define-method mime-entity-body ((entity mime-elmo-entity)) - (with-current-buffer (mime-buffer-entity-buffer-internal entity) - (buffer-substring (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity)))) - -;;(luna-define-method mime-entity-content ((entity mime-elmo-entity)) -;; (mime-decode-string -;; (with-current-buffer (mime-buffer-entity-buffer-internal entity) -;; (buffer-substring (mime-buffer-entity-body-start-internal entity) -;; (mime-buffer-entity-body-end-internal entity))) -;; (mime-entity-encoding entity))) - -(require 'product) -(product-provide (provide 'mmelmo) (require 'elmo-version)) - -;;; mmelmo.el ends here diff --git a/elmo/mmimap.el b/elmo/mmimap.el new file mode 100644 index 0000000..54a5faf --- /dev/null +++ b/elmo/mmimap.el @@ -0,0 +1,295 @@ +;;; mmimap.el --- MIME entity module for IMAP4rev1 (RFC2060). +;; **** This is EXPERIMENTAL ***** + +;; Copyright (C) 2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; Keywords: IMAP, MIME, multimedia, mail, news + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; 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: + +(require 'mmgeneric) +(require 'mime) +(require 'pces) +(require 'static) +(require 'mime-parse) + +(eval-and-compile + (luna-define-class mime-imap-entity (mime-entity) + (size header-string body-string new)) + (luna-define-internal-accessors 'mime-imap-entity)) + +;;; @ MIME IMAP location +;; It should contain server, mailbox and uid (sequence number). +(eval-and-compile + (luna-define-class mime-imap-location () ())) + +(luna-define-generic mime-imap-location-section-body (location section) + "Return a body string from LOCATION which corresponds to SECTION. +SECTION is a section string which is defined in RFC2060.") + +(luna-define-generic mime-imap-location-bodystructure (location) + "Return a parsed bodystructure of LOCATION. +`NIL' should be converted to nil, `astring' should be converted to a string.") + +;;; @ Subroutines +;; + +(defun mmimap-entity-section (node-id) + "Return a section string from NODE-ID" + (cond + ((numberp node-id) + (number-to-string (1+ node-id))) + ((listp node-id) + (mapconcat + 'mmimap-entity-section + (reverse node-id) + ".")))) + +(static-if (fboundp 'mime-decode-parameters) + (defalias 'mmimap-parse-parameters-from-list 'mime-decode-parameters) + (defun mmimap-parse-parameters-from-list (attrlist) + "Parse parameters from ATTRLIST." + (let (ret-val) + (while attrlist + (setq ret-val (append ret-val + (list (cons (downcase (car attrlist)) + (car (cdr attrlist)))))) + (setq attrlist (cdr (cdr attrlist)))) + ret-val))) + +(defun mmimap-make-mime-entity (bodystructure class location node-id number + parent) + "Analyze parsed IMAP4 BODYSTRUCTURE response and make MIME entity. +CLASS, LOCATION, NODE-ID, PARENT are set to the returned entity." + (cond + ((listp (car bodystructure)) ; multipart + (let ((num 0) + curp children content-type entity) + (setq entity + (luna-make-entity + class + :new t + :parent parent + :location location + :node-id (if (eq number 0) + node-id + (nconc (list number) node-id)) + )) + (while (and (setq curp (car bodystructure)) + (listp curp)) + (setq children + (nconc children + (list + (mmimap-make-mime-entity curp class + location + (if (eq number 0) + node-id + (nconc (list number) node-id)) + num + entity)))) + (setq num (+ num 1)) + (setq bodystructure (cdr bodystructure))) + (mime-entity-set-children-internal entity children) + (setq content-type (list (cons 'type 'multipart))) + (if (car bodystructure) + (setq content-type (nconc content-type + (list (cons 'subtype + (intern + (downcase + (car + bodystructure)))))))) + (setq content-type (append content-type + (mmimap-parse-parameters-from-list + (nth 1 bodystructure)))) + (mime-entity-set-content-type-internal entity content-type) + entity)) + (t ; singlepart + (let (content-type entity) + (setq content-type + (list (cons 'type (intern (downcase (car bodystructure)))))) + (if (nth 1 bodystructure) + (setq content-type (append content-type + (list + (cons 'subtype + (intern + (downcase + (nth 1 bodystructure)))))))) + (if (nth 2 bodystructure) + (setq content-type (append content-type + (mmimap-parse-parameters-from-list + (nth 2 bodystructure))))) + (setq node-id (nconc (list number) node-id)) + (setq entity + (luna-make-entity + class + :new t + :size (nth 6 bodystructure) + :content-type content-type + :location location + :parent parent + :node-id node-id)) + (mime-entity-set-content-type-internal entity content-type) + (mime-entity-set-encoding-internal entity + (and (nth 5 bodystructure) + (downcase + (nth 5 bodystructure)))) + (if (and (nth 7 bodystructure) + (nth 8 bodystructure)) ; children. + (mime-entity-set-children-internal + entity + (list (mmimap-make-mime-entity + (nth 8 bodystructure) class + location node-id 0 + entity)))) + entity)))) + +(luna-define-method initialize-instance :after ((entity mime-imap-entity) + &rest init-args) + ;; To prevent infinite loop... + (if (mime-imap-entity-new-internal entity) + entity + (mmimap-make-mime-entity + (mime-imap-location-bodystructure + (mime-entity-location-internal entity)) + (luna-class-name entity) + (mime-entity-location-internal entity) + nil 0 nil))) + +;;; @ entity +;; + +(luna-define-method mime-insert-entity ((entity mime-imap-entity)) + (if (mime-root-entity-p entity) + (progn + (insert (mime-imap-entity-header-string entity)) + (mime-insert-entity-body entity)) + ;; Insert body if it is not a multipart. + (unless (eq (mime-content-type-primary-type + (mime-entity-content-type entity)) + 'multipart) + (mime-insert-entity-body entity)))) + +(luna-define-method mime-write-entity ((entity mime-imap-entity) filename) + (with-temp-buffer + (mime-insert-entity entity) + (write-region-as-raw-text-CRLF (point-min) (point-max) filename))) + +;;; @ entity body +;; + +(luna-define-method mime-entity-body ((entity mime-imap-entity)) + (or (mime-imap-entity-body-string-internal entity) + (mime-imap-entity-set-body-string-internal + entity + (mime-imap-location-section-body + (mime-entity-location-internal entity) + (mmimap-entity-section + (mime-entity-node-id-internal entity)))))) + +(luna-define-method mime-insert-entity-body ((entity mime-imap-entity)) + (insert (mime-entity-body entity))) + +(luna-define-method mime-write-entity-body ((entity mime-imap-entity) + filename) + (with-temp-buffer + (mime-insert-entity-body entity) + (write-region-as-binary (point-min) (point-max) filename))) + +;;; @ entity content +;; + +(luna-define-method mime-entity-content ((entity mime-imap-entity)) + (let ((ret (mime-entity-body entity))) + (if ret + (mime-decode-string ret (mime-entity-encoding entity)) + (message "Cannot decode content.") + nil))) + +(luna-define-method mime-insert-entity-content ((entity mime-imap-entity)) + (insert (mime-entity-content entity))) + +(luna-define-method mime-write-entity-content ((entity mime-imap-entity) + filename) + (with-temp-buffer + (mime-insert-entity-body entity) + (mime-write-decoded-region (point-min) (point-max) + filename + (or (mime-entity-encoding entity) "7bit")))) + +;;; @ header field +;; + +(defun mime-imap-entity-header-string (entity) + (or (mime-imap-entity-header-string-internal entity) + (mime-imap-entity-set-header-string-internal + entity + (mime-imap-location-section-body + (mime-entity-location-internal entity) + (if (if (eq (car (mime-entity-node-id-internal entity)) 0) + (cdr (mime-entity-node-id-internal entity)) + (mime-entity-node-id-internal entity)) + (concat (mmimap-entity-section + (if (eq (car (mime-entity-node-id-internal entity)) 0) + (cdr (mime-entity-node-id-internal entity)) + (mime-entity-node-id-internal entity))) + ".HEADER") + "HEADER"))))) + +(luna-define-method mime-entity-fetch-field :around + ((entity mime-imap-entity) field-name) + (if (mime-root-entity-p entity) + (or (luna-call-next-method) + (with-temp-buffer + (insert (mime-imap-entity-header-string entity)) + (let ((ret (std11-fetch-field field-name))) + (when ret + (or (symbolp field-name) + (setq field-name + (intern (capitalize (capitalize field-name))))) + (mime-entity-set-original-header-internal + entity + (put-alist field-name ret + (mime-entity-original-header-internal entity))) + ret)))))) + +(luna-define-method mime-insert-header ((entity mime-imap-entity) + &optional invisible-fields + visible-fields) + (let ((the-buf (current-buffer)) + buf p-min p-max) + (with-temp-buffer + (insert (mime-imap-entity-header-string entity)) + (setq buf (current-buffer) + p-min (point-min) + p-max (point-max)) + (set-buffer the-buf) + (mime-insert-header-from-buffer buf p-min p-max + invisible-fields visible-fields)))) + +;;; @ end +;; + +(provide 'mmimap) + +;;; mmimap.el ends here diff --git a/samples/en/dot.addresses b/samples/en/dot.addresses index fe387cd..891a3d7 100644 --- a/samples/en/dot.addresses +++ b/samples/en/dot.addresses @@ -1,14 +1,15 @@ # -# ~/.addresses sample file. +# "~/.addresses" sample file. +# by Yuuichi Teranishi +# Time-stamp: <99/09/10 15:45:37 teranisi> # # Lines begin with '#' are comment. # Empty lines are ignored. -# # Format of each line: # email-address "petname" "realname" -# -# petname is used for Summary displaying. realname is used for To: field. +# petname is used for Summary displaying. +# realname is used for To: field. # teranisi@gohome.org "YT" "Yuuichi Teranishi" -foo@example.com "Mr. Foo" "John Foo" -bar@example.org "Mr. Bar" "Michael Bar" +foo@bar.com "Mr. Foo" "John Foo" +bar@foo.com "Mr. Bar" "Michael Bar" diff --git a/samples/en/dot.folders b/samples/en/dot.folders index 149d521..bfa1164 100644 --- a/samples/en/dot.folders +++ b/samples/en/dot.folders @@ -1,65 +1,72 @@ # -# ~/.folders sample file. -# -# For further information, see section "Folders" in the Info. +# "~/.folders" sample file. +# by Yuuichi Teranishi +# Time-stamp: <99/09/10 15:49:11 teranisi> # # Lines begin with '#' are comment. # Empty lines are ignored. # -## incoming mail box for IMAP users -# %inbox - -## incoming mail box for POP users -# &USERNAME@POP3.EXAMPLE.COM - -## [ pipe folder might be useful for some users ] -## [ which get mails and take them in. ] -# |&USERNAME@POP3.EXAMPLE.COM|+inbox - -## trash, draft and queue +%inbox +trash +draft -+queue - -## `$' marked important messages -'mark - -## MH folder -+inbox - -## MH folder via IMAP -# %#mh/inbox - -## NNTP folder -# -fj.os.bsd.freebsd -# -fj.mail.reader.mew -# -fj.news.reader.gnus - -## [ other NNTP server ] -# -jlug.ml.users@NEWS.EXAMPLE.NET -# -emacs.auc-tex@NEWS.EXAMPLE.ORG -# -ring.openlab.skk@NEWS.EXAMPLE.COM - - -## group definition -## [ folders between curly bracket are treated as in a group. ] -# Emacsen{ -# +to/wl -# +to/mew-dist -# +to/apel-ja -## [ You can define multi level group. ] -# XEmacs{ -# +to/xemacs-beta -# +to/xemacs-beta-ja -# +to/xemacs-mule -# } -# } - -## access group -## [ If there is '/' in the end of line, all subfolders are added to group. ] -## [ Use `C-u RET' for update access group. ] +%#mh/Backup@my.imap.server.com +%#mh/spool/mm +# group definition +Emacsen{ + %#mh/spool/xemacs-beta + %#mh/spool/mew-dist + %#mh/spool/tm-ja + %#mh/spool/mule-win32 + -fj.news.reader.gnus@other.nntp.server.com +# multi folder +# following line defines multi folder of -fj.editor.xemacs,-fj.editor.mule, +# and -fj.editor.emacs. + *-fj.editor.xemacs,-fj.editor.mule,-fj.editor.emacs + -gnu.emacs.sources +} +UNIX{ +# You can define multi level group. + BSD { + %#mh/spool/freebsd-users-jp + -fj.os.bsd.freebsd + -japan.comp.freebsd + %#mh/spool/bsd-nomads + -fj.os.bsd.misc + } + Linux { + -fj.os.linux + -japan.comp.linux + } +-fj.kanji +-fj.lang.perl +-fj.unix +-fj.questions.unix +-fj.sys.sun +-fj.sys.j3100 +-comp.windows.x.i386unix +-fj.comp.x11 +} +Television{ +%#mh/spool/tvdrama +-fj.rec.tv +-japan.tv +-fj.rec.tv.cm +-japan.tv.cm +-fj.rec.idol +-fj.rec.music +} +My folders { +INBOXes { +%inbox@localhost +# +# access group +# If there is '/' in the end of line, +# all subfolders are added to group +# +%#mh/expire@localhost / +} +# following definition adds all MH subfolders to group. + / - -## access group for IMAP user -# % / +%#mh@my.imap.server.com +} diff --git a/samples/en/dot.wl b/samples/en/dot.wl index bad17f4..7d17130 100644 --- a/samples/en/dot.wl +++ b/samples/en/dot.wl @@ -1,6 +1,6 @@ -;;; dot.wl -- sample setting file for Wanderlust -*- emacs-lisp -*- - -;; [[ Requirement Setting ]] +;;; -*- emacs-lisp -*- +;;; ~/.wl (setting file for Wanderlust) +;;; ;; Following must be included in ~/.emacs ;; for .emacs begin @@ -9,122 +9,73 @@ (autoload 'wl-draft "wl-draft" "Write draft with Wanderlust." t) ;; for .emacs end -;; Icon directory (XEmacs and Emacs21 only) -;; (No need if installed as XEmacs package.) -;(setq wl-icon-dir "/usr/local/lib/emacs/etc") - - ;;; [[ Private Setting ]] -;; Header From: +;; Header From ;(setq wl-from "Your Name ") +;; Organization +;(setq wl-organization "") ;; User's mail addresses. (setq wl-user-mail-address-list (list (wl-address-header-extract-address wl-from) - ;; "e-mail2@example.com" - ;; "e-mail3@example.net" ... + ;;"e-mail2@example.com" ... )) -;; Subscribed mailing list. -(setq wl-subscribed-mailing-list - '("wl@lists.airs.net" - "apel-ja@m17n.org" - ;;"ml@example.com" ... - )) - - -;;; [[ Server Setting ]] +;;; [[ Basic Setting ]] +;; Home directory for MH (localdir) +(setq elmo-localdir-folder-path "~/Mail") ;; Default IMAP4 server (setq elmo-default-imap4-server "localhost") ;; Default POP server (setq elmo-default-pop3-server "localhost") -;; SMTP server -(setq wl-smtp-posting-server "localhost") ;; Default NNTP server (setq elmo-default-nntp-server "localhost") ;; NNTP server name for posting (setq wl-nntp-posting-server elmo-default-nntp-server) +;; SMTP server +(setq wl-smtp-posting-server "localhost") + +;; Icon directory (XEmacs) +;; (No need if installed as XEmacs package.) +;(setq wl-icon-dir "~/work/wl/etc") ;; If (system-name) does not return FQDN, ;; set following as a local domain name without hostname. ;; ((system-name) "." wl-local-domain is used as domain part of Message-ID ;; and an argument of HELO in SMTP. -;(setq wl-local-domain "example.com") - +;(setq wl-local-domain "localdomain") ;; Specific domain part for message-id. -;(setq wl-message-id-domain "hostname.example.com") - -;; IMAP authenticate type setting -(setq elmo-default-imap4-authenticate-type 'clear) ; raw -;(setq elmo-default-imap4-authenticate-type 'cram-md5) ; CRAM-MD5 - -;; POP-before-SMTP -;(setq wl-draft-send-mail-func 'wl-draft-send-mail-with-pop-before-smtp) - - -;;; [[ Basic Setting ]] - -;; Default folder for `wl-summary-goto-folder'. -;(setq wl-default-folder "+inbox") - -;; Default string for folder name completion. -;(setq wl-default-spec "+") - -;; Folder Carbon Copy -;(setq wl-fcc "+outbox") - -;; Confirm at exit time. -(setq wl-interactive-exit t) - -;; Confirm at message sending time. -(setq wl-interactive-send t) - -;; Create opened thread. -;(setq wl-thread-insert-opened t) - -;; folder mode and summary mode is displayed at the same time. (3pane) -;(setq wl-stay-folder-window t) - -;; Open new frame for draft buffer. -;(setq wl-draft-use-frame t) +;(setq wl-message-id-domain "localhost.localdomain") -;; Disable inline display HTML part. -;(setq mime-setup-enable-inline-html nil) +;(setq wl-default-folder "+inbox") ;; Default folder for + ;; wl-summary-goto-folder. +;(setq wl-default-spec "+") ;; Default string for + ;; folder name completion. -;; Don't split large message. -;(setq mime-edit-split-message nil) +;(setq wl-fcc "+outbox") ;; Folder Carbon Copy -;; Thread divide when change subject. -;(setq wl-summary-divide-thread-when-subject-changed t) +(setq wl-interactive-exit t) ;; Confirm at exit time. +(setq wl-interactive-send t) ;; Confirm at message sending time. -;; Thread view -;(setq wl-thread-have-younger-brother-str "+" -; wl-thread-youngest-child-str "+" -; wl-thread-vertical-str "|" -; wl-thread-horizontal-str "-" -; wl-thread-space-str " ") +(setq wl-auto-select-first t) ;; display first message automatically. +(setq wl-auto-select-next t) ;; goto next folder when exit from + ;; summary. +;(setq wl-summary-next-no-unread 'skip-no-unread) + ;; folder is skipped if there is no + ;; unread. -;; display first message automatically. -;(setq wl-auto-select-first t) +(setq wl-summary-move-order 'unread) ;; jump to unread message in 'N' or 'P'. +(setq wl-thread-insert-opened t) ;; Create opened thread. -;; goto next folder when exit from summary. -;(setq wl-auto-select-next t) - -;; folder is skipped if there is no unread. -;(setq wl-summary-next-no-unread 'skip-no-unread) - -;; jump to unread message in 'N' or 'P'. -;(setq wl-summary-move-order 'unread) - - -;;; [[ Network ]] +;(setq wl-stay-folder-window t) ;; folder mode and summary mode is + ;; displayed at the same time. ;; cache setting. ;; (messages in localdir, localnews, maildir are not cached.) ;(setq elmo-archive-use-cache nil) -;(setq elmo-nntp-use-cache t) +;(setq elmo-nntp-use-cache nil) ;(setq elmo-imap4-use-cache t) ;(setq elmo-pop3-use-cache t) @@ -133,7 +84,7 @@ ;; Store draft message in queue folder if message is sent in unplugged status. (setq wl-draft-enable-queuing t) -;; when plug status is changed from unplugged to plugged, +;; when plug status is changed from unplugged to plugged, ;; queued message is flushed automatically. (setq wl-auto-flush-queue t) @@ -147,23 +98,142 @@ ; )) +;; highlight setting (for light background) + +;; decide group folder color by number. +;(setq wl-highlight-group-folder-by-numbers nil) + +(setq wl-highlight-message-header-alist + '(("Subject[ \t]*:" . wl-highlight-message-subject-header-contents) + ("From[ \t]*:" . wl-highlight-message-from-header-contents) + ("\\(.*To\\|Cc\\|Newsgroups\\)[ \t]*:" . wl-highlight-message-important-header-contents) + ("\\(User-Agent\\|X-Mailer\\|X-Newsreader\\)[ \t]*:" . + wl-highlight-message-unimportant-header-contents) + )) +;; don't change color by citation level. +;(setq wl-highlight-citation-face-list +; '(wl-highlight-message-cited-text-1)) + +(defun my-wl-set-face (face spec) + (make-face face) + (cond ((fboundp 'face-spec-set) + (face-spec-set face spec)) + (t + (wl-declare-face face spec)))) + +;; header. +(my-wl-set-face 'wl-highlight-message-subject-header-contents + '((t (:foreground "blue" :bold t)))) +(my-wl-set-face 'wl-highlight-message-from-header-contents + '((t (:foreground "red" :bold t)))) +(my-wl-set-face 'wl-highlight-message-important-header-contents + '((t (:foreground "purple" :bold t)))) +(my-wl-set-face 'wl-highlight-message-unimportant-header-contents + '((t (:foreground "RoyalBlue" :bold t)))) +(my-wl-set-face 'wl-highlight-message-headers + '((t (:foreground "magenta3" :bold t)))) +(my-wl-set-face 'wl-highlight-message-header-contents + '((t (:foreground "brown" :bold nil)))) +(my-wl-set-face 'wl-highlight-message-signature + '((t (:foreground "blue")))) +;; citation. +(my-wl-set-face 'wl-highlight-message-citation-header + '((t (:foreground "DarkGreen")))) +(my-wl-set-face 'wl-highlight-message-cited-text-1 + '((t (:foreground "forest green")))) +(my-wl-set-face 'wl-highlight-message-cited-text-2 + '((t (:foreground "SaddleBrown")))) +(my-wl-set-face 'wl-highlight-message-cited-text-3 + '((t (:foreground "orchid3")))) +(my-wl-set-face 'wl-highlight-message-cited-text-4 + '((t (:foreground "purple1")))) +(my-wl-set-face 'wl-highlight-message-cited-text-5 + '((t (:foreground "MediumPurple1")))) +(my-wl-set-face 'wl-highlight-message-cited-text-6 + '((t (:foreground "PaleVioletRed")))) +(my-wl-set-face 'wl-highlight-message-cited-text-7 + '((t (:foreground "LightPink")))) +(my-wl-set-face 'wl-highlight-message-cited-text-8 + '((t (:foreground "salmon")))) +(my-wl-set-face 'wl-highlight-message-cited-text-9 + '((t (:foreground "SandyBrown")))) +(my-wl-set-face 'wl-highlight-message-cited-text-10 + '((t (:foreground "wheat")))) +;; summary. +(my-wl-set-face 'wl-highlight-summary-important-face + '((t (:foreground "purple")))) +(my-wl-set-face 'wl-highlight-summary-new-face + '((t (:foreground "tomato")))) +(my-wl-set-face 'wl-highlight-summary-unread-face + '((t (:foreground "RoyalBlue")))) +(my-wl-set-face 'wl-highlight-summary-deleted-face + '((t (:foreground "gray")))) +(my-wl-set-face 'wl-highlight-summary-refiled-face + '((t (:foreground "blue")))) +(my-wl-set-face 'wl-highlight-summary-temp-face + '((t (:foreground "salmon")))) +(my-wl-set-face 'wl-highlight-summary-displaying-face + '((t (:bold t :underline t)))) +;; (thread) +(my-wl-set-face 'wl-highlight-summary-thread-top-face + '((t (:foreground "green4")))) +(my-wl-set-face 'wl-highlight-summary-normal-face + '((t (:foreground "SeaGreen")))) +;; folder +(my-wl-set-face 'wl-highlight-folder-unknown-face + '((t (:foreground "RoyalBlue")))) +(my-wl-set-face 'wl-highlight-folder-killed-face + '((t (:foreground "gray50")))) +(my-wl-set-face 'wl-highlight-folder-unread-face + '((t (:foreground "brown")))) +(my-wl-set-face 'wl-highlight-folder-zero-face + '((t (:foreground "blue4")))) +(my-wl-set-face 'wl-highlight-folder-few-face + '((t (:foreground "tomato")))) +(my-wl-set-face 'wl-highlight-folder-many-face + '((t (:foreground "HotPink1")))) +;; group +(my-wl-set-face 'wl-highlight-folder-opened-face + '((t (:foreground "forest green")))) +(my-wl-set-face 'wl-highlight-folder-closed-face + '((t (:foreground "DarkOliveGreen4")))) +;; demo +(my-wl-set-face 'wl-highlight-demo-face + '((t (:foreground "blue2")))) + + ;;; [[ Special Setting ]] +;; Subscribed mailing list. +(setq wl-subscribed-mailing-list + '("wl@lists.airs.net" + "apel-ja@m17n.org" + ;;"ml@example.com" ... + )) + +;; compress ~/elmo using jka-compr. +;(setq elmo-msgdb-overview-filename "overview.gz") +;(setq elmo-msgdb-number-filename "number.gz") +;(setq wl-summary-cache-file ".wl-summary-cache.gz") +;(setq wl-thread-top-file ".wl-thread-top.gz") + + ;; open unread group folder after checking. -;(add-hook 'wl-folder-check-entity-hook -; '(lambda () -; (wl-folder-open-unread-folder entity) -; )) +(add-hook 'wl-folder-check-entity-hook + '(lambda () + (wl-folder-open-unread-folder entity) + )) ;; Change summary display function. ;; get extra field values as overview information (only localdir folder). (setq elmo-msgdb-extra-fields '("newsgroups" - "x-ml-name" "list-id" - "x-mail-count" "x-ml-count" "x-sequence" + "x-ml-name" + "x-mail-count" "x-ml-count" + "x-sequence" "mailing-list")) -;; ML message displays ML name and ML sequence number in subject. +;;; ML message displays ML name and ML sequence number in subject. (setq wl-summary-subject-func 'my-wl-summary-subject-func-ml) (defun my-wl-summary-subject-func-ml (subject-string) (let ((folder wl-summary-buffer-folder-name) @@ -181,8 +251,7 @@ (and sequence (cadr (split-string sequence " "))))) (if (string-match -;;; "^\\s(\\(.+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" - "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" + "^\\s(\\(.+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" subject-string) (progn (setq subj (substring subject-string (match-end 0))) @@ -206,15 +275,6 @@ ;(setq wl-draft-send-func 'wl-draft-send-with-imput-async) -;; non-verbose User-Agent: field -;(setq wl-generate-mailer-string-func -; (function -; (lambda () -; (wl-generate-user-agent-string-1 nil)))) - - -;;; [[ Template ]] - ;; template (setq wl-template-alist '(("default" @@ -240,56 +300,48 @@ ("^Newsgroups: test.*" ("Organization" . "organization for nntp.")) )) - ;; Change headers in draft preparation time. -;(add-hook 'wl-mail-setup-hook -; '(lambda () -; (unless wl-draft-reedit; ; don't apply when reedit. -; (wl-draft-config-exec wl-draft-config-alist)))) - +; (add-hook 'wl-mail-setup-hook +; '(lambda () +; (unless wl-draft-reedit ;; don't apply when reedit. +; (wl-draft-config-exec wl-draft-config-alist)))) -;; [[ Reply ]] ;; header value setting for mail reply. -;; Wide window for draft buffer. -;(setq wl-draft-reply-buffer-style 'full) - -;; Remove fullname in reply message header. -;(setq wl-draft-reply-use-address-with-full-name nil) - ;; "a" (without-argument) reply to author (Reply-To or From). ;; if 'X-ML-Name' and 'Reply-To' exists, reply to 'Reply-To'. -(setq wl-draft-reply-without-argument-list - '((("X-ML-Name" "Reply-To") . (("Reply-To") nil nil)) - ("X-ML-Name" . (("To" "Cc") nil nil)) - ("Followup-To" . (nil nil ("Followup-To"))) - ("Newsgroups" . (nil nil ("Newsgroups"))) - ("Reply-To" . (("Reply-To") nil nil)) - ("Mail-Reply-To" . (("Mail-Reply-To") nil nil)) - ("From" . (("From") nil nil)))) - +; (setq wl-draft-reply-without-argument-list +; '((("X-ML-Name" "Reply-To") . (("Reply-To") nil nil)) +; ("X-ML-Name" . (("To" "Cc") nil nil)) +; ("Followup-To" . (nil nil ("Followup-To"))) +; ("Newsgroups" . (nil nil ("Newsgroups"))) +; ("Reply-To" . (("Reply-To") nil nil)) +; ("Mail-Reply-To" . (("Mail-Reply-To") nil nil)) +; ("From" . (("From") nil nil)))) +; ;; "C-u a" (with-argument) reply to all. -(setq wl-draft-reply-with-argument-list - '(("Followup-To" . (("From") nil ("Followup-To"))) - ("Newsgroups" . (("From") nil ("Newsgroups"))) - ("Mail-Followup-To" . (("Mail-Followup-To") nil ("Newsgroups"))) - ("From" . (("From") ("To" "Cc") ("Newsgroups"))))) +; (setq wl-draft-reply-with-argument-list +; '(("Followup-To" . (("From") nil ("Followup-To"))) +; ("Newsgroups" . (("From") nil ("Newsgroups"))) +; ("Mail-Followup-To" . (("Mail-Followup-To") nil ("Newsgroups"))) +; ("From" . (("From") ("To" "Cc") ("Newsgroups"))))) ;; X-Face (requires x-face (and x-face-mule)) + (when (and window-system (module-installed-p 'x-face)) - (cond (wl-on-xemacs ;; for XEmacs + (cond (wl-on-xemacs ;; for XEmacs (autoload 'x-face-xmas-wl-display-x-face "x-face" nil t) (setq wl-highlight-x-face-func 'x-face-xmas-wl-display-x-face)) - ;; for Mule (GNU Emacs) - ((module-installed-p 'x-face-mule) - ;; x-face-mule 0.20$B0J8e(B + ((module-installed-p 'x-face-mule) ;; for Mule (GNU Emacs) + ;; after x-face-mule 0.20 (setq wl-highlight-x-face-func (function - (lambda (&rest dummy) + (lambda (&optional beg end) ; for compatibility (x-face-decode-message-header)))) + (setq x-face-mule-highlight-x-face-style 'xmas) (require 'x-face-mule) ))) @@ -308,14 +360,16 @@ ;; Scoring. ;; "all.SCORE" file is used regardless of wl-score-folder-alist. -;(setq wl-score-folder-alist -; '(("^-comp\\." -; "news.comp.SCORE" -; "news.SCORE") -; ("^-" -; "news.SCORE"))) - +; (setq wl-score-folder-alist +; '(("^-comp\\." +; "news.comp.SCORE" +; "news.SCORE") +; ("^-" +; "news.SCORE"))) ;; directory for storing score files. ; (setq wl-score-files-directory "~/.elmo/") -;;; dot.wl ends here + +;;; +;;; end of file +;;; diff --git a/samples/ja/dot.addresses b/samples/ja/dot.addresses index 8b1b84c..40c0d51 100644 --- a/samples/ja/dot.addresses +++ b/samples/ja/dot.addresses @@ -1,14 +1,13 @@ # -# ~/.addresses $B%"%I%l%9D"%U%!%$%k%5%s%W%k(B +# $B%"%I%l%9%U%!%$%k%5%s%W%k(B +# by Yuuichi Teranishi +# Time-stamp: <98/06/15 00:32:30 teranisi> # # '#' $B$G;O$^$k9T$O%3%a%s%H!#(B # $B6u9T$OL5;k!#(B # -# $B=q<0(B: # $B%a!<%k%"%I%l%9(B "$B$"$@L>(B" "$BK\L>(B" # -# $B$"$@L>$O%5%^%j$NI=<($K!"K\L>$O(B To: $B%U%#!<%k%I$K;H$o$l$^$9!#(B -# teranisi@gohome.org "$B$F$i$K$7(B" "$B;{@>M50l(B" -foo@example.com "$B$U!<$5$s(B" "John Foo" -bar@example.org "$B$P!<$5$s(B" "Michael Bar" +foo@bar.com "$B$U!<$5$s(B" "Mr. Foo" +bar@foo.com "$B$P!<$5$s(B" "Mr. Bar" diff --git a/samples/ja/dot.folders b/samples/ja/dot.folders index 5ba69a7..d3f722d 100644 --- a/samples/ja/dot.folders +++ b/samples/ja/dot.folders @@ -1,66 +1,73 @@ # -# ~/.folders $B%U%)%k%@Dj5A%U%!%$%k%5%s%W%k(B -# -# $B8D!9$N%U%)%k%@$N=q<0$K$D$$$F$O(B Info $B$N(B Folders $B%;%/%7%g%s$r;2>H$N$3$H!#(B +# $B%U%)%k%@Dj5A%U%!%$%k%5%s%W%k(B +# by Yuuichi Teranishi +# Time-stamp: <98/10/02 18:31:06 teranisi> # # '#' $B$G;O$^$k9T$O%3%a%s%H!#(B -# $B6u9T$OL5;k$5$l$k!#(B +# $B6u9T$OL5;k!#(B # +# $B8D!9$N%U%)%k%@$N=q<0$K$D$$$F$O(B info $B$r;2>H$N$3$H!#(B +# -## IMAP $B%f!<%6$N%a!<%k%\%C%/%9(B -# %inbox - -## POP $B%f!<%6$N%a!<%k%\%C%/%9(B -# &USERNAME@POPSERVER.EXAMPLE.COM - -## [ POP $B%f!<%6$K$O%Q%$%W%U%)%k%@$,Lr$KN)$A$^$9(B ] -## [ $B%Q%$%W%U%)%k%@$r;H$($P!"%a!<%k$r$N(B NNTP $B%5!<%P>e$N%K%e!<%:%0%k!<%W(B ] -# -jlug.ml.users@NEWS.EXAMPLE.NET -# -emacs.auc-tex@NEWS.EXAMPLE.ORG -# -ring.openlab.skk@NEWS.EXAMPLE.COM - - -## $B%0%k!<%W$NDj5A(B -## [ $B%U%)%k%@$rGH3g8L$G$/$/$C$F%0%k!<%W$K$9$k(B ] -# Emacsen{ -# +to/wl -# +to/mew-dist -# +to/apel-ja -## [ $B%0%k!<%W$NF~$l;R$b2DG=(B ] -# XEmacs{ -# +to/xemacs-beta -# +to/xemacs-beta-ja -# +to/xemacs-mule -# } -# } - -## $B%"%/%;%9%0%k!<%W(B -## [ $B9TKv$K(B '/' $B$,$D$/$H!"$=$N%U%)%k%@$K4^$^$l$k%5%V%U%)%k%@A4$F$,(B ] -## [ $B$R$H$D$N%0%k!<%W$H$J$k!#(B] -## [ `C-u RET' $B$G%"%/%;%9%0%k!<%W$r3+$/$H99?7$G$-$k!#(B ] +%#mh/Backup@my.imap.server.com +%#mh/spool/mm +# $B%0%k!<%W$NDj5A(B +Emacsen{ + %#mh/spool/xemacs-beta + %#mh/spool/mew-dist + %#mh/spool/tm-ja + %#mh/spool/mule-win32 + -fj.news.reader.gnus@other.nntp.server.com +# $B%^%k%A%U%)%k%@(B($BJ#?t$N%U%)%k%@$r2>A[E*$K0l$D$K8+$($k$h$&$K$9$k%U%)%k%@(B) +# $Bl9g$OI,MW$"$j$^$;$s!#(B -;(setq wl-icon-dir "/usr/local/lib/emacs/etc") - - ;;; [[ $B8D?M>pJs$N@_Dj(B ]] -;; From: $B$N@_Dj(B +;; From $B$N@_Dj(B ;(setq wl-from "Your Name ") +;; Organization $B$N@_Dj(B +;(setq wl-organization "") ;; $B<+J,$N%a!<%k%"%I%l%9$N%j%9%H(B (setq wl-user-mail-address-list (list (wl-address-header-extract-address wl-from) - ;; "e-mail2@example.com" - ;; "e-mail3@example.net" ... + ;;"e-mail2@example.com" ... )) -;; $B<+J,$N;22C$7$F$$$k%a!<%j%s%0%j%9%H$N%j%9%H(B -(setq wl-subscribed-mailing-list - '("wl@lists.airs.net" - "apel-ja@m17n.org" - "emacs-mime-ja@m17n.org" - ;; "ml@example.com" ... - )) - - -;;; [[ $B%5!<%P$N@_Dj(B ]] +;;; [[ $B4pK\E*$J@_Dj(B ]] -;; IMAP $B%5!<%P$N@_Dj(B +;; MH (localdir) $B$N%[!<%`(B +(setq elmo-localdir-folder-path "~/Mail") +;; IMAP4$B%5!<%P$N@_Dj(B (setq elmo-default-imap4-server "localhost") -;; POP $B%5!<%P$N@_Dj(B +;; POP$B%5!<%P$N@_Dj(B (setq elmo-default-pop3-server "localhost") -;; SMTP $B%5!<%P$N@_Dj(B -(setq wl-smtp-posting-server "localhost") ;; $B%K%e!<%9%5!<%P$N@_Dj(B (setq elmo-default-nntp-server "localhost") -;; $BEj9F@h$N%K%e!<%9%5!<%P(B +;; $BEj9F@h$N(B $B%K%e!<%9%5!<%P(B (setq wl-nntp-posting-server elmo-default-nntp-server) +;; $B%a!<%k$rAw?.$9$k@h$N(B (SMTP)$B%5!<%P(B +(setq wl-smtp-posting-server "localhost") -;; (system-name) $B$,(B FQDN $B$rJV$5$J$$>l9g!"(B -;; `wl-local-domain' $B$K%[%9%HL>$r=|$$$?%I%a%$%sL>$r@_Dj$7$F$/$@$5$$!#(B -;; (system-name) "." wl-local-domain $B$,(B Message-ID $B$K;HMQ$5$l$^$9!#(B -;(setq wl-local-domain "example.com") +;; $B%"%$%3%s$rCV$/%G%#%l%/%H%j(B (XEmacs $B$N$_(B) +;; (XEmacs $B$N(B package $B$H$7$F%$%s%9%H!<%k$5$l$F$$$k>l9g!"I,MW$"$j$^$;$s(B) +;(setq wl-icon-dir "~/work/wl/etc") +;; (system-name) $B$,(BFQDN$B$rJV$5$J$$>l9g!"(B +;; $B0J2<$r%[%9%HL>$r=|$$$?%I%a%$%sL>$r@_Dj$7$F$/$@$5$$!#(B +;; ((system-name) "." wl-local-domain $B$,(B Message-ID $B$N:n@.!"(B +;; SMTP $B$N(B HELO $B$K;HMQ(B $B$5$l$^$9!#(B) +;(setq wl-local-domain "localdomain") ;; Message-ID $B$N%I%a%$%s%Q!<%H$r6/@)E*$K;XDj(B -;(setq wl-message-id-domain "hostname.example.com") - -;; IMAP $B%5!<%P$NG'>ZJ}<0$N@_Dj(B -(setq elmo-default-imap4-authenticate-type 'clear) ; $B@8%Q%9%o!<%I(B -;(setq elmo-default-imap4-authenticate-type 'cram-md5) ; CRAM-MD5 - -;; POP-before-SMTP -;(setq wl-draft-send-mail-func 'wl-draft-send-mail-with-pop-before-smtp) - - -;;; [[ $B4pK\E*$J@_Dj(B ]] - -;; `wl-summary-goto-folder' $B$N;~$KA*Br$9$k%G%U%)%k%H$N%U%)%k%@(B -;(setq wl-default-folder "+inbox") - -;; $B%U%)%k%@L>Jd40;~$K;HMQ$9$k%G%U%)%k%H$N%9%Z%C%/(B -;(setq wl-default-spec "+") - -;; Folder Carbon Copy -;(setq wl-fcc "+outbox") - -;; $B=*N;;~$K3NG'$9$k(B -(setq wl-interactive-exit t) - -;; $B%a!<%kAw?.;~$K$O3NG'$9$k(B -(setq wl-interactive-send t) - -;; $B%9%l%C%I$O>o$K3+$/(B -;(setq wl-thread-insert-opened t) - -;; $B%5%^%j%P%C%U%!$N:8$K%U%)%k%@%P%C%U%!$rI=<($9$k(B (3$B%Z%$%sI=<((B) -;(setq wl-stay-folder-window t) - -;; $B%I%i%U%H$r?7$7$$%U%l!<%`$G=q$/(B -;(setq wl-draft-use-frame t) - -;; HTML $B%Q!<%H$rI=<($7$J$$(B -;(setq mime-setup-enable-inline-html nil) - -;; $BBg$-$$%a%C%;!<%8$rAw?.;~$KJ,3d$7$J$$(B -;(setq mime-edit-split-message nil) - -;; $B%5%V%8%'%/%H$,JQ$o$C$?$i%9%l%C%I$r@Z$C$FI=<((B -;(setq wl-summary-divide-thread-when-subject-changed t) - -;; $B%9%l%C%I$N8+$?L\$rJQ$($k(B -;(setq wl-thread-have-younger-brother-str "+" -; wl-thread-youngest-child-str "+" -; wl-thread-vertical-str "|" -; wl-thread-horizontal-str "-" -; wl-thread-space-str " ") +;(setq wl-message-id-domain "localhost.localdomain") -;; $B%5%^%j0\F08e$K@hF,%a%C%;!<%8$rI=<($9$k(B -;(setq wl-auto-select-first t) +;(setq wl-default-folder "+inbox") ;; wl-summary-goto-folder $B$N;~$KA*Br$9$k(B + ;; $B%G%U%)%k%H$N%U%)%k%@(B +;(setq wl-default-spec "+") ;; $B%U%)%k%@L>Jd40;~$K;HMQ$9$k(B + ;; $B%G%U%)%k%H$N%9%Z%C%/(B -;; $B%5%^%jFb$N0\F0$GL$FI%a%C%;!<%8$,$J$$$Hl9g$OJXMx(B) -;(setq wl-summary-next-no-unread 'skip-no-unread) +(setq wl-interactive-exit t) ;; $B=*N;;~$K3NG'$9$k(B +(setq wl-interactive-send t) ;; $B%a!<%kAw?.;~$K$O3NG'$9$k(B -;; $BL$FI%a%C%;!<%8$rM%@hE*$KFI$`(B -;(setq wl-summary-move-order 'unread) +(setq wl-auto-select-first t) ;; $B%5%^%j0\F08e$K@hF,%a%C%;!<%8$rI=<($9$k(B +(setq wl-auto-select-next t) ;; $B%5%^%jFb$N0\F0$GL$FI%a%C%;!<%8$,$J$$$H(B + ;; $Bl9g$OJXMx(B +(setq wl-summary-move-order 'unread) ;; $BL$FI%a%C%;!<%8$rM%@hE*$KFI$`(B +(setq wl-thread-insert-opened t) ;; thread$B:n@.;~$O>o$K(Bopen$B$K$9$k(B - -;;; [[ $B%M%C%H%o!<%/(B ]] +;(setq wl-stay-folder-window t) ;; $B%5%^%j$K0\F0$7$?$H$-$K%U%)%k%@%P%C%U%!(B + ;; $B$N1&$K%5%^%j$N%P%C%U%!$rI=<($9$k(B ;; $B%U%)%k%@uBV$GAw?.$9$k$H!$%-%e!<(B(`wl-queue-folder')$B$K3JG<$9$k(B (setq wl-draft-enable-queuing t) -;; unplugged $B$+$i(B plugged $B$KJQ$($?$H$-$K!$%-%e!<$K$"$k%a%C%;!<%8$rAw?.$9$k(B +;; unplugged $B$+$i(B plugged $B$KJQ$($k$H!$%-%e!<$K$"$k%a%C%;!<%8$rAw?.$9$k(B (setq wl-auto-flush-queue t) ;; $B5/F0;~$O%*%U%i%$%s>uBV$K$9$k(B @@ -149,13 +99,131 @@ ; )) +;; highlight$B$N@_Dj(B ($BL@$k$$GX7J?'$N>l9g$G$9(B) + +;; $B%0%k!<%W$rL$FI?t$K$h$j?'J,$1$7$J$$!#3+JD>uBV$K$h$j?'J,$1$9$k!#(B +;(setq wl-highlight-group-folder-by-numbers nil) + +(setq wl-highlight-message-header-alist + '(("Subject[ \t]*:" . wl-highlight-message-subject-header-contents) + ("From[ \t]*:" . wl-highlight-message-from-header-contents) + ("\\(.*To\\|Cc\\|Newsgroups\\)[ \t]*:" . wl-highlight-message-important-header-contents) + ("\\(User-Agent\\|X-Mailer\\|X-Newsreader\\)[ \t]*:" . + wl-highlight-message-unimportant-header-contents) + )) +;; $B0zMQ%l%Y%k$G?'J,$1$7$J$$(B +;(setq wl-highlight-citation-face-list +; '(wl-highlight-message-cited-text-1)) + +(defun my-wl-set-face (face spec) + (make-face face) + (cond ((fboundp 'face-spec-set) + (face-spec-set face spec)) + (t + (wl-declare-face face spec)))) + +;; $B%a%C%;!<%8%X%C%@(B +(my-wl-set-face 'wl-highlight-message-subject-header-contents + '((t (:foreground "blue" :bold t)))) +(my-wl-set-face 'wl-highlight-message-from-header-contents + '((t (:foreground "red" :bold t)))) +(my-wl-set-face 'wl-highlight-message-important-header-contents + '((t (:foreground "purple" :bold t)))) +(my-wl-set-face 'wl-highlight-message-unimportant-header-contents + '((t (:foreground "RoyalBlue" :bold t)))) +(my-wl-set-face 'wl-highlight-message-headers + '((t (:foreground "magenta3" :bold t)))) +(my-wl-set-face 'wl-highlight-message-header-contents + '((t (:foreground "brown" :bold nil)))) +(my-wl-set-face 'wl-highlight-message-signature + '((t (:foreground "blue")))) +;; $B0zMQ(B +(my-wl-set-face 'wl-highlight-message-citation-header + '((t (:foreground "DarkGreen")))) +(my-wl-set-face 'wl-highlight-message-cited-text-1 + '((t (:foreground "forest green")))) +(my-wl-set-face 'wl-highlight-message-cited-text-2 + '((t (:foreground "SaddleBrown")))) +(my-wl-set-face 'wl-highlight-message-cited-text-3 + '((t (:foreground "orchid3")))) +(my-wl-set-face 'wl-highlight-message-cited-text-4 + '((t (:foreground "purple1")))) +(my-wl-set-face 'wl-highlight-message-cited-text-5 + '((t (:foreground "MediumPurple1")))) +(my-wl-set-face 'wl-highlight-message-cited-text-6 + '((t (:foreground "PaleVioletRed")))) +(my-wl-set-face 'wl-highlight-message-cited-text-7 + '((t (:foreground "LightPink")))) +(my-wl-set-face 'wl-highlight-message-cited-text-8 + '((t (:foreground "salmon")))) +(my-wl-set-face 'wl-highlight-message-cited-text-9 + '((t (:foreground "SandyBrown")))) +(my-wl-set-face 'wl-highlight-message-cited-text-10 + '((t (:foreground "wheat")))) +;; $B%5%^%j(B +(my-wl-set-face 'wl-highlight-summary-important-face + '((t (:foreground "purple")))) +(my-wl-set-face 'wl-highlight-summary-new-face + '((t (:foreground "tomato")))) +(my-wl-set-face 'wl-highlight-summary-unread-face + '((t (:foreground "RoyalBlue")))) +(my-wl-set-face 'wl-highlight-summary-deleted-face + '((t (:foreground "gray")))) +(my-wl-set-face 'wl-highlight-summary-refiled-face + '((t (:foreground "blue")))) +(my-wl-set-face 'wl-highlight-summary-temp-face + '((t (:foreground "salmon")))) +(my-wl-set-face 'wl-highlight-summary-displaying-face + '((t (:bold t :underline t)))) +;; ($B%9%l%C%I(B) +(my-wl-set-face 'wl-highlight-summary-thread-top-face + '((t (:foreground "green4")))) +(my-wl-set-face 'wl-highlight-summary-normal-face + '((t (:foreground "SeaGreen")))) +;; $B%U%)%k%@(B +(my-wl-set-face 'wl-highlight-folder-unknown-face + '((t (:foreground "RoyalBlue")))) +(my-wl-set-face 'wl-highlight-folder-killed-face + '((t (:foreground "gray50")))) +(my-wl-set-face 'wl-highlight-folder-unread-face + '((t (:foreground "brown")))) +(my-wl-set-face 'wl-highlight-folder-zero-face + '((t (:foreground "blue4")))) +(my-wl-set-face 'wl-highlight-folder-few-face + '((t (:foreground "tomato")))) +(my-wl-set-face 'wl-highlight-folder-many-face + '((t (:foreground "HotPink1")))) +;; $B%0%k!<%W(B +(my-wl-set-face 'wl-highlight-folder-opened-face + '((t (:foreground "forest green")))) +(my-wl-set-face 'wl-highlight-folder-closed-face + '((t (:foreground "DarkOliveGreen4")))) +;; $B%9%?!<%H%"%C%W%G%b(B +(my-wl-set-face 'wl-highlight-demo-face + '((t (:foreground "blue2")))) + + ;;; [[ $BFC(B $B$d(B ML$B$K$*$1$k%a%C%;!<%8HV9f$bI=<($9$k(B +;;; ML $B$N%a%C%;!<%8$G$"$l$P!$%5%^%j$N(B Subject $BI=<($K(B +;;; ML$BL>(B $B$d(B ML$B$K$*$1$k%a%C%;!<%8HV9f$bI=<($9$k(B (setq wl-summary-subject-func 'my-wl-summary-subject-func-ml) (defun my-wl-summary-subject-func-ml (subject-string) (let ((folder wl-summary-buffer-folder-name) @@ -186,8 +255,7 @@ (and sequence (cadr (split-string sequence " "))))) (if (string-match -;;; "^\\s(\\(.+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" - "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" + "^\\s(\\(.+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" subject-string) (progn (setq subj (substring subject-string (match-end 0))) @@ -210,16 +278,6 @@ ;(autoload 'wl-draft-send-with-imput-async "im-wl") ;(setq wl-draft-send-func 'wl-draft-send-with-imput-async) - -;; $BC;$$(B User-Agent: $B%U%#!<%k%I$r;H$&(B -;(setq wl-generate-mailer-string-func -; (function -; (lambda () -; (wl-generate-user-agent-string-1 nil)))) - - -;;; [[ $B%F%s%W%l!<%H(B ]] - ;; $B%F%s%W%l!<%H$N@_Dj(B (setq wl-template-alist '(("default" @@ -247,61 +305,53 @@ ("^Newsgroups: test.*" ("Organization" . "$B%K%e!<%9Ej9F;~$NAH?%L>(B")) )) - ;; $B%I%i%U%H:n@.;~(B($BJV?.;~(B)$B$K!$<+F0E*$K%X%C%@$rJQ99$9$k(B -;(add-hook 'wl-mail-setup-hook -; '(lambda () -; (unless wl-draft-reedit ; $B:FJT=8;~$OE,MQ$7$J$$(B -; (wl-draft-config-exec wl-draft-config-alist)))) - - -;;; [[ $BJV?.;~$N@_Dj(B ]] - -;; $BJV?.;~$N%&%#%s%I%&$r9-$/$9$k(B -;(setq wl-draft-reply-buffer-style 'full) - -;; $BJV?.;~$N%X%C%@$KAjA0$rF~$l$J$$!#(B -;(setq wl-draft-reply-use-address-with-full-name nil) +; (add-hook 'wl-mail-setup-hook +; '(lambda () +; (unless wl-draft-reedit ;; $B:FJT=8;~$OE,MQ$7$J$$(B +; (wl-draft-config-exec wl-draft-config-alist)))) ;; $B%a!<%k$NJV?.;~$K08@h$rIU$1$kJ}?K$N@_Dj(B + ;; $B2<5-JQ?t$N(B alist $B$NMWAG(B -;; ("$BJV?.85$KB8:_$9$k%U%#!<%k%I(B" . +;; ('$BJV?.85$KB8:_$9$k%U%#!<%k%I(B' . ;; ('To$B%U%#!<%k%I(B' 'Cc$B%U%#!<%k%I(B' 'Newsgroups$B%U%#!<%k%I(B')) -;; "a" (without-argument)$B$G$O(B Reply-To: $B$d(B From: $B$J$I$G;XDj$5$l$?M#0l?M(B -;; $B$^$?$OM#0l$D$NEj9F@h$KJV?.$9$k!#$^$?!$(BX-ML-Name: $B$H(B Reply-To: $B$,$D$$(B -;; $B$F$$$k$J$i(B Reply-To: $B08$K$9$k!#(B -(setq wl-draft-reply-without-argument-list - '((("X-ML-Name" "Reply-To") . (("Reply-To") nil nil)) - ("X-ML-Name" . (("To" "Cc") nil nil)) - ("Followup-To" . (nil nil ("Followup-To"))) - ("Newsgroups" . (nil nil ("Newsgroups"))) - ("Reply-To" . (("Reply-To") nil nil)) - ("Mail-Reply-To" . (("Mail-Reply-To") nil nil)) - ("From" . (("From") nil nil)))) - +;; "a" (without-argument)$B$G$O(B Reply-To $B$d(B From $B$J$I$G;XDj$5$l$?M#0l?M(B +;; $B$^$?$OM#0l$D$NEj9F@h$KJV?.$9$k!#$^$?!$(BX-ML-Name $B$H(B Reply-To $B$,$D$$(B +;; $B$F$$$k$J$i(B Reply-To $B08$K$9$k!#(B +; (setq wl-draft-reply-without-argument-list +; '((("X-ML-Name" "Reply-To") . (("Reply-To") nil nil)) +; ("X-ML-Name" . (("To" "Cc") nil nil)) +; ("Followup-To" . (nil nil ("Followup-To"))) +; ("Newsgroups" . (nil nil ("Newsgroups"))) +; ("Reply-To" . (("Reply-To") nil nil)) +; ("Mail-Reply-To" . (("Mail-Reply-To") nil nil)) +; ("From" . (("From") nil nil)))) +; ;; "C-u a" (with-argument)$B$G$"$l$P4X78$9$kA4$F$N?M!&Ej9F@h$KJV?.$9$k!#(B -(setq wl-draft-reply-with-argument-list - '(("Followup-To" . (("From") nil ("Followup-To"))) - ("Newsgroups" . (("From") nil ("Newsgroups"))) - ("Mail-Followup-To" . (("Mail-Followup-To") nil ("Newsgroups"))) - ("From" . (("From") ("To" "Cc") ("Newsgroups"))))) +; (setq wl-draft-reply-with-argument-list +; '(("Followup-To" . (("From") nil ("Followup-To"))) +; ("Newsgroups" . (("From") nil ("Newsgroups"))) +; ("Mail-Followup-To" . (("Mail-Followup-To") nil ("Newsgroups"))) +; ("From" . (("From") ("To" "Cc") ("Newsgroups"))))) ;; X-Face $B$rI=<($9$k(B ($BMW(B x-face (and x-face-mule)) + (when (and window-system (module-installed-p 'x-face)) - (cond (wl-on-xemacs ;; for XEmacs + (cond (wl-on-xemacs ;; for XEmacs (autoload 'x-face-xmas-wl-display-x-face "x-face" nil t) (setq wl-highlight-x-face-func 'x-face-xmas-wl-display-x-face)) - ;; for Mule (GNU Emacs) - ((module-installed-p 'x-face-mule) + ((module-installed-p 'x-face-mule) ;; for Mule (GNU Emacs) ;; x-face-mule 0.20$B0J8e(B (setq wl-highlight-x-face-func (function - (lambda (&rest dummy) + (lambda (&optional beg end) ; for compatibility (x-face-decode-message-header)))) + (setq x-face-mule-highlight-x-face-style 'xmas) (require 'x-face-mule) ))) @@ -320,15 +370,16 @@ ;(setq wl-summary-auto-refile-skip-marks nil) ;; $B%9%3%"5!G=$N@_Dj(B -;; `wl-score-folder-alist' $B$N@_Dj$K4X$o$i$:I,$:(B "all.SCORE" $B$O;HMQ$5$l$k!#(B -;(setq wl-score-folder-alist -; '(("^-comp\\." -; "news.comp.SCORE" -; "news.SCORE") -; ("^-" -; "news.SCORE"))) - -;; $B%9%3%"%U%!%$%k$rJ]B8$9$k%G%#%l%/%H%j(B +;; wl-score-folder-alist $B$N@_Dj$K4X$o$i$:I,$:(B "all.SCORE" $B$O;HMQ$5$l$k!#(B +; (setq wl-score-folder-alist +; '(("^-comp\\." +; "news.comp.SCORE" +; "news.SCORE") +; ("^-" +; "news.SCORE"))) +;; $B%9%3%"%U%!%$%k$rCV$/%G%#%l%/%H%j(B ; (setq wl-score-files-directory "~/.elmo/") -;;; dot.wl ends here +;;; +;;; end of file +;;; diff --git a/utils/bbdb-wl.el b/utils/bbdb-wl.el index e78e551..b6f0c7d 100644 --- a/utils/bbdb-wl.el +++ b/utils/bbdb-wl.el @@ -31,6 +31,7 @@ (require 'bbdb) (defvar bbdb-wl-get-update-record-hook nil) +(defvar bbdb-wl-folder-regexp nil) (defun bbdb-wl-setup () (add-hook 'wl-message-redisplay-hook 'bbdb-wl-get-update-record) @@ -63,9 +64,15 @@ (bbdb-save-db t)) (defun bbdb-wl-get-update-record () - (with-current-buffer (wl-message-get-original-buffer) - (bbdb-wl-update-record) - (run-hooks 'bbdb-wl-get-update-record-hook))) + (if (or (null bbdb-wl-folder-regexp) + (string-match + bbdb-wl-folder-regexp + (with-current-buffer + wl-message-buffer-cur-summary-buffer + (wl-summary-buffer-folder-name)))) + (with-current-buffer (wl-message-get-original-buffer) + (bbdb-wl-update-record) + (run-hooks 'bbdb-wl-get-update-record-hook)))) (defun bbdb-wl-hide-bbdb-buffer () (let (bbdb-buf bbdb-win) @@ -81,7 +88,7 @@ (save-excursion (if (buffer-live-p wl-current-summary-buffer) (set-buffer wl-current-summary-buffer)) - wl-message-buf-name))) + wl-message-buffer))) (cur-win (selected-window)) (b (current-buffer))) (and mes-win (select-window mes-win)) @@ -190,7 +197,7 @@ the user confirms the creation." (save-excursion (if (buffer-live-p wl-current-summary-buffer) (set-buffer wl-current-summary-buffer)) - wl-message-buf-name)) + wl-message-buffer)) (intern (format "%s-%d" wl-current-summary-buffer @@ -316,7 +323,7 @@ displaying the record corresponding to the sender of the current message." (save-excursion (if (buffer-live-p wl-current-summary-buffer) (set-buffer wl-current-summary-buffer)) - wl-message-buf-name))) + wl-message-buffer))) (cur-win (selected-window)) (b (current-buffer))) (and mes-win diff --git a/wl/ChangeLog b/wl/ChangeLog index 62aabd5..92150b0 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,9 +1,22 @@ 2001-06-15 Yuuichi Teranishi + * Version number is increased to 2.7.0. + + * wl-version.el (wl-version): Changed codename. + + * wl-summary.el (wl-summary-delete-cache): Fixed. + * wl-folder.el (wl-folder-guess-mailing-list-by-folder-name): Workaround for net folders. (According to the patch from ABE Yasushi ) + * wl-vars.el (wl-folder-process-duplicates-alist): Changed default + value to nil (According to the patch from + Yoichi NAKAYAMA ). + + * wl-util.el (wl-biff-check-folder): Call elmo-folder-check instead + of elmo-folder-close. + 2001-06-06 Peter Møller Neergaard * wl-summary.el (wl-summary-resend-bounced-mail): Modified regexp @@ -11,6 +24,8 @@ 2001-06-13 Yuuichi Teranishi + * wl-summary.el (wl-summary-resend-message): Fixed. + * wl-draft.el (wl-draft-edit-string): Fetch From: field value and Call wl-draft with `from' argument if its address is included in `wl-user-mail-address-list'. @@ -18,6 +33,7 @@ * wl.el (wl-exit): Delete current frame if wl-folder-use-frame is non-nil. + (wl): Don't show demo if wl-demo is nil. * wl-summary.el (wl-summary-exit): Renamed wl-folder-use-frame to wl-summary-use-frame. @@ -34,19 +50,32 @@ * wl-summary.el (wl-summary-exit): Back to folder frame if wl-folder-use-frame is non-nil. - (wl-summary-redisplay-internal): Ignore cache - if current folder is draft folder. + (wl-summary-redisplay-internal): Ignore cache if current folder + is draft folder, (wl-summary-redisplay-no-mime): Ditto. (wl-summary-redisplay-all-header): Ditto. * wl-folder.el (wl-folder-select-buffer): Switch to other frame if wl-folder-use-frame is non-nil. -2001-06-03 TAKAHASHI Kaoru +2001-06-06 Yuuichi Teranishi - * wl-folder.el (wl-folder-guess-mailing-list-by-folder-name): - Fixed probrem when hostname/port/auth included folder name makes - misguess. + * wl-summary.el (wl-summary-sync-update): Bind + elmo-folder-update-threshold. + (wl-summary-mark-as-important): Enclosed server mark processing + with `save-match-data'. + + * wl-mime.el (wl-mime-setup): Set mime-setup-signature-key-alist + only when it is already defined. + +2001-05-24 Masahiro MURATA + + * wl-expire.el (wl-expire-archive-get-folder): Fixed problem that + name of folder exclude localdir is wrong. + * wl-folder.el (wl-folder-sync-entity): + Set `wl-summary-always-sticky-folder-list' as nil. + (wl-folder-mark-as-read-all-entity): Ditto. + (wl-folder-prefetch-entity): Ditto. 2001-05-23 Kenichi OKADA @@ -59,17 +88,203 @@ (wl-summary-goto-folder-subr): If `wl-auto-select-first' is non-nil and selected message is important, do not display. +2001-05-16 Kenichi OKADA + + * wl.el (wl): Omit `wl-check-environment' if wl-init is nil. + +2001-05-10 Yuuichi Teranishi + + * wl.el (wl-plugged-dop-queue-info): Fixed for new queue structure. + + * wl-summary.el (wl-summary-mark-as-important): Set message number + using wl-summary-message-number. + +2001-05-10 Hiroya Murata + + * wl-summary.el (wl-summary-exec-subr): Fixed problem when + destination folder is 'null. + +2001-05-09 Kenichi OKADA + + * wl-folder.el (wl-folder-guess-mailing-list-by-refile-rule-subr): + New function. + (wl-folder-guess-mailing-list-by-folder-name-subr): New function. + (wl-folder-guess-mailing-list-by-refile-rule): Fix for multi folder. + (wl-folder-guess-mailing-list-by-folder-name): Ditto. + +2001-05-08 Yuuichi Teranishi + + * wl-mime.el (wl-mime-setup): Added setting for + `mime-setup-signature-key-alist' to avoid overriding key bind for + `wl-draft-send'. + + * wl-e21.el (wl-draft-overload-functions): Don't override key binding + for `wl-draft-send'. + * wl-mule.el (wl-draft-overload-functions): Ditto. + * wl-xmas.el (wl-draft-overload-functions): Ditto. + * wl-draft.el (wl-draft-send): Ditto. + + * wl-message.el (wl-message-display-internal): + Fixed typo (elmo-fetch-threshold->elmo-message-fetch-threshold). + (Patch is provided by ). + +2001-05-09 Kenichi OKADA + + * wl-folder.el (wl-folder-guess-mailing-list-by-refile-rule): Fix. + +2001-05-08 Kenichi OKADA + + * wl.el (wl): Fix for wl-demo. + +2001-05-08 Kenichi OKADA + + * wl-summary.el (wl-summary-supersedes-message): Use 'message-buf' + +2001-05-08 Kenichi OKADA + + * wl-folder.el (wl-folder-prefetch-entity): Use + `wl-folder-get-elmo-folder'. + (wl-folder-count-incorporates): Do not use + `wl-folder-get-elmo-folder'. + +2001-05-08 Kenichi OKADA + + * wl-xmas.el (wl-plugged-set-folder-icon): Use `elmo-folder-type' + instead of `elmo-folder-get-type'. + 2001-05-01 TAKAHASHI Kaoru * wl-summary.el (wl-summary-write-current-folder): Set cursor position on Subject: field. (Advised by Mito ) +2001-04-27 Hiroya Murata + + * wl-folder.el (wl-folder-prefetch-entity): Use + `wl-folder-get-elmo-folder'. + +2001-04-26 Yuuichi Teranishi + + * wl-vars.el (wl-folder-process-duplicates-alist): New user option. + + * wl-summary.el (wl-summary-buffer-set-folder): Set up + `process-duplicates' slot. + + * wl-highlight.el (wl-highlight-message): Don't highlight as signature + if detection failed. + +2001-04-25 TAKAHASHI Kaoru + + * wl-version.el (wl-version-status): Set to "alpha". + +2001-04-23 Yuuichi Teranishi + + * wl-summary.el (wl-summary-set-message-buffer-or-redisplay): + Check wl-message-buffer lives before set-buffer. + +2001-04-22 Masahiro MURATA + + * wl-expire.el (wl-summary-expire): Fixed problem that do not expire + called in folder mode. + * wl-var.el (wl-summary-exit-pre-hook): New variable. + * wl-summary.el (wl-summary-exit-pre-hook): Run + `wl-summary-exit-pre-hook' before exit summary mode. + +2001-04-22 TAKAHASHI Kaoru + + * wl-version.el (wl-version-status): New variable. + (wl-version-status-alist): Removed. + (wl-version-status): Rule included. + +2001-04-19 Yuuichi Teranishi + + * wl-vars.el (wl-folder-mime-charset-alist): Setup default value for + @sponichi. + + * wl-draft.el (wl-draft-insert-current-message): Fixed problem + when `mail-reply-buffer' is buffer-local variable. + (Reported by ). + +2001-04-17 Yuuichi Teranishi + + * wl-vars.el (toplevel): Require 'elmo-util. + +2001-04-16 Yuuichi Teranishi + + * wl-summary.el (wl-summary-message-regexp): Fixed number regexp. + (All other related portions are changed) + + * wl.el (wl-plugged-change): Use '<' instead of '<='. + + * wl-folder.el (wl-folder-check-one-entity): Fixed last change again. + +2001-04-14 Hiroya Murata + + * wl-folder.el (wl-folder-check-one-entity): Fixed last change. + +2001-04-13 Yuuichi Teranishi + + * wl-summary.el (wl-summary-target-mark-reply-with-citation): Fixed. + Delete other windows to avoid an error. + Use `point-marker' instead of `point' to remember the start point + of body. + + * wl.el (wl-plugged-toggle-all): Fixed argument for `elmo-set-plugged'. + + * wl-folder.el (wl-folder-check-one-entity): Adjust unread message + number not to exceed all message number. + 2001-04-12 Yoichi NAKAYAMA * wl-e21.el (wl-biff-init-icons): Don't use `call-interactively' to call the command `wl-biff-check-folders' in `mode-line-mouse2-map'. +2001-04-09 Yuuichi Teranishi + + * wl-summary.el (wl-summary-sync-force-update): Added argument + no-check. + (wl-summary-sync-update): Ditto. + (wl-summary-goto-folder-subr): Call wl-summary-sync-force-update + with `no-check'. + + * wl-message.el (wl-message-buffer-prefetch-timer): New variable. + (wl-message-buffer-prefetch-next): Don't run timer if timer is + already running. + +2001-04-07 Masahiro MURATA + + * wl-expire.el (wl-expire-archive-get-folder): Added argument + `dst-folder-arg'. + (wl-expire-archive-number1): Diito. + (wl-expire-archive-number2): Diito. + (wl-expire-archive-Date): Diito. + (wl-archive-number1): Diito. + (wl-archive-number2): Diito. + (wl-archive-date): Diito. + (wl-archive-folder-p): New function. + (wl-summary-expire): Support of expand folder name at + wl-expire-alist. + * wl-util.el (wl-expand-newtext): Renamed from + `wl-refile-expand-newtext'. + +2001-04-05 Hiroya Murata + + * wl-summary.el (wl-summary-prefetch-msg): Fiexd. Call + `elmo-msgdb-overview-get-entity' with `msgdb' instead of + `(elmo-msgdb-get-overview msgdb)'. + (wl-summary-prefetch): Bind match data before call + `wl-summay-prefetch-msg'. + (wl-summary-goto-folder-subr): Call `wl-summary-toggle-disp-msg' with + 'off if `wl-summary-buffer-disp-msg' is non-nil. + Fixed problem that couldn't show only one new or unread message when + enter folder. + (wl-summary-reply): Don't call `split-window-vertically' and other + window. + +2001-04-03 Yuuichi Teranishi + + * wl-expire.el (wl-expire-refile): Fixed. + 2001-04-02 Yuuichi Teranishi * wl-vars.el (wl-biff-unnotify-hook): New variable. @@ -77,58 +292,171 @@ * wl-util.el (wl-biff-notify): Run `wl-biff-unnotify-hook' when biff notification is removed. -2001-03-20 TAKAHASHI Kaoru + * wl.el (wl): Changed position of `elmo-init'. - * wl-folder.el (wl-folder-write-current-folder): Support petname. + * wl-draft.el (wl-default-draft-cite): Use date field + on the citation buffer. -2001-03-14 Yuuichi Teranishi + * wl-vars.el (wl-shimbun-folder-icon): New variable. - * wl-message.el (wl-normal-message-redisplay): - Set `wl-message-cache-used'. + * wl-xmas.el (wl-folder-internal-icon-list): Added + `wl-folder-shimbun-image'. -2001-03-13 OKAZAKI Tetsurou + * wl-e21.el (wl-folder-internal-icon-list): Added + `wl-folder-shimbun-image'. - * wl-summary.el (wl-summary-mode): Use `make-local-hook' instead - of `make-local-variable' for setting up `window-scroll-functions'. +2001-03-31 Yuuichi Teranishi -2001-03-12 OKAZAKI Tetsurou + * wl.el (wl-init): Eliminated argument. + (wl): Rewrite. - * wl-highlight.el (wl-highlight-summary): Use `save-match-data'. + * wl-summary.el (wl-summary-prefetch-msg): Use `elmo-message-encache'. + (wl-summary-sync-update): Use Use `elmo-folder-msgdb' + instead of `elmo-folder-msgdb-internal'. + (wl-summary-sync-update): Ditto. + (wl-summary-flush-pending-append-operations): Eliminated. + (wl-summary-delete-all-msgs): Set msgdb instead of folder. + (wl-summary-goto-folder-subr): Set load-msgdb argument of + `elmo-folder-open'. -2001-03-12 Yuuichi Teranishi + * wl-mime.el (wl-summary-burst): Fixed. - * wl-summary.el (wl-summary-move-spec-plugged-alist, - wl-summary-move-spec-unplugged-alist): Define without backquote. + * wl-folder.el (wl-folder-info-save): Check data type. -2000-03-11 Kenichi OKADA + * wl-expire.el (wl-expire-delete): Set msgdb instead of folder. + (wl-expire-refile-with-copy-reserve-msg): Use `elmo-folder-msgdb' + instead of `elmo-folder-msgdb-internal'. + (wl-expire-hide): Ditto. - * wl-draft.el (wl-draft-do-fcc): Fix for `wl-draft-use-cache' -2001-03-08 TAKAHASHI Kaoru + * wl-draft.el (wl-draft): Removed argument for `wl-init'. - * wl-score.el (wl-score-get-score-alist): Abolish `temp' key in - score file. Use `target' instead. +2001-03-20 TAKAHASHI Kaoru -2001-03-07 TAKAHASHI Kaoru + * wl-folder.el (wl-folder-write-current-folder): Support petname. - * wl-folder.el (wl-folder-guess-mailing-list-by-folder-name): - Fixed probrem guess by top level folder. +2001-03-11 Kenichi OKADA - * wl-draft.el (wl-draft-random-alphabet): Removed. - (wl-draft-confirm): Don't use conditonal statement - in `format' argument; Use gettext style. - (wl-draft-insert-x-face-field): Refactoring; Use guard statement - for error case. + * wl-draft.el (wl-draft-do-fcc): Fix for `wl-draft-use-cache' + +2001-03-11 TAKAHASHI Kaoru + + * wl-folder.el (wl-folder-guess-mailing-list-by-folder-name): + Fixed `match-beginning' argument mismatch. 2001-03-05 Katsumi Yamaoka * wl-demo.el (wl-demo): Reset `tab-width' and `tab-stop-list' to the default value. -2001-03-03 Masahiro MURATA +2001-03-01 Yuuichi Teranishi + + * wl-folder.el (wl-make-plugged-alist): Use `wl-nntp-posting-port' + instead of `elmo-nntp-default-port'. + + * wl-vars.el: Fixed some doc strings. + +2001-02-28 Yuuichi Teranishi + + * wl-summary.el (wl-summary-prefetch-msg): Use + `elmo-msgdb-overview-get-entity' instead of `assoc'. + + * wl-vars.el: Define *-func as obsolete variable using + `elmo-define-obsolete-variable'. + + * wl-message.el (wl-message-buffer-prefetch-threshold): Eliminated. + (wl-message-buffer-prefetch): Use `elmo-message-fetch-threshold' + instead of `wl-message-buffer-prefetch-threshold'. + + * wl-summary.el (wl-summary-buffer-message-redisplay-func): Removed. + + * wl-vars.el (wl-cache-prefetch-get-next-func): Ditto. + + * wl-draft.el (wl-caesar-region-func): Ditto. + + * wl-summary.el (wl-summary-exec-subr): Fixed `copy'; + Keep unread status in elmo-folder-move-messages. + (wl-summary-sync-update): Set `wl-summary-buffer-msgdb'. + +2001-02-27 TAKAHASHI Kaoru + + * wl-summary.el (wl-summary-buffer-exit-function): Renamed from + `wl-summary-buffer-exit-func' + (wl-summary-buffer-message-redisplay-function): Renamed from + `wl-summary-buffer-message-redisplay-func' + (wl-summary-buffer-next-folder-function): Renamed from + `wl-summary-buffer-next-folder-func'. + (wl-summary-buffer-prev-folder-function): Renamed from + `wl-summary-buffer-prev-folder-func'. + (wl-summary-get-petname-function): Renamed from + `wl-summary-get-petname-func'. + + * wl-score.el (wl-score-edit-exit-function): Renamed from + `wl-score-edit-exit-func'. + + * wl-message.el (wl-message-buffer-prefetch-get-next-function): + Renamed from `wl-message-buffer-prefetch-get-next-function'. + + * wl-util.el (wl-load-profile-function): Renamed from + `wl-load-profile-func'. + + * wl-folder.el (wl-folder-completion-function): Renamed from + `wl-folder-completion-func'. + (wl-folder-init-function): Renamed from `wl-folder-init-func'. + + * wl-vars.el (wl-expire-archive-get-folder-function): Renamed from + `wl-expire-archive-get-folder-func'. + (wl-draft-send-function): Renamed from `wl-draft-send-func'. + (wl-draft-send-mail-function): Renamed from + `wl-draft-send-mail-func'. + (wl-draft-send-news-function): Renamed from + `wl-draft-send-news-func'. + (wl-fldmgr-sort-function): Renamed from `wl-fldmgr-sort-func'. + (wl-generate-mailer-string-function): Renamed from + `wl-generate-mailer-string-func'. + (wl-highlight-signature-search-function): Renamed from + `wl-highlight-signature-search-func'. + (wl-highlight-x-face-function): Renamed from + `wl-highlight-x-face-func' + (wl-print-buffer-function): Renamed from `wl-print-buffer-func'. + (wl-ps-print-buffer-function): Renamed from + `wl-ps-print-buffer-func' + (wl-summary-from-function): Renamed from `wl-summary-from-func'. + (wl-summary-subject-function): Renamed from `wl-summary-subject-func'. + (wl-summary-subject-filter-function): Renamed from + `wl-summary-subject-filter-func'. + + * wl-draft.el (wl-draft-queue-flush-send-function): Renamed from + `wl-draft-queue-flush-send-func' + (wl-draft-cite-function): Renamed from + `wl-draft-cite-func' + + * wl-address.el (wl-address-init-function): Renamed from + `wl-address-init-func'. + +2001-02-27 Yuuichi Teranishi + + * wl-draft.el (wl-draft-queue-flush): Don't call + `elmo-dop-unlock-message'. + * wl-draft.el (wl-draft-queue-append): Don't call + `elmo-dop-lock-message'. + + * wl-summary.el (wl-summary-buffer-msgdb): Revival (for compatibility). + (wl-summary-buffer-folder-name): Ditto. + (wl-summary-message-regexp): Added '-' (all other related portions + are changed). + (wl-summary-goto-folder-subr): Set wl-summary-buffer-msgdb and + wl-summary-buffer-folder-name. + +2001-02-26 "A. SAGATA" + + * wl-folder.el (wl-folder-check-one-entity): Fixed problem that + the number of mails in the folder buffer is not updated by wl-biff. - * wl-summary.el (wl-summary-goto-folder-subr): Fixed problem that - last unread message is skipped. +2000-02-26 Kenichi OKADA + + * wl-summary.el (wl-summary-default-subject-filter): Fix for `Re>'. + * wl-vars.el (wl-summary-search-parent-by-subject-regexp): Ditto. 2001-03-01 Yuuichi Teranishi @@ -155,24 +483,6 @@ simple quotation to quote the anonymous function. * tm-wl.el (wl-draft-preview-message): Ditto. -2001-02-26 "A. SAGATA" - - * wl-folder.el (wl-folder-check-one-entity): Fixed problem that - the number of mails in the folder buffer is not updated by wl-biff. - -2000-02-26 Kenichi OKADA - - * wl-summary.el (wl-summary-default-subject-filter): Fix for `Re>'. - * wl-vars.el (wl-summary-search-parent-by-subject-regexp): Ditto. - -2001-02-25 Masahiro MURATA - - * wl-folder.el (wl-folder-sync-entity): Fixed change value of - `wl-message-buf-name' and `wl-summary-buffer-name'. - (wl-folder-mark-as-read-all-entity) : Ditto. - (wl-folder-prefetch-entity): Ditto. - (wl-folder-drop-unsync-entity): Ditto. - 2001-02-25 OKAZAKI Tetsurou * wl-highlight.el (wl-highlight-summary-displaying): Optimize; @@ -217,7 +527,7 @@ * wl-thread.el (toplevel): require 'cl. (wl-thread-resume-entity): Call wl-thread-make-number-list. (wl-thread-make-number-list): New function. - (wl-thread-entity-make-number-list-from-children): Ditt. + (wl-thread-entity-make-number-list-from-children): Ditto. (wl-thread-entity-insert-as-top): Update wl-summary-buffer-number-list. (wl-thread-entity-insert-as-children): Likewise. (wl-thread-delete-message): Likewise. @@ -253,7 +563,7 @@ (wl-summary-sync-all-init): Ditto. (wl-summary-goto-folder-subr): Call `wl-summary-make-number-list' if summary is not thread view. - (wl-summary-sync-update3): Ditto. + (wl-summary-sync-update): Ditto. (wl-summary-rescan): Ditto. (wl-summary-make-number-list): New function. @@ -264,18 +574,17 @@ * wl-highlight.el (wl-highlight-summary-window): Call `set-buffer-modified-p'. - * wl-vars.el (wl-summary-lazy-highlight): New variable. + * wl.el (wl-init): Don't call `elmo-crosspost-message-alist-load'. + (wl): Call `elmo-init' and fix. - * wl-summary.el (wl-summary-mode): Set up window-scroll-functions - when `wl-summary-lazy-highlight' is non-nil. - (wl-summary-goto-folder-subr): Highlight only when - `wl-summary-lazy-highlight' is non-nil. + * wl-draft.el, wl-folder.el, wl-summary.el, wl-util.el: + Use new variables. - * wl-highlight.el (wl-highlight-summary): Fixed docstring; - Don't display progress and highlight temp-mark when - `wl-summary-lazy-highlight' is non-nil. - (wl-highlight-summary-window): New function. - (Based on the patch from Akihiro MOTOKI ) + * wl-folder.el (wl-folder): Call `sit-for' before `wl-folder-init'. + +2001-02-20 Yuuichi Teranishi + + * wl-vars.el (wl-biff-notify-hook): Set default value as '(beep). 2001-02-20 Katsumi Yamaoka @@ -305,6 +614,64 @@ (wl-demo-image-type-alist): Use `image-type-available-p' for checking whether the image type `xbm' is available. +2000-02-20 Yuuichi Teranishi + + * wl-summary.el (wl-summary-sync): Rename 'all-shown' to `all-visible'. + (wl-summary-input-range): Ditto. + +2001-02-20 Yuuichi Teranishi + + * wl-summary.el (wl-summary-edit-addresses): Use + `wl-summary-get-original-buffer' + (wl-summary-mark-as-unread): Don't call `wl-summary-set-crosspost'. + (wl-summary-jump-to-msg-by-message-id-via-nntp): + Use `elmo-nntp-parse-newsgroup' instead of `wl-parse-newsgroups'. + (wl-summary-get-newsgroups): Eliminated. + (wl-summary-set-crosspost): Ditto. + (wl-summary-is-crosspost-folder): Ditto. + (wl-crosspost-alist-load): Ditto. + (wl-crosspost-alist-save): Ditto. + + * wl-folder.el (wl-folder-create-newsgroups-hashtb): Call + `elmo-setup-subscribed-newsgroups' instead of + `elmo-nntp-make-groups-hashtb'. + (wl-folder-suspend): Call `elmo-crosspost-message-alist-save' + instead of `wl-crosspost-alist-save'. + + * wl-mime.el (wl-summary-burst): Use `elmo-folder-writable-p' instead + of `elmo-folder-message-appendable-p'. + (wl-mime-header-presentation-method): Eliminated. + + * wl-message.el (wl-message-prev-page): Don't pass -1 to `recenter'. + (Error occurs in emacs21). + + * wl-draft.el (wl-draft-queue-flush): Fix (fetch message to + the current buffer). + + * wl.el (wl-save-status): Call `elmo-crosspost-message-alist-save' + instead of `wl-crosspost-alist-save'. + (wl-init): `elmo-crosspost-message-alist-load' + instead of `wl-crosspost-alist-load' + + * wl-util.el (wl-parse): Eliminated (Renamed to `elmo-parse'). + (wl-parse-newsgroups): Likewise. + (wl-biff-notify): Run `wl-biff-notify-hook'. + +2001-02-21 Yuuichi Teranishi + + * wl-vars.el (wl-summary-lazy-highlight): New variable. + + * wl-summary.el (wl-summary-mode): Set up window-scroll-functions + when `wl-summary-lazy-highlight' is non-nil. + (wl-summary-goto-folder-subr): Highlight only when + `wl-summary-lazy-highlight' is non-nil. + + * wl-highlight.el (wl-highlight-summary): Fixed docstring; + Don't display progress and highlight temp-mark when + `wl-summary-lazy-highlight' is non-nil. + (wl-highlight-summary-window): New function. + (Based on the patch from Akihiro MOTOKI ) + 2000-02-20 Kenichi OKADA * wl-summary.el (wl-summary-sync): Change `all-visible' @@ -321,6 +688,38 @@ * wl-demo.el: Work also with BITMAP-MULE under Emacs 21. (wl-demo-image-type-alist): New macro. +2001-02-19 Katsumi Yamaoka + + * wl-e21.el (wl-biff-init-icons): Don't generate icons if the + display does not support graphics. + (wl-plugged-init-icons): Ditto. + (wl-folder-init-icons): Ditto. + + * wl-demo.el (wl-demo): Chech closely whether the display + supports graphics. + +2001-02-09 Yuuichi Teranishi + + * wl-summary.el (wl-summary-get-original-buffer): New function. + (wl-summary-set-crosspost): Use it. + (wl-summary-target-mark-uudecode): Ditto. + (wl-summary-reedit): Ditto. + (wl-summary-resend-bounced-mail): Ditto. + (wl-summary-update-crosspost): Eliminated (It may be incorporated + into `elmo-folder-append-msgdb' method of elmo-nntp-folder class). + + * wl-message.el (wl-message-buffer-display): Added argumnet `unread'. + (wl-message-display-internal): Ditto. + +2001-02-07 Yuuichi Teranishi + + * wl-draft.el (wl-draft-parse-msg-id-list-string): Fix. + +2001-02-06 Yuuichi Teranishi + + * wl-summary.el (wl-summary-save-view): Renamed from + `wl-summary-save-status'. + 2000-02-20 Kenichi OKADA * wl-summary.el (wl-summary-sync): Added `all-shown' @@ -333,16 +732,6 @@ * wl-summary.el (wl-summary-sync-update3): Bind 'nohide as t if sync-all. -2001-02-19 Katsumi Yamaoka - - * wl-e21.el (wl-biff-init-icons): Don't generate icons if the - display does not support graphics. - (wl-plugged-init-icons): Ditto. - (wl-folder-init-icons): Ditto. - - * wl-demo.el (wl-demo): Chech closely whether the display - supports graphics. - 2001-02-19 OKAZAKI Tetsurou * wl-highlight.el (wl-highlight-summary-line-string): Use @@ -369,13 +758,94 @@ 2001-02-14 Yuuichi Teranishi - * wl-summary.el (wl-cache-prefetch-message): - Call `elmo-buffer-cache-message' with `unread' argument. + * wl-expire.el (wl-expire-refile): Don't call + elmo-msgdb-add-msgs-to-seen-list; + Pass wl-expire-add-seen-list to elmo-folder-move-messages. + (wl-expire-refile-with-copy-reserve-msg): Ditto. -2001-02-07 Yuuichi Teranishi +2001-01-19 Yuuichi Teranishi - * wl-draft.el (wl-draft-parse-msg-id-list-string): Fix. + * wl-message.el (wl-message-prev-page): Ignore errors while + scroll-down. +2001-01-14 Yuuichi Teranishi + + * wl-mime.el: Use elmo-original-message-mode instead of + mmelmo-original-mode. + + * wl-fldmgr.el: Use `wl-folder-get-elmo-folder' instead of + `elmo-folder-get-spec'; + (wl-fldmgr-add-completion-all-completions): + Use `elmo-folder-list-subfolders' instead of `elmo-list-folders'. + + * wl-e21.el (wl-plugged-set-folder-icon): Use `elmo-folder-type' instead + of `elmo-folder-get-type'. + + * wl-draft.el: Use `wl-folder-get-elmo-folder' instead of + `elmo-folder-get-spec'; + Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path'; + Use `elmo-folder-append-message' instead of `elmo-append-msg'; + Use `elmo-folder-list-messages' instead of `elmo-list-folder'; + Use `elmo-message-fetch' instead of `elmo-read-msg-with-cache' or + `elmo-read-msg-no-cache'; + Use `elmo-message-file-name' instead of `elmo-get-msg-filename'; + Use `elmo-folder-delete-messages' instead of `elmo-delete-msgs'. + (wl-default-draft-cite): Use `elmo-msgdb-overview-get-entity'. + (wl-draft-dispatch-message): Use `elmo-file-cache-save' instead of + `elmo-cache-save'; + (wl-draft-reedit): Use `elmo-message-file-name'. + + * wl-expire.el: Use `elmo-folder-name-internal'; + Use `elmo-folder-list-messages' instead of `elmo-list-folder'; + Use macro `wl-summary-buffer-msgdb' instead of variable + `wl-summary-buffer-msgdb'; + Use `wl-folder-get-elmo-folder' instead of `elmo-folder-get-spec'; + Use macro `wl-summary-buffer-folder-name' instead of variable + `wl-summary-buffer-folder-name'. + * wl-score.el: Likewise. + + * wl-message.el: Rewrite for new message buffer cache mechanism. + (wl-message-buffer-cache-buffer-get): New macro. + (wl-message-buffer-cache-folder-get): Ditto. + (wl-message-buffer-cache-message-get): Ditto. + (wl-message-buffer-cache-entry-make): Ditto. + (wl-message-buffer-cache-hit): Ditto. + (wl-message-buffer-cache-sort): New function. + (wl-message-buffer-cache-add): Ditto. + (wl-message-buffer-cache-delete): Ditto. + (wl-message-buffer-cache-clean-up): Ditto. + (wl-message-buffer-window): Rewrite. + (wl-message-select-buffer): Renamed from `wl-select-buffer'. + (wl-message-buffer-display): New function. + (wl-message-display-internal): New function. + +2001-01-12 Yuuichi Teranishi + + * wl-folder.el: Use `elmo-folder-name-internal'; + Use `wl-folder-get-elmo-folder'; + Use `elmo-folder-list-messages' instead of + `elmo-list-folder'; + Use `elmo-folder-get-primitive-list' instead of + `elmo-folder-get-primitive-spec-list'; + Use `elmo-folder-list-subfolders' instead of `elmo-list-folders'; + Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path'; + Use `elmo-folder-create' instead of `elmo-create-folder'. + (wl-folder-create-newsgroups-from-nntp-access2): Abolish. + (wl-folder-get-elmo-folder): New macro. + (wl-folder-elmo-folder-cache-get): Ditto. + (wl-folder-elmo-folder-cache-put): Ditto. + (wl-folder-suspend): Call `elmo-quit'. + + * wl.el: Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path'; + Use `elmo-folder-list-messages' instead of `elmo-list-folder'; + Use `elmo-net-port-info' instead of `elmo-folder-portinfo'; + Use `wl-folder-get-elmo-folder' instead of `elmo-folder-get-spec'. + (toplevel): require 'cl. + (wl-exit): Call `wl-message-buffer-cache-clean-up' and `elmo-quit'. + + * wl-summary.el: Rewrite to use new elmo interface. + + 2001-02-06 Yuuichi Teranishi * wl-mime.el (wl-draft-preview-message): diff --git a/wl/wl-address.el b/wl/wl-address.el index 259ae2b..52e1ee2 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -460,11 +460,11 @@ Matched address lists are append to CL." (let ((list (sort (all-completions pattern cl) 'string<))) (wl-complete-window-show list))))))) -(defvar wl-address-init-func 'wl-local-address-init) +(defvar wl-address-init-function 'wl-local-address-init) (defun wl-address-init () - "Call `wl-address-init-func'." - (funcall wl-address-init-func)) + "Call `wl-address-init-function'." + (funcall wl-address-init-function)) (defun wl-local-address-init () "Reload `wl-address-file'. diff --git a/wl/wl-draft.el b/wl/wl-draft.el index e7d7787..7a3f01a 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -50,8 +50,7 @@ (defalias-maybe 'wl-draft-mode 'ignore)) (defvar wl-draft-buf-name "Draft") -(defvar wl-caesar-region-func nil) -(defvar wl-draft-cite-func 'wl-default-draft-cite) +(defvar wl-draft-cite-function 'wl-default-draft-cite) (defvar wl-draft-buffer-file-name nil) (defvar wl-draft-field-completion-list nil) (defvar wl-draft-verbose-send t) @@ -64,7 +63,7 @@ (defvar wl-draft-sendlog-filename "sendlog") (defvar wl-draft-queue-save-filename "qinfo") (defvar wl-draft-config-save-filename "config") -(defvar wl-draft-queue-flush-send-func 'wl-draft-dispatch-message) +(defvar wl-draft-queue-flush-send-function 'wl-draft-dispatch-message) (defvar wl-sent-message-via nil) (defvar wl-sent-message-modified nil) (defvar wl-draft-fcc-list nil) @@ -174,13 +173,13 @@ (defun wl-draft-insert-x-face-field () "Insert X-Face header." (interactive) - (unless (file-exists-p wl-x-face-file) - (error "File %s does not exist" wl-x-face-file)) - (beginning-of-buffer) - (search-forward mail-header-separator nil t) - (beginning-of-line) - (wl-draft-insert-x-face-field-here) - (run-hooks 'wl-draft-insert-x-face-field-hook)) ; highlight it if you want. + (if (not (file-exists-p wl-x-face-file)) + (error "File %s does not exist" wl-x-face-file) + (beginning-of-buffer) + (search-forward mail-header-separator nil t) + (beginning-of-line) + (wl-draft-insert-x-face-field-here) + (run-hooks 'wl-draft-insert-x-face-field-hook))) ; highlight it if you want. (defun wl-draft-insert-x-face-field-here () "Insert X-Face field at point." @@ -441,8 +440,7 @@ Reply to author if WITH-ARG is non-nil." (let ((beg (point))) (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) (mail-yank-hooks (run-hooks 'mail-yank-hooks)) - (t (and wl-draft-cite-func - (funcall wl-draft-cite-func)))) ; default cite + (wl-draft-cite-function (funcall wl-draft-cite-function))) ; default cite (run-hooks 'wl-draft-cited-hook) (when (and wl-draft-add-references (wl-draft-add-references)) @@ -453,11 +451,15 @@ Reply to author if WITH-ARG is non-nil." (defun wl-draft-confirm () "Confirm send message." (interactive) - (y-or-n-p - (cond ((and (wl-message-mail-p) (wl-message-news-p)) - "Send current draft as Mail and News? ") - ((wl-message-mail-p) "Send current draft as Mail? ") - ((wl-message-news-p) "Send current draft as News? ")))) + (y-or-n-p (format "Send current draft as %s? " + (cond ((and (wl-message-mail-p) (wl-message-news-p)) + "Mail and News") + ((wl-message-mail-p) "Mail") + ((wl-message-news-p) "News"))))) + +(defun wl-message-news-p () + "If exist valid Newsgroups field, return non-nil." + (std11-field-body "Newsgroups")) (defun wl-message-field-exists-p (field) "If FIELD exist and FIELD value is not empty, return non-nil." @@ -465,10 +467,6 @@ Reply to author if WITH-ARG is non-nil." (and value (not (string= value ""))))) -(defun wl-message-news-p () - "If exist valid Newsgroups field, return non-nil." - (std11-field-body "Newsgroups")) - (defun wl-message-mail-p () "If exist To, Cc or Bcc field, return non-nil." (or (wl-message-field-exists-p "To") @@ -513,7 +511,7 @@ Reply to author if WITH-ARG is non-nil." (eword-decode-string (decode-mime-charset-string from - wl-mime-charset)))) + wl-mime-charset)))) (setq in-reply-to (std11-field-body "In-Reply-To")) (setq cc (std11-field-body "Cc")) (setq cc (and cc @@ -547,15 +545,21 @@ Reply to author if WITH-ARG is non-nil." (defun wl-draft-insert-current-message (dummy) (interactive) - (let ((mail-reply-buffer (wl-message-get-original-buffer)) + (let (original-buffer + mail-reply-buffer mail-citation-hook mail-yank-hooks - wl-draft-add-references wl-draft-cite-func) - (if (zerop - (with-current-buffer mail-reply-buffer - (buffer-size))) - (error "No current message") - (wl-draft-yank-from-mail-reply-buffer nil - wl-ignored-forwarded-headers)))) + wl-draft-add-references wl-draft-cite-function) + (with-current-buffer wl-draft-buffer-cur-summary-buffer + (with-current-buffer wl-message-buffer + (setq original-buffer (wl-message-get-original-buffer)) + (if (zerop + (with-current-buffer original-buffer + (buffer-size))) + (error "No current message")))) + (setq mail-reply-buffer original-buffer) + (wl-draft-yank-from-mail-reply-buffer + nil + wl-ignored-forwarded-headers))) (defun wl-draft-insert-get-message (dummy) (let ((fld (completing-read @@ -571,11 +575,14 @@ Reply to author if WITH-ARG is non-nil." num)))) (mail-reply-buffer (get-buffer-create "*wl-draft-insert-get-message*")) mail-citation-hook mail-yank-hooks - wl-draft-cite-func) + wl-draft-cite-function) (unwind-protect (progn - (save-excursion - (elmo-read-msg-with-cache fld number mail-reply-buffer nil)) + (elmo-message-fetch (wl-folder-get-elmo-folder fld) + number + ;; No cache. + (elmo-make-fetch-strategy 'entire) + nil mail-reply-buffer) (wl-draft-yank-from-mail-reply-buffer nil)) (kill-buffer mail-reply-buffer)))) @@ -588,6 +595,7 @@ Reply to author if WITH-ARG is non-nil." (summary-buf wl-current-summary-buffer) (message-buf (get-buffer (wl-current-message-buffer))) from date cite-title num entity) + (setq date (std11-fetch-field "date")) (if (and summary-buf (buffer-live-p summary-buf) message-buf @@ -599,13 +607,9 @@ Reply to author if WITH-ARG is non-nil." (save-excursion (set-buffer message-buf) wl-message-buffer-cur-number)) - (setq entity (assoc (cdr (assq num - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) - (elmo-msgdb-get-overview - wl-summary-buffer-msgdb))) - (setq from (elmo-msgdb-overview-entity-get-from entity)) - (setq date (elmo-msgdb-overview-entity-get-date entity))) + (setq entity (elmo-msgdb-overview-get-entity + num (wl-summary-buffer-msgdb))) + (setq from (elmo-msgdb-overview-entity-get-from entity))) (setq cite-title (format "At %s,\n%s wrote:" (or date "some time ago") (wl-summary-from-func-internal @@ -958,15 +962,15 @@ non-nil." (let ((session (elmo-pop3-get-session (list 'pop3 (or wl-pop-before-smtp-user - elmo-default-pop3-user) + elmo-pop3-default-user) (or wl-pop-before-smtp-authenticate-type - elmo-default-pop3-authenticate-type) + elmo-pop3-default-authenticate-type) (or wl-pop-before-smtp-server - elmo-default-pop3-server) + elmo-pop3-default-server) (or wl-pop-before-smtp-port - elmo-default-pop3-port) + elmo-pop3-default-port) (or wl-pop-before-smtp-stream-type - elmo-default-pop3-stream-type))))) + elmo-pop3-default-stream-type))))) (when session (elmo-network-close-session session))) (error)) (wl-draft-send-mail-with-smtp)) @@ -1026,11 +1030,11 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'." (progn (if (and (wl-message-mail-p) (not (wl-draft-sent-message-p 'mail))) - (funcall wl-draft-send-mail-func)) + (funcall wl-draft-send-mail-function)) (if (and (wl-message-news-p) (not (wl-draft-sent-message-p 'news)) (not (wl-message-field-exists-p "Resent-to"))) - (funcall wl-draft-send-news-func))) + (funcall wl-draft-send-news-function))) ;; (let* ((status (wl-draft-sent-message-results)) (unplugged-via (car status)) @@ -1043,7 +1047,7 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'." (if wl-draft-use-cache (let ((id (std11-field-body "Message-ID")) (elmo-enable-disconnected-operation t)) - (elmo-cache-save id nil nil nil))) + (elmo-file-cache-save id nil))) ;; If one unplugged, append queue. (when (and unplugged-via wl-sent-message-modified) @@ -1113,7 +1117,7 @@ If optional argument is non-nil, current draft buffer is killed" (run-hooks 'mail-send-hook) ; translate buffer (if wl-draft-verbose-send (message (or mes-string "Sending..."))) - (funcall wl-draft-send-func editing-buffer kill-when-done) + (funcall wl-draft-send-function editing-buffer kill-when-done) ;; Now perform actions on successful sending. (while mail-send-actions (condition-case () @@ -1121,9 +1125,9 @@ If optional argument is non-nil, current draft buffer is killed" (cdr (car mail-send-actions))) (error)) (setq mail-send-actions (cdr mail-send-actions))) - (if (or (eq major-mode 'wl-draft-mode) - (eq major-mode 'mail-mode)) - (local-set-key "\C-c\C-s" 'wl-draft-send)) ; override +;; (if (or (eq major-mode 'wl-draft-mode) +;; (eq major-mode 'mail-mode)) +;; (local-set-key "\C-c\C-s" 'wl-draft-send)) ; override (if wl-draft-verbose-send (message (concat (or wl-draft-verbose-msg mes-string "Sending...") @@ -1217,7 +1221,8 @@ If optional argument is non-nil, current draft buffer is killed" (point))) fcc-list)) (save-match-data - (wl-folder-confirm-existence (eword-decode-string (car fcc-list)))) + (wl-folder-confirm-existence + (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list))))) (delete-region (match-beginning 0) (progn (forward-line 1) (point))))) fcc-list)) @@ -1244,13 +1249,14 @@ If optional argument is non-nil, current draft buffer is killed" cache-saved) (while fcc-list (unless (or cache-saved - (elmo-folder-plugged-p (car fcc-list))) - (elmo-cache-save id nil nil nil) ;; for disconnected operation + (elmo-folder-plugged-p + (wl-folder-get-elmo-folder (car fcc-list)))) + (elmo-file-cache-save id nil) ;; for disconnected operation (setq cache-saved t)) - (if (elmo-append-msg (eword-decode-string (car fcc-list)) - (buffer-substring - (point-min) (point-max)) - id) + (if (elmo-folder-append-buffer + (wl-folder-get-elmo-folder + (eword-decode-string (car fcc-list))) + id) (wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id) (wl-draft-write-sendlog 'failed 'fcc nil (car fcc-list) id)) (setq fcc-list (cdr fcc-list))))) @@ -1277,6 +1283,10 @@ If optional argument is non-nil, current draft buffer is killed" nil (if (re-search-forward ":" pos t) nil t))))))) +(defun wl-draft-random-alphabet () + (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z))) + (nth (abs (% (random) 26)) alphabet))) + ;;;###autoload (defun wl-draft (&optional to subject in-reply-to cc references newsgroups mail-followup-to @@ -1288,22 +1298,24 @@ If optional argument is non-nil, current draft buffer is killed" (require 'wl)) (unless wl-init (wl-load-profile)) - (wl-init 'wl-draft) ;; returns immediately if already initialized. + (wl-init) ;; returns immediately if already initialized. (if (interactive-p) - (setq summary-buf (wl-summary-get-buffer wl-summary-buffer-folder-name))) - (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder)) + (setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name)))) + (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) buf-name file-name num wl-demo change-major-mode-hook) - (if (not (eq (car draft-folder-spec) 'localdir)) + (if (not (elmo-folder-message-file-p draft-folder)) (error "%s folder cannot be used for draft folder" wl-draft-folder)) - (setq num (elmo-max-of-list (or (elmo-list-folder wl-draft-folder) '(0)))) + (setq num (elmo-max-of-list + (or (elmo-folder-list-messages draft-folder) '(0)))) (setq num (+ 1 num)) ;; To get unused buffer name. (while (get-buffer (concat wl-draft-folder "/" (int-to-string num))) (setq num (+ 1 num))) (setq buf-name (find-file-noselect (setq file-name - (elmo-get-msg-filename wl-draft-folder - num)))) + (elmo-message-file-name + (wl-folder-get-elmo-folder wl-draft-folder) + num)))) (if wl-draft-use-frame (switch-to-buffer-other-frame buf-name) (switch-to-buffer buf-name)) @@ -1335,8 +1347,7 @@ If optional argument is non-nil, current draft buffer is killed" wl-from) "\n")) (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n")) (and references (insert "References: " references "\n")) - (insert (funcall wl-generate-mailer-string-func) - "\n") + (insert (funcall wl-generate-mailer-string-function) "\n") (setq wl-draft-buffer-file-name file-name) (if mail-default-reply-to (insert "Reply-To: " mail-default-reply-to "\n")) @@ -1421,21 +1432,21 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft-elmo-nntp-send () (let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook) - (elmo-default-nntp-user - (or wl-nntp-posting-user elmo-default-nntp-user)) - (elmo-default-nntp-server - (or wl-nntp-posting-server elmo-default-nntp-server)) - (elmo-default-nntp-port - (or wl-nntp-posting-port elmo-default-nntp-port)) - (elmo-default-nntp-stream-type - (or wl-nntp-posting-stream-type elmo-default-nntp-stream-type))) - (if (not (elmo-plugged-p elmo-default-nntp-server elmo-default-nntp-port)) + (elmo-nntp-default-user + (or wl-nntp-posting-user elmo-nntp-default-user)) + (elmo-nntp-default-server + (or wl-nntp-posting-server elmo-nntp-default-server)) + (elmo-nntp-default-port + (or wl-nntp-posting-port elmo-nntp-default-port)) + (elmo-nntp-default-stream-type + (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type))) + (if (not (elmo-plugged-p elmo-nntp-default-server elmo-nntp-default-port)) (wl-draft-set-sent-message 'news 'unplugged - (cons elmo-default-nntp-server - elmo-default-nntp-port)) - (elmo-nntp-post elmo-default-nntp-server (current-buffer)) + (cons elmo-nntp-default-server + elmo-nntp-default-port)) + (elmo-nntp-post elmo-nntp-default-server (current-buffer)) (wl-draft-set-sent-message 'news 'sent) - (wl-draft-write-sendlog 'ok 'nntp elmo-default-nntp-server + (wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server (std11-field-body "Newsgroups") (std11-field-body "Message-ID"))))) @@ -1459,14 +1470,10 @@ If optional argument is non-nil, current draft buffer is killed" (current-buffer)))) (defun wl-draft-reedit (number) - (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder)) + (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) (wl-draft-reedit t) buf-name file-name change-major-mode-hook) - (setq file-name (expand-file-name - (int-to-string number) - (expand-file-name - (nth 1 draft-folder-spec) - elmo-localdir-folder-path))) + (setq file-name (elmo-message-file-name draft-folder number)) (unless (file-exists-p file-name) (error "File %s does not exist" file-name)) (setq buf-name (find-file-noselect file-name)) @@ -1699,7 +1706,8 @@ If optional argument is non-nil, current draft buffer is killed" (insert (concat field ": " content "\n")))))))) (defun wl-draft-config-info-operation (msg operation) - (let* ((msgdb-dir (elmo-msgdb-expand-path wl-draft-folder)) + (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-folder-get-elmo-folder + wl-draft-folder))) (filename (expand-file-name (format "%s-%d" wl-draft-config-save-filename msg) @@ -1724,7 +1732,8 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft-queue-info-operation (msg operation &optional add-sent-message-via) - (let* ((msgdb-dir (elmo-msgdb-expand-path wl-queue-folder)) + (let* ((msgdb-dir (elmo-folder-msgdb-path + (wl-folder-get-elmo-folder wl-queue-folder))) (filename (expand-file-name (format "%s-%d" wl-draft-queue-save-filename msg) @@ -1758,15 +1767,12 @@ If optional argument is non-nil, current draft buffer is killed" (if wl-draft-verbose-send (message "Queuing...")) (let ((send-buffer (current-buffer)) + (folder (wl-folder-get-elmo-folder wl-queue-folder)) (message-id (std11-field-body "Message-ID"))) - (if (elmo-append-msg wl-queue-folder - (buffer-substring (point-min) (point-max)) - message-id) + (if (elmo-folder-append-buffer folder t) (progn - (if message-id - (elmo-dop-lock-message message-id)) (wl-draft-queue-info-operation - (car (elmo-max-of-folder wl-queue-folder)) + (car (elmo-folder-status folder)) 'save wl-sent-message-via) (wl-draft-write-sendlog 'ok 'queue nil wl-queue-folder message-id) (when wl-draft-verbose-send @@ -1778,11 +1784,12 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft-queue-flush () "Flush draft queue." (interactive) - (let ((msgs2 (elmo-list-folder wl-queue-folder)) - (i 0) - (performed 0) - (wl-draft-queue-flushing t) - msgs failure len buffer msgid sent-via) + (let* ((queue-folder (wl-folder-get-elmo-folder wl-queue-folder)) + (msgs2 (elmo-folder-list-messages queue-folder)) + (i 0) + (performed 0) + (wl-draft-queue-flushing t) + msgs failure len buffer msgid sent-via) ;; get plugged send message (while msgs2 (setq sent-via (wl-draft-queue-info-operation (car msgs2) 'get-sent-via)) @@ -1813,11 +1820,13 @@ If optional argument is non-nil, current draft buffer is killed" failure nil) (setq wl-sent-message-via nil) (wl-draft-queue-info-operation (car msgs) 'load) - (elmo-read-msg-no-cache wl-queue-folder (car msgs) - (current-buffer)) + (elmo-message-fetch queue-folder + (car msgs) + (elmo-make-fetch-strategy 'entire) + nil (current-buffer)) (condition-case err (setq failure (funcall - wl-draft-queue-flush-send-func + wl-draft-queue-flush-send-function (format "Sending (%d/%d)..." i len))) ;;; (wl-draft-raw-send nil nil ;;; (format "Sending (%d/%d)..." i len)) @@ -1827,9 +1836,9 @@ If optional argument is non-nil, current draft buffer is killed" (quit (setq failure t))) (unless failure - (elmo-delete-msgs wl-queue-folder (cons (car msgs) nil)) + (elmo-folder-delete-messages + queue-folder (cons (car msgs) nil)) (wl-draft-queue-info-operation (car msgs) 'delete) - (elmo-dop-unlock-message (std11-field-body "Message-ID")) (setq performed (+ 1 performed))) (setq msgs (cdr msgs))) (kill-buffer buffer) @@ -1845,10 +1854,8 @@ If optional argument is non-nil, current draft buffer is killed" (let ((bufs (buffer-list)) (draft-regexp (concat "^" (regexp-quote - (expand-file-name - (nth 1 (elmo-folder-get-spec wl-draft-folder)) - (expand-file-name - elmo-localdir-folder-path))))) + (elmo-localdir-folder-directory-internal + (wl-folder-get-elmo-folder wl-draft-folder))))) buf draft-bufs) (while bufs (if (and @@ -1868,7 +1875,8 @@ If optional argument is non-nil, current draft buffer is killed" (switch-to-buffer buf)))))) (defun wl-jump-to-draft-folder () - (let ((msgs (reverse (elmo-list-folder wl-draft-folder))) + (let ((msgs (reverse (elmo-folder-list-messages (wl-folder-get-elmo-folder + wl-draft-folder)))) (mybuf (buffer-name)) msg buf) (if (not msgs) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 17135fc..e441e07 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -62,6 +62,7 @@ ;;; Code: ;; +(require 'elmo) (eval-when-compile (require 'wl-folder) (require 'wl-summary) @@ -357,7 +358,7 @@ ((string= fld-name wl-queue-folder);; queue folder (get 'wl-folder-queue-image 'image)) (;; and one of many other folders - (setq type (elmo-folder-get-type fld-name)) + (setq type (elmo-folder-type fld-name)) (get (intern (format "wl-folder-%s-image" type)) 'image))))) (overlay-put overlay 'before-string image))) @@ -411,7 +412,7 @@ (concat (propertize " " 'display (get 'wl-folder-queue-image 'image)) string)) - ((setq type (elmo-folder-get-type folder)) + ((setq type (elmo-folder-type folder)) (concat (propertize " " 'display (get (intern (format "wl-folder-%s-image" type)) @@ -434,6 +435,8 @@ (wl-folder-archive-image . wl-archive-folder-icon) (wl-folder-pipe-image . wl-pipe-folder-icon) (wl-folder-maildir-image . wl-maildir-folder-icon) + (wl-folder-nmz-image . wl-nmz-folder-icon) + (wl-folder-shimbun-image . wl-shimbun-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) @@ -537,7 +540,8 @@ (defun wl-message-wheel-up (event) (interactive "e") - (if (string-match wl-message-buf-name (buffer-name)) + (if (string-match (regexp-quote wl-message-buffer-cache-name) + (regexp-quote (buffer-name))) (wl-message-next-page) (let ((cur-buf (current-buffer)) proceed) @@ -552,7 +556,8 @@ (defun wl-message-wheel-down (event) (interactive "e") - (if (string-match wl-message-buf-name (buffer-name)) + (if (string-match (regexp-quote wl-message-buffer-cache-name) + (regexp-quote (buffer-name))) (wl-message-prev-page) (let ((cur-buf (current-buffer)) proceed) @@ -609,7 +614,7 @@ Special commands: (defun wl-draft-overload-functions () (wl-mode-line-buffer-identification) - (local-set-key "\C-c\C-s" 'wl-draft-send);; override +;; (local-set-key "\C-c\C-s" 'wl-draft-send);; override (wl-e21-setup-draft-toolbar) (wl-draft-overload-menubar)) diff --git a/wl/wl-expire.el b/wl/wl-expire.el index 178dab0..755221f 100644 --- a/wl/wl-expire.el +++ b/wl/wl-expire.el @@ -30,6 +30,7 @@ (require 'wl-summary) (require 'wl-thread) (require 'wl-folder) +(require 'elmo) ;;; Code: @@ -43,6 +44,7 @@ (defvar wl-expired-alist-file-name "expired-alist") (defvar wl-expired-log-alist nil) (defvar wl-expired-log-alist-file-name "expired-log") +(defvar wl-expire-test nil) ;; for debug (no execute) (defun wl-expired-alist-load () (elmo-object-load (expand-file-name @@ -105,15 +107,14 @@ (format "Expiring (delete) %s msgs..." (length delete-list)))) (message "%s" mess) - (if (elmo-delete-msgs folder - delete-list - msgdb) + (if (elmo-folder-delete-messages folder + delete-list) (progn - (elmo-msgdb-delete-msgs folder - delete-list - msgdb - t) - (wl-expire-append-log folder delete-list nil 'delete) + (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) + delete-list) + (wl-expire-append-log + (elmo-folder-name-internal folder) + delete-list nil 'delete) (message "%s" (concat mess "done"))) (error (concat mess "failed!"))))) (cons delete-list (length delete-list))) @@ -121,39 +122,43 @@ (defun wl-expire-refile (folder refile-list msgdb dst-folder &optional no-reserve-marks preserve-number copy) "Refile message for expire. If COPY is non-nil, copy message." - (when (not (string= folder dst-folder)) + (when (not (string= (elmo-folder-name-internal folder) dst-folder)) (unless no-reserve-marks (setq refile-list (wl-expire-delete-reserve-marked-msgs-from-list refile-list (elmo-msgdb-get-mark-alist msgdb)))) (when refile-list - (let* ((doingmes (if copy - "Copying %s" - "Expiring (move %s)")) - (mess (format (concat doingmes " %s msgs...") - dst-folder (length refile-list)))) - (message "%s" mess) - (unless (or (elmo-folder-exists-p dst-folder) - (elmo-create-folder dst-folder)) - (error "%s: create folder failed" dst-folder)) - (if wl-expire-add-seen-list - (elmo-msgdb-add-msgs-to-seen-list - dst-folder - refile-list - msgdb - (concat wl-summary-important-mark - wl-summary-read-uncached-mark))) - (if (elmo-move-msgs folder - refile-list - dst-folder - msgdb - nil nil t - copy - preserve-number) - (progn - (wl-expire-append-log folder refile-list dst-folder (if copy 'copy 'move)) - (message "%s" (concat mess "done"))) - (error (concat mess "failed!"))))) + (let* ((doingmes (if copy + "Copying %s" + "Expiring (move %s)")) + (dst-folder (wl-folder-get-elmo-folder dst-folder)) + (mess (format (concat doingmes " %s msgs...") + (elmo-folder-name-internal dst-folder) + (length refile-list)))) + (message "%s" mess) + (if wl-expire-test + nil + (unless (or (elmo-folder-exists-p dst-folder) + (elmo-folder-create dst-folder)) + (error "%s: create folder failed" + (elmo-folder-name-internal dst-folder))) + (if (elmo-folder-move-messages folder + refile-list + dst-folder + msgdb + nil nil t + copy + preserve-number + nil + wl-expire-add-seen-list) + (progn + (wl-expire-append-log + (elmo-folder-name-internal folder) + refile-list + (elmo-folder-name-internal dst-folder) + (if copy 'copy 'move)) + (message "%s" (concat mess "done"))) + (error (concat mess "failed!")))))) (cons refile-list (length refile-list)))) (defun wl-expire-refile-with-copy-reserve-msg @@ -161,108 +166,117 @@ &optional no-reserve-marks preserve-number copy) "Refile message for expire. If REFILE-LIST includes reserve mark message, so copy." - (when (not (string= folder dst-folder)) + (when (not (string= (elmo-folder-name-internal folder) dst-folder)) (let ((msglist refile-list) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) + (mark-alist (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) + (number-alist (elmo-msgdb-get-number-alist (elmo-folder-msgdb + folder))) + (dst-folder (wl-folder-get-elmo-folder dst-folder)) (ret-val t) (copy-reserve-message) (copy-len 0) msg msg-id) (message "Expiring (move %s) %s msgs..." - dst-folder (length refile-list)) - (unless (or (elmo-folder-exists-p dst-folder) - (elmo-create-folder dst-folder)) - (error "%s: create folder failed" dst-folder)) - (while (setq msg (wl-pop msglist)) - (unless (wl-expire-msg-p msg mark-alist) - (setq msg-id (cdr (assq msg number-alist))) - (if (assoc msg-id wl-expired-alist) - ;; reserve mark message already refiled or expired - (setq refile-list (delq msg refile-list)) - ;; reserve mark message not refiled - (wl-append wl-expired-alist (list (cons msg-id dst-folder))) - (setq copy-reserve-message t)))) - (when refile-list - (if wl-expire-add-seen-list - (elmo-msgdb-add-msgs-to-seen-list - dst-folder - refile-list - msgdb - (concat wl-summary-important-mark - wl-summary-read-uncached-mark))) - (unless - (setq ret-val - (elmo-move-msgs folder - refile-list - dst-folder - msgdb - nil nil t - copy-reserve-message - preserve-number)) - (error "Expire: move msgs to %s failed" dst-folder)) - (wl-expire-append-log folder refile-list dst-folder - (if copy-reserve-message 'copy 'move)) - (setq copy-len (length refile-list)) - (when copy-reserve-message - (setq refile-list - (wl-expire-delete-reserve-marked-msgs-from-list - refile-list - mark-alist)) - (when refile-list - (if (setq ret-val - (elmo-delete-msgs folder - refile-list - msgdb)) - (progn - (elmo-msgdb-delete-msgs folder - refile-list - msgdb - t) - (wl-expire-append-log folder refile-list nil 'delete)))))) - (let ((mes (format "Expiring (move %s) %s msgs..." - dst-folder (length refile-list)))) - (if ret-val - (message (concat mes "done")) - (error (concat mes "failed!")))) + (elmo-folder-name-internal dst-folder) (length refile-list)) + (if wl-expire-test + (setq copy-len (length refile-list)) + (unless (or (elmo-folder-exists-p dst-folder) + (elmo-folder-create dst-folder)) + (error "%s: create folder failed" (elmo-folder-name-internal + dst-folder))) + (while (setq msg (wl-pop msglist)) + (unless (wl-expire-msg-p msg mark-alist) + (setq msg-id (cdr (assq msg number-alist))) + (if (assoc msg-id wl-expired-alist) + ;; reserve mark message already refiled or expired + (setq refile-list (delq msg refile-list)) + ;; reserve mark message not refiled + (wl-append wl-expired-alist (list (cons msg-id + (elmo-folder-name-internal + dst-folder)))) + (setq copy-reserve-message t)))) + (when refile-list + (unless + (setq ret-val + (elmo-folder-move-messages folder + refile-list + dst-folder + msgdb + nil nil t + copy-reserve-message + preserve-number + nil + wl-expire-add-seen-list + )) + (error "Expire: move msgs to %s failed" + (elmo-folder-name-internal dst-folder))) + (wl-expire-append-log (elmo-folder-name-internal folder) + refile-list + (elmo-folder-name-internal dst-folder) + (if copy-reserve-message 'copy 'move)) + (setq copy-len (length refile-list)) + (when copy-reserve-message + (setq refile-list + (wl-expire-delete-reserve-marked-msgs-from-list + refile-list + mark-alist)) + (when refile-list + (if (setq ret-val + (elmo-folder-delete-messages folder + refile-list)) + (progn + (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) + refile-list) + (wl-expire-append-log + (elmo-folder-name-internal folder) + refile-list nil 'delete)))))) + (let ((mes (format "Expiring (move %s) %s msgs..." + (elmo-folder-name-internal dst-folder) + (length refile-list)))) + (if ret-val + (message (concat mes "done")) + (error (concat mes "failed!"))))) (cons refile-list copy-len)))) -(defun wl-expire-archive-get-folder (src-folder &optional fmt) +(defun wl-expire-archive-get-folder (src-folder &optional fmt dst-folder-arg) "Get archive folder name from SRC-FOLDER." - (let* ((spec (elmo-folder-get-spec src-folder)) - (fmt (or fmt wl-expire-archive-folder-name-fmt)) + (let* ((fmt (or fmt wl-expire-archive-folder-name-fmt)) + (src-folde-name (substring + (elmo-folder-name-internal src-folder) + (length (elmo-folder-prefix-internal src-folder)))) (archive-spec (char-to-string - (car (rassq 'archive elmo-spec-alist)))) + (car (rassq 'archive elmo-folder-type-alist)))) dst-folder-base dst-folder-fmt prefix) - (cond ((eq (car spec) 'localdir) - (setq dst-folder-base (concat archive-spec (nth 1 spec)))) - ((stringp (nth 1 spec)) + (cond (dst-folder-arg + (setq dst-folder-base (concat archive-spec dst-folder-arg))) + ((eq (elmo-folder-type-internal src-folder) 'localdir) (setq dst-folder-base - (elmo-concat-path (format "%s%s" archive-spec (car spec)) - (nth 1 spec)))) + (concat archive-spec src-folde-name))) (t (setq dst-folder-base - (elmo-concat-path (format "%s%s" archive-spec (car spec)) - (elmo-replace-msgid-as-filename - src-folder))))) + (elmo-concat-path + (format "%s%s" archive-spec (elmo-folder-type-internal + src-folder)) + src-folde-name)))) (setq dst-folder-fmt (format fmt dst-folder-base wl-expire-archive-folder-type)) (setq dst-folder-base (format "%s;%s" dst-folder-base wl-expire-archive-folder-type)) - (when (and wl-expire-archive-folder-prefix - (stringp (nth 1 spec))) + (when wl-expire-archive-folder-prefix (cond ((eq wl-expire-archive-folder-prefix 'short) - (setq prefix (file-name-nondirectory (nth 1 spec)))) + (setq prefix (file-name-nondirectory + src-folde-name))) (t - (setq prefix (nth 1 spec)))) + (setq prefix src-folde-name))) (setq dst-folder-fmt (concat dst-folder-fmt ";" prefix)) (setq dst-folder-base (concat dst-folder-base ";" prefix))) (cons dst-folder-base dst-folder-fmt))) (defsubst wl-expire-archive-get-max-number (dst-folder-base &optional regexp) - (let ((files (reverse (sort (elmo-list-folders dst-folder-base) + (let ((files (reverse (sort (elmo-folder-list-subfolders + (elmo-make-folder dst-folder-base)) 'string<))) (regexp (or regexp wl-expire-archive-folder-num-regexp)) filenum in-folder) @@ -270,7 +284,8 @@ If REFILE-LIST includes reserve mark message, so copy." (while files (when (string-match regexp (car files)) (setq filenum (elmo-match-string 1 (car files))) - (setq in-folder (elmo-max-of-folder (car files))) + (setq in-folder (elmo-folder-status + (wl-folder-get-elmo-folder (car files)))) (throw 'done (cons in-folder filenum))) (setq files (cdr files)))))) @@ -280,9 +295,12 @@ If REFILE-LIST includes reserve mark message, so copy." (let ((len 0) (max-num 0) folder-info dels) (if (or (and file (setq folder-info - (cons (elmo-max-of-folder file) nil))) - (setq folder-info (wl-expire-archive-get-max-number dst-folder-base - regexp))) + (cons (elmo-folder-status + (wl-folder-get-elmo-folder file)) + nil))) + (setq folder-info (wl-expire-archive-get-max-number + dst-folder-base + regexp))) (progn (setq len (cdar folder-info)) (when preserve-number @@ -305,12 +323,18 @@ If REFILE-LIST includes reserve mark message, so copy." (list msgs dels 0 "0" 0)))) (defun wl-expire-archive-number1 (folder delete-list msgdb - &optional preserve-number no-delete) + &optional preserve-number dst-folder-arg + no-delete) "Standard function for `wl-summary-expire'. Refile to archive folder followed message number." (let* ((elmo-archive-treat-file t) ;; treat archive folder as a file. + (dst-folder-expand (and dst-folder-arg + (wl-expand-newtext + dst-folder-arg + (elmo-folder-name-internal folder)))) (dst-folder-fmt (funcall - wl-expire-archive-get-folder-func folder)) + wl-expire-archive-get-folder-function + folder nil dst-folder-expand)) (dst-folder-base (car dst-folder-fmt)) (dst-folder-fmt (cdr dst-folder-fmt)) (refile-func (if no-delete @@ -347,16 +371,21 @@ Refile to archive folder followed message number." (throw 'done t)) (wl-append arcmsg-list (list msg)) (setq prev-arcnum arcnum))) - deleted-list - )) + deleted-list)) (defun wl-expire-archive-number2 (folder delete-list msgdb - &optional preserve-number no-delete) + &optional preserve-number dst-folder-arg + no-delete) "Standard function for `wl-summary-expire'. Refile to archive folder followed the number of message in one archive folder." (let* ((elmo-archive-treat-file t) ;; treat archive folder as a file. + (dst-folder-expand (and dst-folder-arg + (wl-expand-newtext + dst-folder-arg + (elmo-folder-name-internal folder)))) (dst-folder-fmt (funcall - wl-expire-archive-get-folder-func folder)) + wl-expire-archive-get-folder-function + folder nil dst-folder-expand)) (dst-folder-base (car dst-folder-fmt)) (dst-folder-fmt (cdr dst-folder-fmt)) (refile-func (if no-delete @@ -402,20 +431,25 @@ Refile to archive folder followed the number of message in one archive folder." (if (null msg) (throw 'done t)) (wl-append arcmsg-list (list msg)))) - deleted-list - )) + deleted-list)) (defun wl-expire-archive-date (folder delete-list msgdb - &optional preserve-number no-delete) + &optional preserve-number dst-folder-arg + no-delete) "Standard function for `wl-summary-expire'. Refile to archive folder followed message date." (let* ((elmo-archive-treat-file t) ;; treat archive folder as a file. (number-alist (elmo-msgdb-get-number-alist msgdb)) (overview (elmo-msgdb-get-overview msgdb)) + (dst-folder-expand (and dst-folder-arg + (wl-expand-newtext + dst-folder-arg + (elmo-folder-name-internal folder)))) (dst-folder-fmt (funcall - wl-expire-archive-get-folder-func + wl-expire-archive-get-folder-function folder wl-expire-archive-date-folder-name-fmt + dst-folder-expand )) (dst-folder-base (car dst-folder-fmt)) (dst-folder-fmt (cdr dst-folder-fmt)) @@ -462,8 +496,7 @@ Refile to archive folder followed message date." no-delete)) (wl-append deleted-list (car ret-val))) (setq arcmsg-alist (cdr arcmsg-alist))) - deleted-list - )) + deleted-list)) (defun wl-expire-hide (folder hide-list msgdb &optional no-reserve-marks) "Hide message for expire." @@ -473,32 +506,38 @@ Refile to archive folder followed message date." hide-list (elmo-msgdb-get-mark-alist msgdb)))) (let ((mess (format "Hiding %s msgs..." (length hide-list)))) (message mess) - (elmo-msgdb-delete-msgs folder hide-list msgdb t) + (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) hide-list) (elmo-msgdb-append-to-killed-list folder hide-list) - (elmo-msgdb-save folder msgdb) + (elmo-folder-commit folder) (message (concat mess "done")) (cons hide-list (length hide-list)))) -(defsubst wl-expire-folder-p (folder) - "Return non-nil, when FOLDER matched `wl-expire-alist'." - (wl-get-assoc-list-value wl-expire-alist folder)) +(defsubst wl-expire-folder-p (entity) + "Return non-nil, when ENTITY matched `wl-expire-alist'." + (wl-get-assoc-list-value wl-expire-alist entity)) + +(defsubst wl-archive-folder-p (entity) + "Return non-nil, when ENTITY matched `wl-archive-alist'." + (wl-get-assoc-list-value wl-archive-alist entity)) -(defun wl-summary-expire (&optional folder-name notsummary nolist) +(defun wl-summary-expire (&optional folder notsummary nolist) "" (interactive) - (let ((folder (or folder-name wl-summary-buffer-folder-name)) - (alist wl-expire-alist) + (let ((folder (or folder wl-summary-buffer-elmo-folder)) (deleting-info "Expiring...") expires) - (when (and (or (setq expires (wl-expire-folder-p folder)) + (when (and (or (setq expires (wl-expire-folder-p + (elmo-folder-name-internal folder))) (progn (and (interactive-p) (message "no match %s in wl-expire-alist" - folder)) + (elmo-folder-name-internal folder))) nil)) (or (not (interactive-p)) - (y-or-n-p (format "Expire %s? " folder)))) - (let* ((msgdb (or wl-summary-buffer-msgdb - (elmo-msgdb-load folder))) + (y-or-n-p (format "Expire %s? " (elmo-folder-name-internal + folder))))) + (let* ((msgdb (or (wl-summary-buffer-msgdb) + (progn (elmo-folder-open folder 'load-msgdb) + (elmo-folder-msgdb folder)))) (number-alist (elmo-msgdb-get-number-alist msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) expval rm-type val-type value more args @@ -515,7 +554,7 @@ Refile to archive folder followed message date." ((eq val-type nil)) ((eq val-type 'number) (let* ((msgs (if (not nolist) - (elmo-list-folder folder) + (elmo-folder-list-messages folder) (mapcar 'car number-alist))) (msglen (length msgs)) (more (or more (1+ value))) @@ -549,6 +588,9 @@ Refile to archive folder followed message date." (when delete-list (or wl-expired-alist (setq wl-expired-alist (wl-expired-alist-load))) + ;; evaluate string-match for wl-expand-newtext + (wl-expire-folder-p + (elmo-folder-name-internal folder)) (setq delete-list (cond ((eq rm-type nil) nil) ((eq rm-type 'remove) @@ -562,13 +604,16 @@ Refile to archive folder followed message date." (car (wl-expire-hide folder delete-list msgdb))) ((stringp rm-type) (setq deleting-info "Refiling...") - (car (wl-expire-refile folder delete-list msgdb rm-type))) + (car (wl-expire-refile folder delete-list msgdb + (wl-expand-newtext + rm-type + (elmo-folder-name-internal folder))))) ((fboundp rm-type) (apply rm-type (append (list folder delete-list msgdb) args))) (t (error "%s: invalid type" rm-type)))) - (when (and (not notsummary) delete-list) + (when (and (not wl-expire-test) (not notsummary) delete-list) (wl-summary-delete-messages-on-buffer delete-list deleting-info) (wl-summary-folder-info-update) (wl-summary-set-message-modified) @@ -578,11 +623,11 @@ Refile to archive folder followed message date." (wl-expired-alist-save)) (run-hooks 'wl-summary-expire-hook) (if delete-list - (message "Expiring %s is done" folder) + (message "Expiring %s is done" (elmo-folder-name-internal + folder)) (and (interactive-p) (message "No expire")))) - delete-list - )))) + delete-list)))) (defun wl-folder-expire-entity (entity) (cond @@ -593,25 +638,28 @@ Refile to archive folder followed message date." (setq flist (cdr flist))))) ((stringp entity) (when (wl-expire-folder-p entity) - (let ((update-msgdb (cond + (let* ((folder (wl-folder-get-elmo-folder entity)) + (update-msgdb (cond ((consp wl-expire-folder-update-msgdb) (wl-string-match-member entity wl-expire-folder-update-msgdb)) (t wl-expire-folder-update-msgdb))) - (wl-summary-highlight (if (or (wl-summary-sticky-p entity) + (wl-summary-highlight (if (or (wl-summary-sticky-p folder) (wl-summary-always-sticky-folder-p - entity)) + folder)) wl-summary-highlight)) wl-auto-select-first ret-val) (save-window-excursion (save-excursion (and update-msgdb (wl-summary-goto-folder-subr entity 'force-update nil)) - (setq ret-val (wl-summary-expire entity (not update-msgdb))) + (setq ret-val (wl-summary-expire folder (not update-msgdb))) (if update-msgdb - (wl-summary-save-status 'keep) + (progn + (wl-summary-save-view 'keep) + (elmo-folder-commit wl-summary-buffer-elmo-folder)) (if ret-val (wl-folder-check-entity entity)))))))))) @@ -649,14 +697,14 @@ Refile to archive folder followed message date." wl-folder-entity)) (message "Archiving %s is done" entity-name)))) -(defun wl-archive-number1 (folder archive-list msgdb) - (wl-expire-archive-number1 folder archive-list msgdb t t)) +(defun wl-archive-number1 (folder archive-list msgdb &optional dst-folder-arg) + (wl-expire-archive-number1 folder archive-list msgdb t dst-folder-arg t)) -(defun wl-archive-number2 (folder archive-list msgdb) - (wl-expire-archive-number2 folder archive-list msgdb t t)) +(defun wl-archive-number2 (folder archive-list msgdb &optional dst-folder-arg) + (wl-expire-archive-number2 folder archive-list msgdb t dst-folder-arg t)) -(defun wl-archive-date (folder archive-list msgdb) - (wl-expire-archive-date folder archive-list msgdb t t)) +(defun wl-archive-date (folder archive-list msgdb &optional dst-folder-arg) + (wl-expire-archive-date folder archive-list msgdb t dst-folder-arg t)) (defun wl-archive-folder (folder archive-list msgdb dst-folder) (let* ((elmo-archive-treat-file t) ;; treat archive folder as a file. @@ -672,44 +720,44 @@ Refile to archive folder followed message date." (wl-expire-refile folder archive-list msgdb dst-folder t t t)) ;; copy!! (wl-append copied-list ret-val))) - copied-list - )) + copied-list)) -(defun wl-summary-archive (&optional arg folder-name notsummary nolist) +(defun wl-summary-archive (&optional arg folder notsummary nolist) + "" (interactive "P") - (let* ((folder (or folder-name wl-summary-buffer-folder-name)) - (msgdb (or wl-summary-buffer-msgdb + (let* ((folder (or folder wl-summary-buffer-elmo-folder)) + (msgdb (or (wl-summary-buffer-msgdb) (elmo-msgdb-load folder))) (msgs (if (not nolist) - (elmo-list-folder folder) + (elmo-folder-list-messages folder) (mapcar 'car (elmo-msgdb-get-number-alist msgdb)))) (alist wl-archive-alist) - func dst-folder archive-list) + archives func args dst-folder archive-list) (if arg (let ((wl-default-spec (char-to-string - (car (rassq 'archive elmo-spec-alist))))) + (car (rassq 'archive elmo-folder-type-alist))))) (setq dst-folder (wl-summary-read-folder (concat wl-default-spec (substring folder 1)) "for archive")))) (run-hooks 'wl-summary-archive-pre-hook) (if dst-folder (wl-archive-folder folder msgs msgdb dst-folder) - (when (and (catch 'match - (while alist - (when (string-match (caar alist) folder) - (setq func (cadar alist)) - (throw 'match t)) - (setq alist (cdr alist))) - (and (interactive-p) - (message "No match %s in wl-archive-alist" folder)) - (throw 'match nil)) + (when (and (or (setq archives (wl-archive-folder-p + (elmo-folder-name-internal folder))) + (progn (and (interactive-p) + (message "No match %s in wl-archive-alist" + (elmo-folder-name-internal folder))) + nil)) (or (not (interactive-p)) - (y-or-n-p (format "Archive %s? " folder)))) + (y-or-n-p (format "Archive %s? " + (elmo-folder-name-internal folder))))) + (setq func (car archives) + args (cdr archives)) (setq archive-list - (funcall func folder msgs msgdb)) + (apply func (append (list folder msgs msgdb) args))) (run-hooks 'wl-summary-archive-hook) (if archive-list - (message "Archiving %s is done" folder) + (message "Archiving %s is done" (elmo-folder-name-internal folder)) (and (interactive-p) (message "No archive"))))))) @@ -721,7 +769,7 @@ Refile to archive folder followed message date." (wl-folder-archive-entity (car flist)) (setq flist (cdr flist))))) ((stringp entity) - (wl-summary-archive nil entity t)))) + (wl-summary-archive nil (wl-folder-get-elmo-folder entity) t)))) ;; append log diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index 0fb0b9e..f63811e 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -751,54 +751,57 @@ return value is diffs '(-new -unread -all)." (defvar wl-fldmgr-add-completion-hashtb (make-vector 7 0)) -(defun wl-fldmgr-add-completion-all-completions (string) - (let ((table - (catch 'found - (mapatoms - (function - (lambda (atom) - (if (string-match (symbol-name atom) string) - (throw 'found (symbol-value atom))))) - wl-fldmgr-add-completion-hashtb))) - (pattern - (if (string-match "\\.$" - (car (elmo-network-get-spec - string nil nil nil nil))) - (substring string 0 (match-beginning 0)) - (concat string nil)))) - (or table - (setq table (elmo-list-folders pattern)) - (and table - (or (/= (length table) 1) - (elmo-folder-exists-p (car table)))) - (setq pattern - (if (string-match "\\.[^\\.]+$" string) - (substring string 0 (match-beginning 0)) - (char-to-string (aref string 0))) - table (elmo-list-folders pattern))) - (setq pattern (concat "^" (regexp-quote pattern))) - (unless (intern-soft pattern wl-fldmgr-add-completion-hashtb) - (set (intern pattern wl-fldmgr-add-completion-hashtb) table)) - table)) - -(defun wl-fldmgr-add-completion-subr (string predicate flag) - (let ((table - (if (string= string "") - (mapcar (function (lambda (spec) - (list (char-to-string (car spec))))) - elmo-spec-alist) - (when (assq (aref string 0) elmo-spec-alist) - (delq nil (mapcar - (function list) - (condition-case nil - (wl-fldmgr-add-completion-all-completions string) - (error nil)))))))) - (if (null flag) - (try-completion string table predicate) - (if (eq flag 'lambda) - (eq t (try-completion string table predicate)) - (if flag - (all-completions string table predicate)))))) +;(defun wl-fldmgr-add-completion-all-completions (string) +; (let ((table +; (catch 'found +; (mapatoms +; (function +; (lambda (atom) +; (if (string-match (symbol-name atom) string) +; (throw 'found (symbol-value atom))))) +; wl-fldmgr-add-completion-hashtb))) +; (pattern +; (if (string-match "\\.$" +; (car (elmo-network-get-spec +; string nil nil nil nil))) +; (substring string 0 (match-beginning 0)) +; (concat string nil)))) +; (or table +; (setq table (elmo-folder-list-subfolders (wl-folder-get-elmo-folder +; pattern))) +; (and table +; (or (/= (length table) 1) +; (elmo-folder-exists-p (wl-folder-get-elmo-folder +; (car table))))) +; (setq pattern +; (if (string-match "\\.[^\\.]+$" string) +; (substring string 0 (match-beginning 0)) +; (char-to-string (aref string 0))) +; table (elmo-folder-list-subfolders +; (wl-folder-get-elmo-folder pattern)))) +; (setq pattern (concat "^" (regexp-quote pattern))) +; (unless (intern-soft pattern wl-fldmgr-add-completion-hashtb) +; (set (intern pattern wl-fldmgr-add-completion-hashtb) table)) +; table)) + +;(defun wl-fldmgr-add-completion-subr (string predicate flag) +; (let ((table +; (if (string= string "") +; (mapcar (function (lambda (spec) +; (list (char-to-string (car spec))))) +; elmo-spec-alist) +; (when (assq (aref string 0) elmo-spec-alist) +; (delq nil (mapcar +; (function list) +; (condition-case nil +; (wl-fldmgr-add-completion-all-completions string) +; (error nil)))))))) +; (if (null flag) +; (try-completion string table predicate) +; (if (eq flag 'lambda) +; (eq t (try-completion string table predicate)) +; (if flag +; (all-completions string table predicate)))))) (defun wl-fldmgr-add (&optional name) (interactive) @@ -806,7 +809,7 @@ return value is diffs '(-new -unread -all)." (beginning-of-line) (let ((ret-val nil) (inhibit-read-only t) - (wl-folder-completion-func + (wl-folder-completion-function (if wl-fldmgr-add-complete-with-current-folder-list (function wl-fldmgr-add-completion-subr))) tmp indent path diffs) @@ -819,8 +822,7 @@ return value is diffs '(-new -unread -all)." (setq name (wl-fldmgr-read-string (wl-summary-read-folder wl-default-folder "to add")))) ;; maybe add elmo-plugged-alist. - (when (stringp name) - (elmo-folder-set-plugged name wl-plugged t)) + (elmo-folder-set-plugged (wl-folder-get-elmo-folder name) wl-plugged t) (when (setq diffs (wl-add-entity path (list name) wl-folder-entity (nth 3 tmp) t)) @@ -840,14 +842,15 @@ return value is diffs '(-new -unread -all)." (let* ((inhibit-read-only t) (tmp (wl-fldmgr-get-path-from-buffer)) (entity (elmo-string (nth 4 tmp))) - (msgs (and (elmo-folder-exists-p entity) - (elmo-list-folder entity)))) + (folder (wl-folder-get-elmo-folder entity)) + (msgs (and (elmo-folder-exists-p folder) + (elmo-folder-list-messages folder)))) (when (yes-or-no-p (format "%sDo you really delete \"%s\"? " (if (> (length msgs) 0) (format "%d msg(s) exists. " (length msgs)) "") entity)) - (elmo-delete-folder entity) + (elmo-folder-delete folder) (wl-fldmgr-cut tmp nil t))))) (defun wl-fldmgr-rename () @@ -901,9 +904,11 @@ return value is diffs '(-new -unread -all)." (wl-fldmgr-read-string (wl-summary-read-folder old-folder "to rename" t t old-folder))) (if (or (wl-folder-entity-exists-p new-folder) - (file-exists-p (elmo-msgdb-expand-path new-folder))) + (file-exists-p (elmo-folder-msgdb-path + (wl-folder-get-elmo-folder new-folder)))) (error "Already exists folder: %s" new-folder)) - (elmo-rename-folder old-folder new-folder) + (elmo-folder-rename (wl-folder-get-elmo-folder old-folder) + (wl-folder-get-elmo-folder new-folder)) (wl-folder-set-entity-info new-folder (wl-folder-get-entity-info old-folder)) @@ -970,9 +975,10 @@ return value is diffs '(-new -unread -all)." (message "Can't make multi included group folder") (throw 'done nil)) (t - (let ((spec (elmo-folder-get-spec (car cut-entity))) + (let ((folder (wl-folder-get-elmo-folder + (car cut-entity))) multi-fld) - (if (eq (car spec) 'multi) + (if (eq (elmo-folder-type-internal folder) 'multi) (setq multi-fld (substring (car cut-entity) 1))) (setq new-entity @@ -1017,7 +1023,7 @@ return value is diffs '(-new -unread -all)." (wl-folder-get-realname (wl-match-buffer 3)) wl-folder-entity)) (message "Sorting...") - (setq flist (sort (nth 2 entity) wl-fldmgr-sort-func)) + (setq flist (sort (nth 2 entity) wl-fldmgr-sort-function)) (setcar (cddr entity) flist) (wl-fldmgr-add-modified-access-list (car entity)) (setq wl-fldmgr-modified t) diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 2f562d6..c4223fa 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -33,7 +33,7 @@ (require 'elmo-vars) (require 'elmo-util) -(require 'elmo2) +(require 'elmo) (require 'wl-vars) (condition-case () (require 'easymenu) ; needed here. @@ -44,12 +44,7 @@ (require 'wl-util) (provide 'wl-folder) (require 'wl) - (require 'elmo-nntp) - (if wl-use-semi - (require 'mmelmo)) - (unless (boundp ':file) - (set (make-local-variable ':file) nil)) - (defun-maybe mmelmo-cleanup-entity-buffers ())) + (require 'elmo-nntp)) (defvar wl-folder-buffer-name "Folder") (defvar wl-folder-entity nil) ; desktop entity. @@ -57,9 +52,11 @@ (defvar wl-folder-entity-id nil) ; id (defvar wl-folder-entity-hashtb nil) (defvar wl-folder-entity-id-name-hashtb nil) +(defvar wl-folder-elmo-folder-hashtb nil) ; name => elmo folder structure + (defvar wl-folder-newsgroups-hashtb nil) (defvar wl-folder-info-alist-modified nil) -(defvar wl-folder-completion-func nil) +(defvar wl-folder-completion-function nil) (defvar wl-folder-mode-map nil) @@ -85,7 +82,7 @@ ["Next Folder" wl-folder-next-entity t] ["Check Current Folder" wl-folder-check-current-entity t] ["Sync Current Folder" wl-folder-sync-current-entity t] - ["Drop Current Folder" wl-folder-drop-unsync-current-entity t] +; ["Drop Current Folder" wl-folder-drop-unsync-current-entity t] ["Prefetch Current Folder" wl-folder-prefetch-current-entity t] ["Mark as Read all Current Folder" wl-folder-mark-as-read-all-current-entity t] ["Expire Current Folder" wl-folder-expire-current-entity t] @@ -155,7 +152,7 @@ (define-key wl-folder-mode-map "rs" 'wl-folder-check-region) (define-key wl-folder-mode-map "s" 'wl-folder-check-current-entity) (define-key wl-folder-mode-map "I" 'wl-folder-prefetch-current-entity) - (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity) +; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity) (define-key wl-folder-mode-map "p" 'wl-folder-prev-entity) (define-key wl-folder-mode-map "n" 'wl-folder-next-entity) (define-key wl-folder-mode-map "v" 'wl-folder-toggle-disp-summary) @@ -293,7 +290,9 @@ hashtb)))) (defun wl-folder-persistent-p (folder) - (or (elmo-get-hash-val folder wl-folder-entity-hashtb) ; on Folder mode. + (or (and (wl-folder-search-entity-by-name folder wl-folder-entity + 'folder) + t) ; on Folder mode. (catch 'found (let ((li wl-save-folder-list)) (while li @@ -307,6 +306,27 @@ (throw 'found t)) (setq li (cdr li)))))))) +;;; ELMO folder structure with cache. +(defmacro wl-folder-get-elmo-folder (entity) + "Get elmo folder structure from entity." + (` (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)))) + +(defmacro wl-folder-elmo-folder-cache-get (name &optional hashtb) + "Returns a elmo folder structure associated with NAME from HASHTB. +Default HASHTB is `wl-folder-elmo-folder-hashtb'." + (` (elmo-get-hash-val (, name) + (or (, hashtb) wl-folder-elmo-folder-hashtb)))) + +(defmacro wl-folder-elmo-folder-cache-put (name folder &optional hashtb) + "Get folder elmo folder structure on HASHTB for folder with NAME. +Default HASHTB is `wl-folder-elmo-folder-hashtb'." + (` (elmo-set-hash-val (, name) (, folder) + (or (, hashtb) wl-folder-elmo-folder-hashtb)))) + (defun wl-folder-prev-entity () (interactive) (forward-line -1)) @@ -447,7 +467,8 @@ emptied) (if elmo-enable-disconnected-operation (elmo-dop-queue-flush 'force)) ; Try flushing all queue. - (if (not (elmo-list-folder wl-queue-folder)) + (if (not (elmo-folder-list-messages + (wl-folder-get-elmo-folder wl-queue-folder))) (message "No sending queue exists.") (if wl-stay-folder-window (wl-folder-select-buffer @@ -479,7 +500,7 @@ (setq wl-thread-entities nil wl-thread-entity-list nil) (if wl-summary-cache-use (wl-summary-save-view-cache)) - (wl-summary-msgdb-save)) + (elmo-folder-commit wl-summary-buffer-elmo-folder)) (if (get-buffer-window cur-buf) (select-window (get-buffer-window cur-buf))) (set-buffer cur-buf) @@ -519,28 +540,29 @@ Optional argument ARG is repeart count." (goto-char (point-max)))) (defsubst wl-folder-update-group (entity diffs &optional is-group) - (let ((path (wl-folder-get-path - wl-folder-entity - (wl-folder-get-entity-id entity) - entity))) - (if (not is-group) - ;; delete itself from path - (setq path (delete (nth (- (length path) 1) path) path))) - (goto-char (point-min)) - (catch 'done - (while path - ;; goto the path line. - (if (or (eq (car path) 0) ; update desktop - (wl-folder-buffer-search-group - (wl-folder-get-petname - (if (stringp (car path)) - (car path) - (wl-folder-get-folder-name-by-id - (car path)))))) - ;; update it. - (wl-folder-update-diff-line diffs) - (throw 'done t)) - (setq path (cdr path)))))) + (save-excursion + (let ((path (wl-folder-get-path + wl-folder-entity + (wl-folder-get-entity-id entity) + entity))) + (if (not is-group) + ;; delete itself from path + (setq path (delete (nth (- (length path) 1) path) path))) + (goto-char (point-min)) + (catch 'done + (while path + ;; goto the path line. + (if (or (eq (car path) 0) ; update desktop + (wl-folder-buffer-search-group + (wl-folder-get-petname + (if (stringp (car path)) + (car path) + (wl-folder-get-folder-name-by-id + (car path)))))) + ;; update it. + (wl-folder-update-diff-line diffs) + (throw 'done t)) + (setq path (cdr path))))))) (defun wl-folder-maybe-load-folder-list (entity) (when (null (caddr entity)) @@ -582,33 +604,33 @@ Optional argument ARG is repeart count." (setq beg (point)) (if arg (wl-folder-update-recursive-current-entity entity) - ;; insert as opened - (setcdr (assoc (car entity) wl-folder-group-alist) t) - (if (eq 'access (cadr entity)) - (wl-folder-maybe-load-folder-list entity)) - (condition-case errobj - (progn - (if (or (wl-folder-force-fetch-p (car entity)) - (and - (eq 'access (cadr entity)) - (null (caddr entity)))) - (wl-folder-update-newest indent entity) - (wl-folder-insert-entity indent entity)) - (wl-highlight-folder-path wl-folder-buffer-cur-path)) - (quit - (setq err t) - (setcdr (assoc fname wl-folder-group-alist) nil)) - (error - (elmo-display-error errobj t) - (ding) - (setq err t) - (setcdr (assoc fname wl-folder-group-alist) nil))) - (if (not err) - (let ((buffer-read-only nil)) - (delete-region (save-excursion (beginning-of-line) - (point)) - (save-excursion (end-of-line) - (+ 1 (point)))))))) + ;; insert as opened + (setcdr (assoc (car entity) wl-folder-group-alist) t) + (if (eq 'access (cadr entity)) + (wl-folder-maybe-load-folder-list entity)) + ;(condition-case errobj + (progn + (if (or (wl-folder-force-fetch-p (car entity)) + (and + (eq 'access (cadr entity)) + (null (caddr entity)))) + (wl-folder-update-newest indent entity) + (wl-folder-insert-entity indent entity)) + (wl-highlight-folder-path wl-folder-buffer-cur-path)) + ; (quit + ; (setq err t) + ; (setcdr (assoc fname wl-folder-group-alist) nil)) + ; (error + ; (elmo-display-error errobj t) + ; (ding) + ; (setq err t) + ; (setcdr (assoc fname wl-folder-group-alist) nil))) + (if (not err) + (let ((buffer-read-only nil)) + (delete-region (save-excursion (beginning-of-line) + (point)) + (save-excursion (end-of-line) + (+ 1 (point)))))))) (setq beg (point)) (end-of-line) (save-match-data @@ -646,7 +668,8 @@ Optional argument ARG is repeart count." (get-buffer-window summary-buf)) (delete-window))) (wl-summary-goto-folder-subr fld-name - (wl-summary-get-sync-range fld-name) + (wl-summary-get-sync-range + (wl-folder-get-elmo-folder fld-name)) nil arg t))))) (set-buffer-modified-p nil)) @@ -768,10 +791,10 @@ Optional argument ARG is repeart count." ;(wl-folder-buffer-search-entity (car entity)) ;(wl-folder-update-line ret-val) )) - ((and (stringp entity) - (elmo-folder-plugged-p entity)) + ((stringp entity) (message "Checking \"%s\"" entity) - (setq ret-val (wl-folder-check-one-entity entity)) + (setq ret-val (wl-folder-check-one-entity + entity)) (goto-char start-pos) (sit-for 0)) (t @@ -782,38 +805,18 @@ Optional argument ARG is repeart count." (run-hooks 'wl-folder-check-entity-hook) ret-val)) -;; All contained folders are imap4 and persistent flag, then -;; use server diff. -(defun wl-folder-use-server-diff-p (folder) - (let ((spec (elmo-folder-get-spec folder))) - (cond - ((eq (car spec) 'multi) - (let ((folders (cdr spec))) - (catch 'done - (while folders - (if (wl-folder-use-server-diff-p (car folders)) - (throw 'done t)) - (setq folders (cdr folders))) - nil))) - ((eq (car spec) 'filter) - (wl-folder-use-server-diff-p (nth 2 spec))) - ((eq (car spec) 'imap4) - (and wl-folder-use-server-diff - (elmo-imap4-use-flag-p spec))) - (t nil)))) - (defun wl-folder-check-one-entity (entity) - (let* ((elmo-use-server-diff (wl-folder-use-server-diff-p entity)) + (let* ((folder (wl-folder-get-elmo-folder entity)) (nums (condition-case err (if (wl-string-match-member entity wl-strict-diff-folders) - (elmo-strict-folder-diff entity) - (elmo-folder-diff entity)) + (elmo-strict-folder-diff folder) + (elmo-folder-diff folder)) (error ;; maybe not exist folder. (if (and (not (memq 'elmo-open-error (get (car err) 'error-conditions))) - (not (elmo-folder-exists-p entity))) - (wl-folder-create-subr entity) + (not (elmo-folder-exists-p folder))) + (wl-folder-create-subr folder) (signal (car err) (cdr err)))))) unread unsync nomif) (if (and (eq wl-folder-notify-deleted 'sync) @@ -821,24 +824,23 @@ Optional argument ARG is repeart count." (or (> 0 (car nums)) (> 0 (cdr nums)))) (progn (wl-folder-sync-entity entity) - (setq nums (elmo-folder-diff entity))) + (setq nums (elmo-folder-diff folder))) (unless wl-folder-notify-deleted (setq unsync (if (and (car nums) (> 0 (car nums))) 0 (car nums))) (setq nomif (if (and (car nums) (> 0 (cdr nums))) 0 (cdr nums))) (setq nums (cons unsync nomif))) + (setq unread (or ;; If server diff, All unreads are + ; treated as unsync. + (if (elmo-folder-use-flag-p folder) + 0) + (elmo-folder-get-info-unread folder) + (wl-summary-count-unread (elmo-msgdb-mark-load + (elmo-folder-msgdb-path + folder))))) + (setq unread (min unread (- (or (cdr nums) 0) (or (car nums) 0)))) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity (list (car nums) - (setq - unread - (or - ;; If server diff, All unreads are - ;; treated as unsync. - (if elmo-use-server-diff 0) - (elmo-folder-get-info-unread entity) - (wl-summary-count-unread - (elmo-msgdb-mark-load - (elmo-msgdb-expand-path entity)) - entity))) + unread (cdr nums)) (get-buffer wl-folder-buffer-name))) (setq wl-folder-info-alist-modified t) @@ -855,50 +857,61 @@ Optional argument ARG is repeart count." (wl-folder-get-entity-list entity)) (wl-folder-get-entity-list entity))) (nntp-connection-keys nil) - folder spec-list local-elist net-elist server + name folder folder-list + sync-folder-list + async-folder-list + server ret-val) (while elist - (if (not (elmo-folder-plugged-p (car elist))) + (setq folder (wl-folder-get-elmo-folder (car elist))) + (if (not (elmo-folder-plugged-p folder)) (message "Uncheck \"%s\"" (car elist)) - (setq spec-list - (elmo-folder-get-primitive-spec-list (elmo-string (car elist)))) - (cond ((assq 'nntp spec-list) - (wl-append net-elist (list (car elist))) - (while spec-list - (when (eq (caar spec-list) 'nntp) - (when (not (string= server (elmo-nntp-spec-hostname (car spec-list)))) - (setq server (elmo-nntp-spec-hostname (car spec-list))) + (setq folder-list + (elmo-folder-get-primitive-list folder)) + (cond ((elmo-folder-contains-type folder 'nntp) + (wl-append async-folder-list (list folder)) + (while folder-list + (when (eq (elmo-folder-type-internal (car folder-list)) + 'nntp) + (when (not (string= + server + (elmo-net-folder-server-internal + (car folder-list)))) + (setq server (elmo-net-folder-server-internal + (car folder-list))) (message "Checking on \"%s\"" server)) (setq nntp-connection-keys (elmo-nntp-get-folders-info-prepare - (car spec-list) + (car folder-list) nntp-connection-keys))) - (setq spec-list (cdr spec-list)))) + (setq folder-list (cdr folder-list)))) (t - (wl-append local-elist (list (car elist)))))) + (wl-append sync-folder-list (list folder))))) (setq elist (cdr elist))) ;; check local entity at first - (while (setq folder (pop local-elist)) + (while (setq folder (pop sync-folder-list)) (if (not (elmo-folder-plugged-p folder)) - (message "Uncheck \"%s\"" folder) - (message "Checking \"%s\"" folder) + (message "Uncheck \"%s\"" (elmo-folder-name-internal folder)) + (message "Checking \"%s\"" (elmo-folder-name-internal folder)) (setq ret-val (wl-folder-add-folder-info ret-val - (wl-folder-check-one-entity folder))) + (wl-folder-check-one-entity (elmo-folder-name-internal + folder)))) ;;(sit-for 0) )) ;; check network entity at last - (when net-elist + (when async-folder-list (elmo-nntp-get-folders-info nntp-connection-keys) - (while (setq folder (pop net-elist)) + (while (setq folder (pop async-folder-list)) (if (not (elmo-folder-plugged-p folder)) - (message "Uncheck \"%s\"" folder) - (message "Checking \"%s\"" folder) + (message "Uncheck \"%s\"" (elmo-folder-name-internal folder)) + (message "Checking \"%s\"" (elmo-folder-name-internal folder)) (setq ret-val (wl-folder-add-folder-info ret-val - (wl-folder-check-one-entity folder))) + (wl-folder-check-one-entity (elmo-folder-name-internal + folder)))) ;;(sit-for 0) ))) ret-val)) @@ -971,12 +984,13 @@ If current line is group folder, check all sub entries." (wl-folder-sync-entity (car flist) unread-only) (setq flist (cdr flist))))) ((stringp entity) - (let ((nums (wl-folder-get-entity-info entity)) - (wl-summary-highlight (if (or (wl-summary-sticky-p entity) - (wl-summary-always-sticky-folder-p - entity)) - wl-summary-highlight)) - wl-auto-select-first new unread) + (let* ((folder (wl-folder-get-elmo-folder entity)) + (nums (wl-folder-get-entity-info entity)) + (wl-summary-highlight (if (or (wl-summary-sticky-p folder) + (wl-summary-always-sticky-folder-p + folder)) + wl-summary-highlight)) + wl-auto-select-first new unread) (setq new (or (car nums) 0)) (setq unread (or (cadr nums) 0)) (if (or (not unread-only) @@ -984,12 +998,12 @@ If current line is group folder, check all sub entries." (let ((wl-summary-buffer-name (concat wl-summary-buffer-name (symbol-name this-command))) - (wl-message-buf-name (concat wl-message-buf-name - (symbol-name this-command)))) + (wl-summary-always-sticky-folder-list nil)) (save-window-excursion (save-excursion (wl-summary-goto-folder-subr entity - (wl-summary-get-sync-range entity) + (wl-summary-get-sync-range + folder) nil nil nil t) (wl-summary-exit))))))))) @@ -1019,25 +1033,25 @@ If current line is group folder, check all subfolders." (wl-folder-mark-as-read-all-entity (car flist)) (setq flist (cdr flist))))) ((stringp entity) - (let ((nums (wl-folder-get-entity-info entity)) - (wl-summary-highlight (if (or (wl-summary-sticky-p entity) - (wl-summary-always-sticky-folder-p - entity)) - wl-summary-highlight)) - wl-auto-select-first new unread) + (let* ((nums (wl-folder-get-entity-info entity)) + (folder (wl-folder-get-elmo-folder entity)) + (wl-summary-highlight (if (or (wl-summary-sticky-p folder) + (wl-summary-always-sticky-folder-p + folder)) + wl-summary-highlight)) + wl-auto-select-first new unread) (setq new (or (car nums) 0)) (setq unread (or (cadr nums) 0)) (if (or (< 0 new) (< 0 unread)) - (let ((wl-summary-buffer-name (concat - wl-summary-buffer-name - (symbol-name this-command))) - (wl-message-buf-name (concat wl-message-buf-name - (symbol-name this-command)))) - (save-window-excursion - (save-excursion + (save-window-excursion + (save-excursion + (let ((wl-summary-buffer-name (concat + wl-summary-buffer-name + (symbol-name this-command))) + (wl-summary-always-sticky-folder-list nil)) (wl-summary-goto-folder-subr entity - (wl-summary-get-sync-range entity) - nil) + (wl-summary-get-sync-range folder) + nil) (wl-summary-mark-as-read-all) (wl-summary-exit)))) (sit-for 0)))))) @@ -1075,7 +1089,8 @@ If current line is group folder, all subfolders are marked." (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n") (save-excursion (setq entity (wl-folder-get-entity-from-buffer)) - (if (not (elmo-folder-plugged-p entity)) + (if (not (elmo-folder-plugged-p (wl-folder-get-elmo-folder + entity))) (message "Uncheck %s" entity) (message "Checking %s" entity) (wl-folder-check-one-entity entity) @@ -1308,7 +1323,8 @@ If current line is group folder, all subfolders are marked." (and (interactive-p) (wl-folder-buffer-group-p))) (error "This command is not available on Group")) (beginning-of-line) - (let (wl-auto-select-first) + (let (wl-auto-select-first + (wl-stay-folder-window t)) (cond ((eq arg 'on) (setq wl-folder-buffer-disp-summary t)) @@ -1451,10 +1467,10 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (switch-to-buffer-other-frame (get-buffer-create wl-folder-buffer-name)) (switch-to-buffer (get-buffer-create wl-folder-buffer-name))) - (switch-to-buffer (get-buffer wl-folder-buffer-name)) + (set-buffer wl-folder-buffer-name) (wl-folder-mode) + (sit-for 0) (wl-folder-init) - (set-buffer wl-folder-buffer-name) (let ((inhibit-read-only t) (buffer-read-only nil)) (erase-buffer) @@ -1462,7 +1478,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (save-excursion (wl-folder-insert-entity " " wl-folder-entity))) (set-buffer-modified-p nil) - ;(sit-for 0) (setq initialize t)) initialize)) @@ -1494,11 +1509,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (if (setq buf (get-buffer wl-folder-buffer-name)) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb name value buf)) -;;; (elmo-folder-set-info-hashtb (elmo-string name) -;;; nil -;;; (nth 2 value) -;;; (nth 0 value) -;;; (nth 1 value)) (setq wl-folder-info-alist-modified t)))) (defun wl-folder-calc-finfo (entity) @@ -1547,11 +1557,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (if as-opened (let (update-flist flist-unsub new-flist removed group-name-end) (when (and (eq (cadr entity) 'access) - (elmo-folder-plugged-p (car entity))) + (elmo-folder-plugged-p + (wl-folder-get-elmo-folder (car entity)))) (message "Fetching folder entries...") (when (setq new-flist - (elmo-list-folders - (elmo-string (car entity)) + (elmo-folder-list-subfolders + (wl-folder-get-elmo-folder (car entity)) (wl-string-member (car entity) wl-folder-hierarchy-access-folders))) @@ -1741,19 +1752,19 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (equal diffs '(0 0 0))) (wl-folder-set-entity-info name value entity-hashtb) (save-match-data - (save-excursion - (set-buffer buffer) - (setq entity-list (wl-folder-search-entity-list-by-name - name wl-folder-entity)) - (while entity-list - (wl-folder-update-group (car entity-list) diffs) - (setq entity-list (cdr entity-list))) - (goto-char (point-min)) - (while (wl-folder-buffer-search-entity name) - (wl-folder-update-line value))))))) - + (with-current-buffer buffer + (save-excursion + (setq entity-list (wl-folder-search-entity-list-by-name + name wl-folder-entity)) + (while entity-list + (wl-folder-update-group (car entity-list) diffs) + (setq entity-list (cdr entity-list))) + (goto-char (point-min)) + (while (wl-folder-buffer-search-entity name) + (wl-folder-update-line value)))))))) + (defun wl-folder-update-unread (folder unread) - (save-window-excursion +; (save-window-excursion (let ((buf (get-buffer wl-folder-buffer-name)) cur-unread (unread-diff 0) @@ -1764,7 +1775,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0)) (setq unread-diff (- (or unread 0) cur-unread)) (setq value (wl-folder-get-entity-info folder)) - (setq newvalue (list (nth 0 value) unread (nth 2 value))) @@ -1773,8 +1783,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (when (and buf (not (eq unread-diff 0))) (save-match-data - (save-excursion - (set-buffer buf) + (with-current-buffer buf (save-excursion (setq entity-list (wl-folder-search-entity-list-by-name folder wl-folder-entity)) @@ -1785,7 +1794,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (setq entity-list (cdr entity-list))) (goto-char (point-min)) (while (wl-folder-buffer-search-entity folder) - (wl-folder-update-line newvalue))))))))) + (wl-folder-update-line newvalue))))))));) (defun wl-folder-create-entity-hashtb (entity &optional hashtb reconst) (let ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id))) @@ -1835,22 +1844,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." ;; (setq entities (wl-pop entity-stack)))) ;; hashtb)) -(defun wl-folder-create-newsgroups-from-nntp-access2 (entity) - (let ((flist (nth 2 entity)) - folders) - (and - (setq folders - (delq - nil - (mapcar - '(lambda (fld) - (if (consp fld) - (wl-folder-create-newsgroups-from-nntp-access2 fld) - (nth 1 (elmo-folder-get-spec fld)))) - flist))) - (elmo-nntp-make-groups-hashtb folders 1024)) - nil)) - (defun wl-folder-create-newsgroups-from-nntp-access (entity) (let ((flist (nth 2 entity)) folders) @@ -1860,38 +1853,45 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." ((consp (car flist)) (wl-folder-create-newsgroups-from-nntp-access (car flist))) (t - (list (nth 1 (elmo-folder-get-spec (car flist))))))) + (list + (elmo-nntp-folder-group-internal + (wl-folder-get-elmo-folder (car flist))))))) (setq flist (cdr flist))) folders)) (defun wl-folder-create-newsgroups-hashtb (entity &optional is-list info) + "Create NNTP group hashtable for ENTITY." (let ((entities (if is-list entity (list entity))) - entity-stack spec-list folders fld make-hashtb) + entity-stack folder-list newsgroups newsgroup make-hashtb) (and info (message "Creating newsgroups...")) (while entities (setq entity (wl-pop entities)) (cond ((consp entity) (if (eq (nth 1 entity) 'access) - (when (eq (elmo-folder-get-type (car entity)) 'nntp) - (wl-append folders + (when (eq (elmo-folder-type-internal + (elmo-make-folder (car entity))) 'nntp) + (wl-append newsgroups (wl-folder-create-newsgroups-from-nntp-access entity)) (setq make-hashtb t)) (and entities (wl-push entities entity-stack)) (setq entities (nth 2 entity)))) ((stringp entity) - (setq spec-list (elmo-folder-get-primitive-spec-list entity)) - (while spec-list - (when (and (eq (caar spec-list) 'nntp) - (setq fld (nth 1 (car spec-list)))) - (wl-append folders (list (elmo-string fld)))) - (setq spec-list (cdr spec-list))))) + (setq folder-list (elmo-folder-get-primitive-list + (elmo-make-folder entity))) + (while folder-list + (when (and (eq (elmo-folder-type-internal (car folder-list)) + 'nntp) + (setq newsgroup (elmo-nntp-folder-group-internal + (car folder-list)))) + (wl-append newsgroups (list (elmo-string newsgroup)))) + (setq folder-list (cdr folder-list))))) (unless entities (setq entities (wl-pop entity-stack)))) (and info (message "Creating newsgroups...done")) - (if (or folders make-hashtb) - (elmo-nntp-make-groups-hashtb folders)))) + (if (or newsgroups make-hashtb) + (elmo-setup-subscribed-newsgroups newsgroups)))) (defun wl-folder-get-path (entity target-id &optional string) (let ((entities (list entity)) @@ -1962,7 +1962,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (add (not wl-reset-plugged-alist))) (while entity-list (elmo-folder-set-plugged - (elmo-string (car entity-list)) wl-plugged add) + (wl-folder-get-elmo-folder (car entity-list)) wl-plugged add) (setq entity-list (cdr entity-list))) ;; smtp posting server (when wl-smtp-posting-server @@ -1970,21 +1970,23 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." wl-smtp-posting-server ; server (or (and (boundp 'smtp-service) smtp-service) "smtp") ; port + wl-smtp-connection-type nil nil "smtp" add)) ;; nntp posting server (when wl-nntp-posting-server (elmo-set-plugged wl-plugged wl-nntp-posting-server - elmo-default-nntp-port + wl-nntp-posting-stream-type + wl-nntp-posting-port nil nil "nntp" add)) (run-hooks 'wl-make-plugged-hook))) -(defvar wl-folder-init-func 'wl-local-folder-init) +(defvar wl-folder-init-function 'wl-local-folder-init) (defun wl-folder-init () - "Call `wl-folder-init-func' function." + "Call `wl-folder-init-function' function." (interactive) - (funcall wl-folder-init-func)) + (funcall wl-folder-init-function)) (defun wl-local-folder-init () "Initialize local folder." @@ -1998,6 +2000,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (wl-folder-entity-assign-id wl-folder-entity) (setq wl-folder-entity-hashtb (wl-folder-create-entity-hashtb entity)) + (setq wl-folder-elmo-folder-hashtb (elmo-make-hash wl-folder-entity-id)) (setq wl-folder-group-alist (wl-folder-create-group-alist entity)) (setq wl-folder-newsgroups-hashtb @@ -2012,12 +2015,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." wl-folder-petname-alist)) petname)) -(defun wl-folder-get-petname (folder) +(defun wl-folder-get-petname (name) (or (cdr (wl-string-assoc - folder + name wl-folder-petname-alist)) - folder)) + name)) (defun wl-folder-get-entity-with-petname () (let ((alist wl-folder-petname-alist) @@ -2030,15 +2033,17 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (defun wl-folder-get-newsgroups (folder) "Return Newsgroups field value string for FOLDER newsgroup. If FOLDER is multi, return comma separated string (cross post)." - (let ((flist (elmo-folder-get-primitive-folder-list folder)) ; multi + (let ((flist (elmo-folder-get-primitive-list + (wl-folder-get-elmo-folder folder))) ; multi newsgroups fld ret) (while (setq fld (car flist)) (if (setq ret - (cond ((eq 'nntp (elmo-folder-get-type fld)) - (nth 1 (elmo-folder-get-spec fld))) - ((eq 'localnews (elmo-folder-get-type fld)) + (cond ((eq 'nntp (elmo-folder-type-internal fld)) + (elmo-nntp-folder-group-internal fld)) + ((eq 'localnews (elmo-folder-type-internal fld)) (elmo-replace-in-string - (nth 1 (elmo-folder-get-spec fld)) "/" "\\.")))) + (elmo-nntp-folder-group-internal fld) + "/" "\\.")))) ;; append newsgroup (setq newsgroups (if (stringp newsgroups) (concat newsgroups "," ret) @@ -2046,15 +2051,29 @@ If FOLDER is multi, return comma separated string (cross post)." (setq flist (cdr flist))) (list nil nil newsgroups))) -(defun wl-folder-guess-mailing-list-by-refile-rule (folder) +(defun wl-folder-guess-mailing-list-by-refile-rule (entity) "Return ML address guess by FOLDER. -Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'. -Don't care multi." - (setq folder (car (elmo-folder-get-primitive-folder-list folder))) - (unless (memq (elmo-folder-get-type folder) +Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'." + (let ((flist + (elmo-folder-get-primitive-list + (wl-folder-get-elmo-folder entity))) + fld ret mlist) + (while (setq fld (car flist)) + (if (setq ret + (wl-folder-guess-mailing-list-by-refile-rule-subr + (elmo-folder-name-internal fld))) + (setq mlist (if (stringp mlist) + (concat mlist ", " ret) + ret))) + (setq flist (cdr flist))) + (if mlist + (list mlist nil nil)))) + +(defun wl-folder-guess-mailing-list-by-refile-rule-subr (entity) + (unless (memq (elmo-folder-type entity) '(localnews nntp)) (let ((rules wl-refile-rule-alist) - mladdress tokey toalist histkey) + tokey toalist) (while rules (if (or (and (stringp (car (car rules))) (string-match "[Tt]o" (car (car rules)))) @@ -2063,37 +2082,43 @@ Don't care multi." 'case-ignore))) (setq toalist (append toalist (cdr (car rules))))) (setq rules (cdr rules))) - (setq tokey (car (rassoc folder toalist))) + (setq tokey (car (rassoc entity toalist))) ;;; (setq histkey (car (rassoc folder wl-refile-alist))) ;; case-ignore search `wl-subscribed-mailing-list' (if (stringp tokey) - (list - (elmo-string-matched-member tokey wl-subscribed-mailing-list t) - nil nil) - nil)))) + (elmo-string-matched-member tokey wl-subscribed-mailing-list t))))) -(defun wl-folder-guess-mailing-list-by-folder-name (folder) +(defun wl-folder-guess-mailing-list-by-folder-name (entity) "Return ML address guess by FOLDER name's last hierarchy. Use `wl-subscribed-mailing-list'." - (setq folder (car (elmo-folder-get-primitive-folder-list folder))) - (when (memq (elmo-folder-get-type folder) + (let ((flist + (elmo-folder-get-primitive-list + (wl-folder-get-elmo-folder entity))) + fld ret mlist) + (while (setq fld (car flist)) + (if (setq ret + (wl-folder-guess-mailing-list-by-folder-name-subr + (elmo-folder-name-internal fld))) + (setq mlist (if (stringp mlist) + (concat mlist ", " ret) + ret))) + (setq flist (cdr flist))) + (if mlist + (list mlist nil nil)))) + +(defun wl-folder-guess-mailing-list-by-folder-name-subr (entity) + (when (memq (elmo-folder-type entity) '(localdir imap4 maildir)) - (let (key mladdress) - (setq folder ; make folder name simple - (if (eq 'imap4 (elmo-folder-get-type folder)) - (elmo-imap4-spec-mailbox (elmo-imap4-get-spec folder)) - (substring folder 1))) - (if (string-match "@" folder) - (setq folder (substring folder 0 (match-beginning 0)))) - (when (string-match "[^\\./]+$" folder) ; last hierarchy + (let (key foldername) + ;; Get foldername and Remove folder type symbol. + (setq foldername (substring entity 1)) + (if (string-match "@" foldername) + (setq foldername (substring foldername 0 (match-beginning 0)))) + (when (string-match "[^\\./]+$" foldername) (setq key (regexp-quote - (concat (substring folder (match-beginning 0)) "@"))) - (setq mladdress - (elmo-string-matched-member - key wl-subscribed-mailing-list 'case-ignore)) - (if (stringp mladdress) - (list mladdress nil nil) - nil))))) + (concat (substring foldername (match-beginning 0)) "@"))) + (elmo-string-matched-member + key wl-subscribed-mailing-list 'case-ignore))))) (defun wl-folder-update-diff-line (diffs) (let ((inhibit-read-only t) @@ -2154,6 +2179,7 @@ Use `wl-subscribed-mailing-list'." ;; update only colors (wl-highlight-folder-group-line nums) (wl-highlight-folder-current-line nums)) + (beginning-of-line) (set-buffer-modified-p nil)))))) (defun wl-folder-goto-folder (&optional arg) @@ -2182,23 +2208,18 @@ Use `wl-subscribed-mailing-list'." (get-buffer-window summary-buf)) (delete-window))) (wl-summary-goto-folder-subr fld-name - (wl-summary-get-sync-range fld-name) + (wl-summary-get-sync-range + (wl-folder-get-elmo-folder fld-name)) nil sticky t))) - + (defun wl-folder-suspend () (interactive) (run-hooks 'wl-folder-suspend-hook) (wl-folder-info-save) - (wl-crosspost-alist-save) - (wl-kill-buffers - (format "^\\(%s\\)$" - (mapconcat 'identity - (list (format "%s\\(:.*\\)?" - (default-value 'wl-message-buf-name)) - wl-original-buf-name) - "\\|"))) - (if (fboundp 'mmelmo-cleanup-entity-buffers) - (mmelmo-cleanup-entity-buffers)) + (elmo-crosspost-message-alist-save) + (elmo-quit) + ;(if (fboundp 'mmelmo-cleanup-entity-buffers) + ;(mmelmo-cleanup-entity-buffers)) (bury-buffer wl-folder-buffer-name) (delete-windows-on wl-folder-buffer-name t)) @@ -2215,14 +2236,16 @@ Use `wl-subscribed-mailing-list'." (wl-push entities entity-stack)) (setq entities (nth 2 entity))) ((stringp entity) - (when (and (setq info (elmo-folder-get-info entity)) + (when (and (setq info (elmo-folder-get-info + (wl-folder-get-elmo-folder entity))) (not (equal info '(nil)))) - (wl-append info-alist (list (list (elmo-string entity) - (list (nth 3 info) ;; max - (nth 2 info) ;; length - (nth 0 info) ;; new - (nth 1 info)) ;; unread - )))))) + (if (listp info) + (wl-append info-alist (list (list (elmo-string entity) + (list (nth 3 info) ;; max + (nth 2 info) ;; length + (nth 0 info) ;; new + (nth 1 info)) ;; unread + ))))))) (unless entities (setq entities (wl-pop entity-stack)))) (elmo-msgdb-finfo-save info-alist) @@ -2627,27 +2650,28 @@ Use `wl-subscribed-mailing-list'." (wl-folder-get-petname (car entity))) (cons sum-done sum-all))) ((stringp entity) - (let ((nums (wl-folder-get-entity-info entity)) - (wl-summary-highlight (if (or (wl-summary-sticky-p entity) - (wl-summary-always-sticky-folder-p - entity)) - wl-summary-highlight)) - wl-summary-exit-next-move - wl-auto-select-first ret-val - count) + (let* ((folder (wl-folder-get-elmo-folder entity)) + (nums (wl-folder-get-entity-info entity)) + (wl-summary-highlight (if (or (wl-summary-sticky-p folder) + (wl-summary-always-sticky-folder-p + folder)) + wl-summary-highlight)) + wl-summary-exit-next-move + wl-auto-select-first ret-val + count) (setq count (or (car nums) 0)) - (setq count (+ count (wl-folder-count-incorporates entity))) + (setq count (+ count (wl-folder-count-incorporates folder))) (if (or (null (car nums)) ; unknown (< 0 count)) - (let ((wl-summary-buffer-name (concat - wl-summary-buffer-name - (symbol-name this-command))) - (wl-message-buf-name (concat wl-message-buf-name - (symbol-name this-command)))) - (save-window-excursion - (save-excursion + (save-window-excursion + (save-excursion + (let ((wl-summary-buffer-name (concat + wl-summary-buffer-name + (symbol-name this-command))) + (wl-summary-always-sticky-folder-list nil)) (wl-summary-goto-folder-subr entity - (wl-summary-get-sync-range entity) + (wl-summary-get-sync-range + folder) nil) (setq ret-val (wl-summary-incorporate)) (wl-summary-exit) @@ -2655,7 +2679,8 @@ Use `wl-subscribed-mailing-list'." (cons 0 0)))))) (defun wl-folder-count-incorporates (folder) - (let ((marks (elmo-msgdb-mark-load (elmo-msgdb-expand-path folder))) + (let ((marks (elmo-msgdb-mark-load + (elmo-folder-msgdb-path folder))) (sum 0)) (while marks (if (member (cadr (car marks)) @@ -2683,52 +2708,50 @@ If current line is group folder, all subfolders are prefetched." (wl-folder-check-entity entity)) (wl-folder-prefetch-entity entity))))) -(defun wl-folder-drop-unsync-entity (entity) - "Drop all unsync messages in the ENTITY." - (cond - ((consp entity) - (let ((flist (nth 2 entity))) - (while flist - (wl-folder-drop-unsync-entity (car flist)) - (setq flist (cdr flist))))) - ((stringp entity) - (let ((nums (wl-folder-get-entity-info entity)) - wl-summary-highlight wl-auto-select-first new) - (setq new (or (car nums) 0)) - (if (< 0 new) - (let ((wl-summary-buffer-name (concat - wl-summary-buffer-name - (symbol-name this-command))) - (wl-message-buf-name (concat wl-message-buf-name - (symbol-name this-command)))) - (save-window-excursion - (save-excursion - (wl-summary-goto-folder-subr entity 'no-sync nil) - (wl-summary-drop-unsync) - (wl-summary-exit))))))))) - -(defun wl-folder-drop-unsync-current-entity (&optional force-check) - "Drop all unsync messages in the folder at position. -If current line is group folder, all subfolders are dropped. -If optional arg exists, don't check any folders." - (interactive "P") - (save-excursion - (let ((entity-name (wl-folder-get-entity-from-buffer)) - (group (wl-folder-buffer-group-p)) - wl-folder-check-entity-hook - summary-buf entity) - (when (and entity-name - (y-or-n-p (format - "Drop all unsync messages in %s?" entity-name))) - (setq entity - (if group - (wl-folder-search-group-entity-by-name entity-name - wl-folder-entity) - entity-name)) - (if (null force-check) - (wl-folder-check-entity entity)) - (wl-folder-drop-unsync-entity entity) - (message "All unsync messages in %s are dropped!" entity-name))))) +;(defun wl-folder-drop-unsync-entity (entity) +; "Drop all unsync messages in the ENTITY." +; (cond +; ((consp entity) +; (let ((flist (nth 2 entity))) +; (while flist +; (wl-folder-drop-unsync-entity (car flist)) +; (setq flist (cdr flist))))) +; ((stringp entity) +; (let ((nums (wl-folder-get-entity-info entity)) +; wl-summary-highlight wl-auto-select-first new) +; (setq new (or (car nums) 0)) +; (if (< 0 new) +; (save-window-excursion +; (save-excursion +; (let ((wl-summary-buffer-name (concat +; wl-summary-buffer-name +; (symbol-name this-command)))) +; (wl-summary-goto-folder-subr entity 'no-sync nil) +; (wl-summary-drop-unsync) +; (wl-summary-exit))))))))) + +;(defun wl-folder-drop-unsync-current-entity (&optional force-check) +; "Drop all unsync messages in the folder at position. +;If current line is group folder, all subfolders are dropped. +;If optional arg exists, don't check any folders." +; (interactive "P") +; (save-excursion +; (let ((entity-name (wl-folder-get-entity-from-buffer)) +; (group (wl-folder-buffer-group-p)) +; wl-folder-check-entity-hook +; summary-buf entity) +; (when (and entity-name +; (y-or-n-p (format +; "Drop all unsync messages in %s?" entity-name))) +; (setq entity +; (if group +; (wl-folder-search-group-entity-by-name entity-name +; wl-folder-entity) +; entity-name)) +; (if (null force-check) +; (wl-folder-check-entity entity)) +; (wl-folder-drop-unsync-entity entity) +; (message "All unsync messages in %s are dropped!" entity-name))))) (defun wl-folder-write-current-folder () "Write message to current folder's newsgroup or mailing-list. @@ -2750,26 +2773,27 @@ Call `wl-summary-write-current-folder' with current folder name." (wl-exit) (kill-buffer bufname)))) -(defun wl-folder-create-subr (entity) - (if (not (elmo-folder-creatable-p entity)) - (error "Folder %s is not found" entity) +(defun wl-folder-create-subr (folder) + (if (not (elmo-folder-creatable-p folder)) + (error "Folder %s is not found" (elmo-folder-name-internal folder)) (if (y-or-n-p (format "Folder %s does not exist, create it?" - entity)) + (elmo-folder-name-internal folder))) (progn (setq wl-folder-entity-hashtb (wl-folder-create-entity-hashtb - entity wl-folder-entity-hashtb)) - (unless (elmo-create-folder entity) + (elmo-folder-name-internal folder) + wl-folder-entity-hashtb)) + (unless (elmo-folder-create folder) (error "Create folder failed"))) - (error "Folder %s is not created" entity)))) + (error "Folder %s is not created" (elmo-folder-name-internal folder))))) (defun wl-folder-confirm-existence (folder &optional force) (if force (unless (elmo-folder-exists-p folder) (wl-folder-create-subr folder)) - (unless (or (wl-folder-entity-exists-p folder) - (file-exists-p (elmo-msgdb-expand-path folder)) + (unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal folder)) + (file-exists-p (elmo-folder-msgdb-path folder)) (elmo-folder-exists-p folder)) (wl-folder-create-subr folder)))) diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index f323e23..041628c 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -994,29 +994,28 @@ Variables used: (let ((s start)) (setq start end end s))) (let (lines too-big gc-message e p hend i percent) (save-excursion - (save-match-data - (unless wl-summary-lazy-highlight - (setq lines (count-lines start end) - too-big (and wl-highlight-max-summary-lines - (> lines wl-highlight-max-summary-lines)))) - (goto-char start) - (setq i 0) - (while (and (not (eobp)) - (< (point) end)) - (wl-highlight-summary-current-line nil nil - (or wl-summary-lazy-highlight - wl-summary-scored)) - (when (and (not wl-summary-lazy-highlight) - (> lines elmo-display-progress-threshold)) - (setq i (+ i 1)) - (setq percent (/ (* i 100) lines)) - (if (or (zerop (% percent 5)) (= i lines)) - (elmo-display-progress - 'wl-highlight-summary "Highlighting..." - percent))) - (forward-line 1)) - (unless wl-summary-lazy-highlight - (message "Highlighting...done")))))) + (unless wl-summary-lazy-highlight + (setq lines (count-lines start end) + too-big (and wl-highlight-max-summary-lines + (> lines wl-highlight-max-summary-lines)))) + (goto-char start) + (setq i 0) + (while (and (not (eobp)) + (< (point) end)) + (wl-highlight-summary-current-line nil nil + (or wl-summary-lazy-highlight + wl-summary-scored)) + (when (and (not wl-summary-lazy-highlight) + (> lines elmo-display-progress-threshold)) + (setq i (+ i 1)) + (setq percent (/ (* i 100) lines)) + (if (or (zerop (% percent 5)) (= i lines)) + (elmo-display-progress + 'wl-highlight-summary "Highlighting..." + percent))) + (forward-line 1)) + (unless wl-summary-lazy-highlight + (message "Highlighting...done"))))) (defun wl-highlight-summary-window (&optional win beg) "Highlight summary window. @@ -1038,8 +1037,8 @@ This function is defined for `window-scroll-functions'" (wl-highlight-message beg end nil) (unless for-draft (wl-highlight-message-add-buttons-to-header beg end) - (when wl-highlight-x-face-func - (funcall wl-highlight-x-face-func beg end))) + (when wl-highlight-x-face-function + (funcall wl-highlight-x-face-function beg end))) (run-hooks 'wl-highlight-headers-hook))) (defun wl-highlight-message-add-buttons-to-header (start end) @@ -1162,9 +1161,10 @@ interpreted as cited text.)" (widen) ;; take off signature (if (and hack-sig (not too-big)) - (setq end (funcall wl-highlight-signature-search-func + (setq end (funcall wl-highlight-signature-search-function (- end wl-max-signature-size) end))) - (if hack-sig + (if (and hack-sig + (not (eq end real-end))) (put-text-property end (point-max) 'face 'wl-highlight-message-signature)) (narrow-to-region start end) diff --git a/wl/wl-message.el b/wl/wl-message.el index 0d36a10..b8f9851 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -31,110 +31,280 @@ (require 'wl-vars) (require 'wl-highlight) +(require 'elmo) +(require 'elmo-mime) ; XXX should modify for tm. (eval-when-compile (if wl-use-semi (progn (require 'wl-mime) - (require 'mime-view) - (require 'mmelmo-imap4)) + (require 'mime-view)) (require 'tm-wl)) (defalias-maybe 'event-window 'ignore) (defalias-maybe 'posn-window 'ignore) (defalias-maybe 'event-start 'ignore) (defalias-maybe 'mime-open-entity 'ignore)) -(defvar wl-original-buf-name "*Message*") -(defvar wl-message-buf-name "Message") +(defconst wl-message-buffer-prefetch-idle-time + (if (featurep 'lisp-float-type) (/ (float 1) (float 5)) 1)) +(defvar wl-message-buffer-prefetch-get-next-function + 'wl-summary-default-get-next-msg) + +(defvar wl-message-buffer-prefetch-folder-type-list t) + +(defvar wl-message-buffer-prefetch-debug t) + +(defvar wl-message-buffer nil) ; message buffer. + (defvar wl-message-buffer-cur-summary-buffer nil) (defvar wl-message-buffer-cur-folder nil) (defvar wl-message-buffer-cur-number nil) - -(defvar wl-original-buffer-cur-folder nil) -(defvar wl-original-buffer-cur-number nil) -(defvar wl-original-buffer-cur-msgdb nil) - -(defvar mmelmo-imap4-skipped-parts) +(defvar wl-message-buffer-cur-flag nil) +(defvar wl-message-buffer-cur-summary-buffer nil) +(defvar wl-message-buffer-original-buffer nil) ; original buffer. (make-variable-buffer-local 'wl-message-buffer-cur-folder) (make-variable-buffer-local 'wl-message-buffer-cur-number) +(make-variable-buffer-local 'wl-message-buffer-cur-flag) +(make-variable-buffer-local 'wl-message-buffer-cur-summary-buffer) +(make-variable-buffer-local 'wl-message-buffer-original-buffer) (defvar wl-fixed-window-configuration nil) +(defvar wl-message-buffer-cache-size 10) ; At least 1. + +;;; Message buffer cache. + +(defvar wl-message-buffer-cache nil + "Message cache. (old ... new) order alist. +With association ((\"folder\" message \"message-id\") . cache-buffer).") + +(defmacro wl-message-buffer-cache-buffer-get (entry) + (` (cdr (, entry)))) + +(defmacro wl-message-buffer-cache-folder-get (entry) + (` (car (car (, entry))))) + +(defmacro wl-message-buffer-cache-message-get (entry) + (` (cdr (car (, entry))))) + +(defmacro wl-message-buffer-cache-entry-make (key buf) + (` (cons (, key) (, buf)))) + +(defmacro wl-message-buffer-cache-hit (key) + "Return value assosiated with key." + (` (wl-message-buffer-cache-buffer-get + (assoc (, key) wl-message-buffer-cache)))) + +(defun wl-message-buffer-cache-sort (entry) + "Move ENTRY to the top of `wl-message-buffer-cache'." + (setq wl-message-buffer-cache + (cons entry (delete entry wl-message-buffer-cache)))) +; (let* ((pointer (cons nil wl-message-buffer-cache)) +; (top pointer)) +; (while (cdr pointer) +; (if (equal (car (cdr pointer)) entry) +; (setcdr pointer (cdr (cdr pointer))) +; (setq pointer (cdr pointer)))) +; (setcdr pointer (list entry)) +; (setq wl-message-buffer-cache (cdr top)))) + +(defconst wl-message-buffer-cache-name " *WL:Message*") +(defconst wl-original-message-buffer-name " *Original*") + +(defun wl-original-message-mode () + "A major mode for original message buffer." + (setq major-mode 'wl-original-message-mode) + (setq buffer-read-only t) + (elmo-set-buffer-multibyte nil) + (setq mode-name "Wanderlust original message")) + +(defun wl-original-message-buffer-get (name) + "Get original message buffer for NAME. +If original message buffer already exists, it is re-used." + (let* ((name (concat wl-original-message-buffer-name name)) + (buffer (get-buffer name))) + (unless (and buffer (buffer-live-p buffer)) + (with-current-buffer (setq buffer (get-buffer-create name)) + (wl-original-message-mode))) + buffer)) + +(defun wl-message-buffer-create () + "Create a new message buffer." + (let* ((buffer (generate-new-buffer wl-message-buffer-cache-name)) + (name (buffer-name buffer))) + (with-current-buffer buffer + (setq wl-message-buffer-original-buffer + (wl-original-message-buffer-get name))) + buffer)) + +(defun wl-message-buffer-cache-add (key) + "Add (KEY . buf) to the top of `wl-message-buffer-cache'. +Return its cache buffer." + (let ((len (length wl-message-buffer-cache)) + (buf nil)) + (if (< len wl-message-buffer-cache-size) + (setq buf (wl-message-buffer-create)) + (setq buf (wl-message-buffer-cache-buffer-get + (nth (1- len) wl-message-buffer-cache))) + (setcdr (nthcdr (- len 2) wl-message-buffer-cache) nil)) + (setq wl-message-buffer-cache + (cons (wl-message-buffer-cache-entry-make key buf) + wl-message-buffer-cache)) + buf)) + +(defun wl-message-buffer-cache-delete (&optional key) + "Delete the most recent cache entry" + (if key + (setq wl-message-buffer-cache + (delq (assoc key wl-message-buffer-cache) + wl-message-buffer-cache)) + (let ((buf (wl-message-buffer-cache-buffer-get + (car wl-message-buffer-cache)))) + (setq wl-message-buffer-cache + (nconc (cdr wl-message-buffer-cache) + (list (wl-message-buffer-cache-entry-make nil buf))))))) + +(defun wl-message-buffer-cache-clean-up () + "A function to flush all decoded messages in cache list." + (interactive) + (if (and (eq major-mode 'wl-summary-mode) + wl-message-buffer + (get-buffer-window wl-message-buffer)) + (delete-window (get-buffer-window wl-message-buffer))) + (wl-kill-buffers (regexp-quote wl-message-buffer-cache-name)) + (setq wl-message-buffer-cache nil)) + +;;; Message buffer handling from summary buffer. + (defun wl-message-buffer-window () - (let* ((mes-buf (concat "^" (default-value 'wl-message-buf-name))) - (start-win (selected-window)) + "Get message buffer window if any." + (let* ((start-win (selected-window)) (cur-win start-win)) (catch 'found (while (progn (setq cur-win (next-window cur-win)) - (if (string-match mes-buf (buffer-name (window-buffer cur-win))) - (throw 'found cur-win)) + (with-current-buffer (window-buffer cur-win) + (if (or (eq major-mode 'wl-message-mode) + (eq major-mode 'mime-view-mode)) + (throw 'found cur-win))) (not (eq cur-win start-win))))))) -(defun wl-select-buffer (buffer) - (let ((gbw (or (get-buffer-window buffer) - (wl-message-buffer-window))) +(defun wl-message-select-buffer (buffer) + "Select BUFFER as a message buffer." + (let ((window (get-buffer-window buffer)) (sum (car wl-message-window-size)) (mes (cdr wl-message-window-size)) whi) - (when (and gbw - (not (eq (save-excursion (set-buffer (window-buffer gbw)) + (when (and window + (not (eq (save-excursion (set-buffer (window-buffer window)) wl-message-buffer-cur-summary-buffer) (current-buffer)))) - (delete-window gbw) + (delete-window window) (run-hooks 'wl-message-window-deleted-hook) - (setq gbw nil)) - (if gbw - (select-window gbw) -;;; (if (or (null mes) -;;; wl-stay-folder-window) -;;; (delete-other-windows)) + (setq window nil)) + (if window + (select-window window) (when wl-fixed-window-configuration (delete-other-windows) (and wl-stay-folder-window (wl-summary-toggle-disp-folder))) - (setq whi (1- (window-height))) - (if mes - (progn - (let ((total (+ sum mes))) - (setq sum (max window-min-height (/ (* whi sum) total))) - (setq mes (max window-min-height (/ (* whi mes) total)))) - (if (< whi (+ sum mes)) - (enlarge-window (- (+ sum mes) whi))))) - (split-window (get-buffer-window (current-buffer)) sum) - (other-window 1)) + ;; There's no buffer window. Search for message window and snatch it. + (if (setq window (wl-message-buffer-window)) + (select-window window) + (setq whi (1- (window-height))) + (if mes + (progn + (let ((total (+ sum mes))) + (setq sum (max window-min-height (/ (* whi sum) total))) + (setq mes (max window-min-height (/ (* whi mes) total)))) + (if (< whi (+ sum mes)) + (enlarge-window (- (+ sum mes) whi))))) + (split-window (get-buffer-window (current-buffer)) sum) + (other-window 1))) (switch-to-buffer buffer))) -;; -;; called by wl-summary-mode buffer -;; -(defvar wl-message-func-called-hook nil) - -(defun wl-message-scroll-down (amount) - (let ((view-message-buffer (get-buffer-create wl-message-buf-name)) - (cur-buf (current-buffer))) - (wl-select-buffer view-message-buffer) - (if (bobp) - () - (scroll-down)) - (select-window (get-buffer-window cur-buf)))) - -(defun wl-message-scroll-up (amount) - (let ((view-message-buffer (get-buffer-create wl-message-buf-name)) - (cur-buf (current-buffer))) - (wl-select-buffer view-message-buffer) - (save-excursion - (save-restriction - (widen) - (forward-page 1) - (if (pos-visible-in-window-p (point)) - (wl-message-narrow-to-page 1)))) ; Go to next page. - (if (eobp) - () - (scroll-up)) - (select-window (get-buffer-window cur-buf)))) - +(defun wl-message-narrow-to-page (&optional arg) + "Narrow to page. +If ARG is specified, narrow to ARGth page." + (interactive "P") + (setq arg (if arg (prefix-numeric-value arg) 0)) + (save-excursion + (condition-case () + (forward-page -1) ; Beginning of current page. + (beginning-of-buffer + (goto-char (point-min)))) + (forward-char 1) ; for compatibility with emacs-19.28 and emacs-19.29 + (widen) + (cond + ((> arg 0) (forward-page arg)) + ((< arg 0) (forward-page (1- arg)))) + (forward-page) + (if wl-break-pages + (narrow-to-region (point) + (progn + (forward-page -1) + (if (and (eolp) (not (bobp))) + (forward-line)) + (point)))))) + +(defun wl-message-prev-page (&optional lines) + "Scroll down current message by LINES. +Returns non-nil if top of message." + (interactive) + (if (buffer-live-p wl-message-buffer) + (let ((cur-buf (current-buffer)) + top) + (wl-message-select-buffer wl-message-buffer) + (move-to-window-line 0) + (if (and wl-break-pages + (bobp) + (not (save-restriction (widen) (bobp)))) + (progn + (wl-message-narrow-to-page -1) + (goto-char (point-max)) + (recenter)) + (if (not (bobp)) + (condition-case nil + (scroll-down lines) + (error)) + (setq top t))) + (select-window (get-buffer-window cur-buf)) + top))) + +(defun wl-message-next-page (&optional lines) + "Scroll up current message by LINES. +Returns non-nil if bottom of message." + (interactive) + (if (buffer-live-p wl-message-buffer) + (let ((cur-buf (current-buffer)) + bottom) + (wl-message-select-buffer wl-message-buffer) + (move-to-window-line -1) + (if (save-excursion + (end-of-line) + (and (pos-visible-in-window-p) + (eobp))) + (if (or (null wl-break-pages) + (save-excursion + (save-restriction + (widen) (forward-line) (eobp)))) + (setq bottom t) + (wl-message-narrow-to-page 1) + (setq bottom nil)) + (condition-case () + (static-if (boundp 'window-pixel-scroll-increment) + ;; XEmacs 21.2.20 and later. + (let (window-pixel-scroll-increment) + (scroll-up lines)) + (scroll-up lines)) + (end-of-buffer + (goto-char (point-max)))) + (setq bottom nil)) + (select-window (get-buffer-window cur-buf)) + bottom))) + + (defun wl-message-follow-current-entity (buffer) "Follow to current message." (wl-draft-reply (wl-message-get-original-buffer) @@ -142,184 +312,27 @@ (let ((mail-reply-buffer buffer)) (wl-draft-yank-from-mail-reply-buffer nil))) -(defun wl-message-original-mode () - (setq major-mode 'wl-message-original-mode) - (setq mode-name "Original") - (setq buffer-read-only t) - (if (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system wl-cs-noconv))) +;; (defun wl-message-mode () + "A major mode for message displaying." (interactive) (setq major-mode 'wl-message-mode) (setq buffer-read-only t) (setq mode-name "Message")) -(defun wl-message-get-buffer-create () - (let ((buf-name wl-message-buf-name)) - (or (get-buffer buf-name) - (save-excursion - (set-buffer (get-buffer-create buf-name)) - (wl-message-mode) - (run-hooks 'wl-message-buffer-created-hook) - (get-buffer buf-name))))) - -(defun wl-message-original-get-buffer-create () - (or (get-buffer wl-original-buf-name) - (save-excursion - (set-buffer (get-buffer-create wl-original-buf-name)) - (wl-message-original-mode) - (get-buffer wl-original-buf-name)))) - (defun wl-message-exit () + "Move to summary buffer." (interactive) (let (summary-buf summary-win) (if (setq summary-buf wl-message-buffer-cur-summary-buffer) (if (setq summary-win (get-buffer-window summary-buf)) (select-window summary-win) (switch-to-buffer summary-buf) - (wl-select-buffer wl-message-buf-name) + (wl-message-select-buffer wl-message-buffer) (select-window (get-buffer-window summary-buf)))) (run-hooks 'wl-message-exit-hook))) -(defvar wl-message-mode-map nil) -(if wl-message-mode-map - () - (setq wl-message-mode-map (make-sparse-keymap)) - (define-key wl-message-mode-map "q" 'wl-message-exit) - (define-key wl-message-mode-map "n" 'wl-message-exit) - (define-key wl-message-mode-map "p" 'wl-message-exit)) - -(defun wl-message-decode (outbuf inbuf flag) - (cond - ((eq flag 'all-header) - (save-excursion - (set-buffer inbuf) - (let ((buffer-read-only nil)) - (decode-mime-charset-region (point-min) - (save-excursion - (goto-char (point-min)) - (re-search-forward "^$" nil t) - (point)) - wl-mime-charset))) - (wl-message-decode-with-all-header outbuf inbuf)) - ((eq flag 'no-mime) - (save-excursion - (set-buffer inbuf) - (let ((buffer-read-only nil)) - (save-excursion - (set-buffer outbuf) - (elmo-set-buffer-multibyte nil)) - (copy-to-buffer outbuf (point-min) (point-max)) - (set-buffer outbuf) - (use-local-map wl-message-mode-map) - (elmo-set-buffer-multibyte default-enable-multibyte-characters) -;;; (decode-mime-charset-region (point-min) (point-max) wl-mime-charset) - ;; we can call decode-coding-region() directly, because multibyte flag is t. - (decode-coding-region (point-min) (point-max) wl-cs-autoconv) - (wl-highlight-message (point-min) - (save-excursion - (goto-char (point-min)) - (re-search-forward "^$" nil t)) nil)))) - (t ; normal - (save-excursion - (set-buffer inbuf) - (let ((buffer-read-only nil)) - (decode-mime-charset-region (point-min) - (save-excursion - (goto-char (point-min)) - (re-search-forward "^$" nil t) - (point)) - wl-mime-charset))) - (wl-message-decode-mode outbuf inbuf)))) - -(defun wl-message-prev-page (&optional lines) - "Scroll down this message. Returns non-nil if top of message." - (interactive) - (let ((cur-buf (current-buffer)) - (view-message-buffer (get-buffer-create wl-message-buf-name)) - ret-val) - (wl-select-buffer view-message-buffer) - (move-to-window-line 0) - (if (and wl-break-pages - (bobp) - (not (save-restriction (widen) (bobp)))) - (progn - (wl-message-narrow-to-page -1) - (goto-char (point-max)) - (recenter -1)) - (if (not (bobp)) - (scroll-down lines) - (setq ret-val t))) - (select-window (get-buffer-window cur-buf)) - ret-val)) - -(static-if (fboundp 'luna-make-entity) - (defsubst wl-message-make-mime-entity (backend number backend folder msgdb) - (luna-make-entity (mm-expand-class-name 'elmo) - :location (get-buffer-create - (concat mmelmo-entity-buffer-name "0")) - :imap (eq backend 'elmo-imap4) - :folder folder - :number number - :msgdb msgdb :size 0)) - (defsubst wl-message-make-mime-entity (backend number backend folder msgdb) - (mime-open-entity backend (list folder number msgdb nil)))) - -(defun wl-message-next-page (&optional lines) - "Scroll up this message. Returns non-nil if bottom of message." - (interactive) - (let ((cur-buf (current-buffer)) - (view-message-buffer (get-buffer-create wl-message-buf-name)) - ret-val) - (wl-select-buffer view-message-buffer) - (move-to-window-line -1) - (if (save-excursion - (end-of-line) - (and (pos-visible-in-window-p) - (eobp))) - (if (or (null wl-break-pages) - (save-excursion - (save-restriction - (widen) (forward-line) (eobp)))) - (setq ret-val t) - (wl-message-narrow-to-page 1) - (setq ret-val nil)) - (condition-case () - (static-if (boundp 'window-pixel-scroll-increment) - ;; XEmacs 21.2.20 and later. - (let (window-pixel-scroll-increment) - (scroll-up lines)) - (scroll-up lines)) - (end-of-buffer - (goto-char (point-max)))) - (setq ret-val nil)) - (select-window (get-buffer-window cur-buf)) - ret-val - )) - -(defun wl-message-narrow-to-page (&optional arg) - (interactive "P") - (setq arg (if arg (prefix-numeric-value arg) 0)) - (save-excursion - (condition-case () - (forward-page -1) ; Beginning of current page. - (beginning-of-buffer - (goto-char (point-min)))) - (forward-char 1) ; for compatibility with emacs-19.28 and emacs-19.29 - (widen) - (cond - ((> arg 0) (forward-page arg)) - ((< arg 0) (forward-page (1- arg)))) - (forward-page) - (if wl-break-pages - (narrow-to-region (point) - (progn - (forward-page -1) - (if (and (eolp) (not (bobp))) - (forward-line)) - (point)))) )) - (defun wl-message-toggle-disp-summary () (interactive) (let ((summary-buf (get-buffer wl-message-buffer-cur-summary-buffer)) @@ -329,238 +342,208 @@ (if (setq summary-win (get-buffer-window summary-buf)) (delete-window summary-win) (switch-to-buffer summary-buf) - (wl-select-buffer wl-message-buf-name)) + (wl-message-select-buffer wl-message-buffer)) (wl-summary-goto-folder-subr wl-message-buffer-cur-folder 'no-sync nil nil t) ; no summary-buf (let ((sum-buf (current-buffer))) - (wl-select-buffer wl-message-buf-name) + (wl-message-select-buffer wl-message-buffer) (setq wl-message-buffer-cur-summary-buffer sum-buf))))) -(defun wl-message-normal-get-original-buffer () - (let ((ret-val (get-buffer wl-original-buf-name))) - (if (not ret-val) - (save-excursion - (set-buffer (setq ret-val - (get-buffer-create wl-original-buf-name))) - (wl-message-original-mode))) - ret-val)) - - -(if wl-use-semi - (defalias 'wl-message-get-original-buffer - 'mmelmo-get-original-buffer) - (defalias 'wl-message-get-original-buffer - 'wl-message-normal-get-original-buffer)) - -(defvar wl-message-redisplay-func 'wl-normal-message-redisplay) -(defvar wl-message-cache-used nil) ;whether cache is used or not. - -(defun wl-message-redisplay (folder number flag msgdb &optional force-reload) - (let ((default-mime-charset wl-mime-charset) - (buffer-read-only nil)) - (setq wl-message-cache-used nil) - (if wl-message-redisplay-func - (funcall wl-message-redisplay-func - folder number flag msgdb force-reload)))) - -;; nil means don't fetch all. -(defun wl-message-decide-backend (folder number message-id size) - (let ((dont-do-that (and - (not (setq wl-message-cache-used - (or - (elmo-buffer-cache-hit - (list folder number message-id)) - (elmo-cache-exists-p message-id - folder number)))) - (integerp size) - (not (elmo-local-file-p folder number)) - wl-fetch-confirm-threshold - (>= size wl-fetch-confirm-threshold) - (not (y-or-n-p - (format "Fetch entire message? (%dbytes)" - size)))))) - (message "") - (cond ((and dont-do-that - (eq (elmo-folder-number-get-type folder number) 'imap4) - (not (and (elmo-use-cache-p folder number) - (elmo-cache-exists-p message-id folder number)))) - 'elmo-imap4) - (t (if (not dont-do-that) 'elmo))))) - -(defmacro wl-message-original-buffer-folder () - wl-original-buffer-cur-folder) - -(defmacro wl-message-original-buffer-number () - wl-original-buffer-cur-number) - -(defun wl-message-set-original-buffer-information (folder number) - (when (or (not (string= folder (or wl-original-buffer-cur-folder ""))) - (not (eq number (or wl-original-buffer-cur-number 0)))) - (setq wl-original-buffer-cur-folder folder) - (setq wl-original-buffer-cur-number number))) - -;; Works on FLIM-1.9.0/SEMI-1.8.2 or later (maybe). -(defun wl-mmelmo-message-redisplay (folder number flag msgdb - &optional force-reload) - (let* ((cur-buf (current-buffer)) - (view-message-buffer (wl-message-get-buffer-create)) - (message-id (cdr (assq number - (elmo-msgdb-get-number-alist msgdb)))) - (size (elmo-msgdb-overview-entity-get-size - (elmo-msgdb-overview-get-entity number msgdb))) - (backend (wl-message-decide-backend folder number message-id size)) - cur-entity ret-val header-end real-fld-num summary-win) - (require 'mmelmo) - (wl-select-buffer view-message-buffer) - (set-buffer view-message-buffer) - (unwind-protect - (progn - (setq wl-message-buffer-cur-summary-buffer cur-buf) - (setq wl-message-buffer-cur-folder folder) - (setq wl-message-buffer-cur-number number) - (setq buffer-read-only nil) - (erase-buffer) - (if backend - (let (mime-display-header-hook ;; bind to nil... - (wl-message-ignored-field-list - (if (eq flag 'all-header) - nil - wl-message-ignored-field-list)) - (mmelmo-force-reload force-reload) - (mmelmo-imap4-threshold wl-fetch-confirm-threshold)) - (setq real-fld-num (elmo-get-real-folder-number - folder number)) - (setq cur-entity - (wl-message-make-mime-entity - backend - (if (eq backend 'elmo-imap4) - (cdr real-fld-num) - number) - backend - (if (eq backend 'elmo-imap4) - (car real-fld-num) - folder) - msgdb)) - (setq mmelmo-imap4-skipped-parts nil) - ;; mime-display-message sets buffer-read-only variable as t. - ;; which makes buffer read-only status confused... - (mime-display-message cur-entity view-message-buffer - nil nil 'mmelmo-original-mode) - (if mmelmo-imap4-skipped-parts - (progn - (message "Skipped fetching of %s." - (mapconcat - (lambda (x) - (format "[%s]" x)) - mmelmo-imap4-skipped-parts ",")))) - (if (and (eq backend 'elmo-imap4) - (null mmelmo-imap4-skipped-parts)) - (message "No required part was skipped.")) - (setq ret-val (not (eq backend 'elmo-imap4)))) - (message "Skipped fetching.") - (setq ret-val nil))) - (setq buffer-read-only nil) - (wl-message-set-original-buffer-information folder number) - (wl-message-overload-functions) - ;; highlight body - (when wl-highlight-body-too - (wl-highlight-body)) - (condition-case () - (wl-message-narrow-to-page) - (error nil));; ignore errors. - (setq mode-line-buffer-identification - (format "Wanderlust: << %s / %s >>" - (if (memq 'modeline wl-use-folder-petname) - (wl-folder-get-petname folder) - folder) number)) - (goto-char (point-min)) - (unwind-protect - (save-excursion - (run-hooks 'wl-message-redisplay-hook)) - ;; go back to summary mode - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (set-buffer cur-buf) - (setq summary-win (get-buffer-window cur-buf)) - (if (window-live-p summary-win) - (select-window summary-win)))) - ret-val - )) - -(defun wl-normal-message-redisplay (folder number flag msgdb - &optional force-reload) - (interactive) - (let* ((cur-buf (current-buffer)) - (original-message-buffer (wl-message-get-original-buffer)) - (view-message-buffer (wl-message-get-buffer-create)) - (message-id (cdr (assq number - (elmo-msgdb-get-number-alist msgdb)))) - (size (elmo-msgdb-overview-entity-get-size - (elmo-msgdb-overview-get-entity number msgdb))) - header-end ret-val summary-win) - (wl-select-buffer view-message-buffer) +(defun wl-message-get-original-buffer () + "Get original buffer for current message buffer." + wl-message-buffer-original-buffer) + +(defun wl-message-redisplay (folder number flag &optional force-reload) + (let* ((default-mime-charset wl-mime-charset) + (buffer-read-only nil) + (summary-buf (current-buffer)) + message-buf + strategy entity + cache-used + header-end real-fld-num summary-win) + (setq buffer-read-only nil) + (setq cache-used (wl-message-buffer-display + folder number flag force-reload)) + (setq wl-message-buffer (car cache-used)) + (setq message-buf wl-message-buffer) + (wl-message-select-buffer wl-message-buffer) + + (set-buffer message-buf) + (setq buffer-read-only nil) + (setq wl-message-buffer-cur-summary-buffer summary-buf) + (setq wl-message-buffer-cur-folder (elmo-folder-name-internal folder)) + (setq wl-message-buffer-cur-number number) + (wl-message-overload-functions) + (setq mode-line-buffer-identification + (format "Wanderlust: << %s / %s >>" + (if (memq 'modeline wl-use-folder-petname) + (wl-folder-get-petname (elmo-folder-name-internal + folder)) + (elmo-folder-name-internal folder)) number)) + ;; highlight body +; (when wl-highlight-body-too +; (wl-highlight-body)) + (condition-case () + (wl-message-narrow-to-page) + (error nil)); ignore errors. + (setq cache-used (cdr cache-used)) + (goto-char (point-min)) (unwind-protect + (save-excursion + (run-hooks 'wl-message-redisplay-hook)) + ;; go back to summary mode + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (set-buffer summary-buf) + (setq summary-win (get-buffer-window summary-buf)) + (if (window-live-p summary-win) + (select-window summary-win))) + cache-used)) + +;; Use message buffer cache. +(defun wl-message-buffer-display (folder number flag + &optional force-reload unread) + (let* ((msg-id (elmo-message-field folder number 'message-id)) + (fname (elmo-folder-name-internal folder)) + (hit (wl-message-buffer-cache-hit (list fname number msg-id))) + (read nil) + cache-used) + (when (and hit (not (buffer-live-p hit))) + (wl-message-buffer-cache-delete (list fname number msg-id)) + (setq hit nil)) + (if hit (progn - (setq wl-message-buffer-cur-summary-buffer cur-buf) - (setq wl-message-buffer-cur-folder folder) - (setq wl-message-buffer-cur-number number) - (setq buffer-read-only nil) - (erase-buffer) - (if (or (eq (elmo-folder-number-get-type folder number) 'localdir) - (not (and (not - (setq wl-message-cache-used - (or - (elmo-buffer-cache-hit - (list folder number message-id)) - (elmo-cache-exists-p message-id - folder number)))) - (integerp size) - wl-fetch-confirm-threshold - (>= size wl-fetch-confirm-threshold) - (not (y-or-n-p - (format "Fetch entire message? (%dbytes)" - size)))))) - (progn - (save-excursion - (set-buffer original-message-buffer) - (let ((buffer-read-only nil)) - (elmo-read-msg-with-buffer-cache - folder number original-message-buffer msgdb force-reload))) - ;; decode MIME message. - (wl-message-decode - view-message-buffer - original-message-buffer flag) - (setq ret-val t)) + ;; move hit to the top. + (wl-message-buffer-cache-sort + (wl-message-buffer-cache-entry-make (list fname number msg-id) hit)) + ;; buffer cache is used. + (setq cache-used t) + (with-current-buffer hit + (unless (eq wl-message-buffer-cur-flag flag) + (setq read t)))) + ;; delete tail and add new to the top. + (setq hit (wl-message-buffer-cache-add (list fname number msg-id))) + (setq read t)) + (if (or force-reload read) + (condition-case err (save-excursion - (set-buffer view-message-buffer) - (insert "\n\n")))) - (setq buffer-read-only nil) - (wl-message-set-original-buffer-information folder number) - (wl-message-overload-functions) - ;; highlight body - (and wl-highlight-body-too (wl-highlight-body)) - (condition-case () - (wl-message-narrow-to-page) - (error nil)) ; ignore errors. - (setq mode-line-buffer-identification - (format "Wanderlust: << %s / %s >>" - (if (memq 'modeline wl-use-folder-petname) - (wl-folder-get-petname folder) - folder) - number)) - (goto-char (point-min)) - (unwind-protect - (run-hooks 'wl-message-redisplay-hook) - ;; go back to summary mode - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (set-buffer cur-buf) - (setq summary-win (get-buffer-window cur-buf)) - (if (window-live-p summary-win) - (select-window summary-win))) - ret-val - ))) + (set-buffer hit) + (setq + cache-used + (wl-message-display-internal folder number flag + force-reload unread)) + (setq wl-message-buffer-cur-flag flag)) + (quit + (wl-message-buffer-cache-delete) + (error "Display message %s/%s is quitted" fname number)) + (error + (wl-message-buffer-cache-delete) + (signal (car err) (cdr err)) + nil))) ;; will not be used + (cons hit cache-used))) + +(defun wl-message-display-internal (folder number flag + &optional force-reload unread) + (let ((elmo-message-ignored-field-list + (if (eq flag 'all-header) + nil + wl-message-ignored-field-list)) + (elmo-message-visible-field-list wl-message-visible-field-list) + (elmo-message-sorted-field-list wl-message-sort-field-list) + (elmo-message-fetch-threshold wl-fetch-confirm-threshold)) + (prog1 + (if (eq flag 'as-is) + (let (wl-highlight-x-face-function) + (elmo-mime-display-as-is folder number + (current-buffer) + (wl-message-get-original-buffer) + 'wl-original-message-mode + force-reload + unread)) + (elmo-mime-message-display folder number + (current-buffer) + (wl-message-get-original-buffer) + 'wl-original-message-mode + force-reload + unread)) + (setq buffer-read-only t)))) + +(defsubst wl-message-buffer-prefetch-p (folder &optional number) + (cond + ((eq wl-message-buffer-prefetch-folder-type-list t) + t) + ((and number wl-message-buffer-prefetch-folder-type-list) + (memq (elmo-folder-type-internal + (elmo-message-folder folder number)) + wl-message-buffer-prefetch-folder-type-list)) + (wl-message-buffer-prefetch-folder-type-list + (let ((list wl-message-buffer-prefetch-folder-type-list) + type) + (catch 'done + (while (setq type (pop list)) + (if (elmo-folder-contains-type folder type) + (throw 'done t)))))) + ((consp wl-message-buffer-prefetch-folder-type-list) + (wl-string-match-member (elmo-folder-name-internal folder) + wl-message-buffer-prefetch-folder-type-list)) + (t wl-message-buffer-prefetch-folder-type-list))) + + +(defvar wl-message-buffer-prefetch-timer nil) + +(defun wl-message-buffer-prefetch-next (folder number &optional + summary charset) + (if (wl-message-buffer-prefetch-p folder) + (with-current-buffer (or summary (get-buffer wl-summary-buffer-name)) + (let* ((next (funcall wl-message-buffer-prefetch-get-next-function + number))) + (when (and next (wl-message-buffer-prefetch-p folder next)) + (if (not (fboundp 'run-with-idle-timer)) + (when (sit-for wl-message-buffer-prefetch-idle-time) + (wl-message-buffer-prefetch folder next summary charset)) + (unless wl-message-buffer-prefetch-timer + (setq wl-message-buffer-prefetch-timer + (run-with-idle-timer + wl-message-buffer-prefetch-idle-time + nil + 'wl-message-buffer-prefetch + folder next summary charset))))))))) + +(defun wl-message-buffer-prefetch (folder number summary charset) + (when (buffer-live-p summary) + (save-excursion + (set-buffer summary) + (when (string= (elmo-folder-name-internal folder) + (wl-summary-buffer-folder-name)) + (let ((message-id (elmo-message-field folder number 'message-id)) + (wl-mime-charset charset) + (default-mime-charset charset) + result time1 time2 sec micro) + (if (not (wl-message-buffer-cache-hit (list folder + number message-id))) + (let* ((size (elmo-message-field folder number 'size))) + (when (or (elmo-message-file-p folder number) + (not + (and (integerp size) + elmo-message-fetch-threshold + (>= size + elmo-message-fetch-threshold)))) + ;;(not (elmo-file-cache-exists-p message-id))))) + (when wl-message-buffer-prefetch-debug + (setq time1 (current-time)) + (message "Prefetching %d..." number)) + (setq result (wl-message-buffer-display folder number + 'mime nil 'unread)) + (when wl-message-buffer-prefetch-debug + (setq time2 (current-time)) + (setq sec (- (nth 1 time2)(nth 1 time1))) + (setq micro (- (nth 2 time2)(nth 2 time1))) + (setq micro (+ micro (* 1000000 sec))) + (message "Prefetching %d...done(%f msec)." + number + (/ micro 1000.0)))))))))) + (setq wl-message-buffer-prefetch-timer nil)) (defvar wl-message-button-map (make-sparse-keymap)) diff --git a/wl/wl-mime.el b/wl/wl-mime.el index 285fee4..aac9672 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -32,7 +32,7 @@ (require 'mime-view) (require 'mime-edit) (require 'mime-play) -(require 'mmelmo) +(require 'elmo) (eval-when-compile (defalias-maybe 'Meadow-version 'ignore)) @@ -54,10 +54,10 @@ By setting following-method as yank-content." (let ((wl-draft-buffer (current-buffer)) (mime-view-following-method-alist - (list (cons 'mmelmo-original-mode + (list (cons 'wl-original-message-mode (function wl-draft-yank-to-draft-buffer)))) (mime-preview-following-method-alist - (list (cons 'mmelmo-original-mode + (list (cons 'wl-original-message-mode (function wl-draft-yank-to-draft-buffer))))) (if (get-buffer (wl-current-message-buffer)) (save-excursion @@ -135,8 +135,12 @@ By setting following-method as yank-content." (defun wl-message-request-partial (folder number) (elmo-set-work-buf - (elmo-read-msg-no-cache folder number (current-buffer)) -;;;(mime-parse-buffer nil 'mime-buffer-entity) + (elmo-message-fetch (wl-folder-get-elmo-folder folder) + number + (elmo-make-fetch-strategy 'entire) + nil + (current-buffer) + 'unread) (mime-parse-buffer nil))) (defalias 'wl-message-read 'mime-preview-scroll-up-entity) @@ -164,36 +168,38 @@ By setting following-method as yank-content." (message (format "Bursting...%s" (setq number (+ 1 number)))) (setq message-entity (car (mime-entity-children (car children)))) - (elmo-append-msg target - (mime-entity-body (car children)) - (mime-entity-fetch-field message-entity - "Message-ID")))) + (with-temp-buffer + (insert (mime-entity-body (car children))) + (elmo-folder-append-buffer + target + (mime-entity-fetch-field message-entity + "Message-ID"))))) (setq children (cdr children))) number)) (defun wl-summary-burst () "" (interactive) - (let ((raw-buf (wl-message-get-original-buffer)) + (let ((raw-buf (wl-summary-get-original-buffer)) + (view-buf wl-message-buffer) children message-entity content-type target) (save-excursion - (setq target wl-summary-buffer-folder-name) + (setq target wl-summary-buffer-elmo-folder) (while (not (elmo-folder-writable-p target)) (setq target (wl-summary-read-folder wl-default-folder "to extract to"))) (wl-summary-set-message-buffer-or-redisplay) - (save-excursion - (set-buffer (get-buffer wl-message-buf-name)) + (with-current-buffer view-buf (setq message-entity (get-text-property (point-min) 'mime-view-entity))) - (set-buffer raw-buf) - (setq children (mime-entity-children message-entity)) + (with-current-buffer raw-buf + (setq children (mime-entity-children message-entity))) (when children (message "Bursting...") (wl-summary-burst-subr children target 0) (message "Bursting...done")) (if (elmo-folder-plugged-p target) - (elmo-commit target))) - (wl-summary-sync-update3))) + (elmo-folder-check target))) + (wl-summary-sync-update))) ;; internal variable. (defvar wl-mime-save-dir nil "Last saved directory.") @@ -220,22 +226,32 @@ By setting following-method as yank-content." (interactive) (let* ((msgdb (save-excursion (set-buffer wl-message-buffer-cur-summary-buffer) - wl-summary-buffer-msgdb)) + (wl-summary-buffer-msgdb))) (mime-display-header-hook 'wl-highlight-headers) (folder wl-message-buffer-cur-folder) (id (or (cdr (assoc "id" situation)) "")) (mother (current-buffer)) + (summary-buf wl-message-buffer-cur-summary-buffer) subject-id overviews (root-dir (expand-file-name (concat "m-prts-" (user-login-name)) temporary-file-directory)) - full-file) + full-file point) (setq root-dir (concat root-dir "/" (replace-as-filename id))) (setq full-file (concat root-dir "/FULL")) (if (or (file-exists-p full-file) (not (y-or-n-p "Merge partials? "))) (with-current-buffer mother - (mime-store-message/partial-piece entity situation)) + (mime-store-message/partial-piece entity situation) + (setq wl-message-buffer-cur-summary-buffer summary-buf) + (make-variable-buffer-local 'mime-preview-over-to-next-method-alist) + (setq mime-preview-over-to-next-method-alist + (cons (cons 'mime-show-message-mode 'wl-message-exit) + mime-preview-over-to-next-method-alist)) + (make-variable-buffer-local 'mime-preview-over-to-previous-method-alist) + (setq mime-preview-over-to-previous-method-alist + (cons (cons 'mime-show-message-mode 'wl-message-exit) + mime-preview-over-to-previous-method-alist))) (setq subject-id (eword-decode-string (decode-mime-charset-string @@ -253,7 +269,8 @@ By setting following-method as yank-content." ;; request message at the cursor in Subject buffer. (wl-message-request-partial folder - (elmo-msgdb-overview-entity-get-number (car overviews)))) + (elmo-msgdb-overview-entity-get-number + (car overviews)))) (situation (mime-entity-situation message)) (the-id (or (cdr (assoc "id" situation)) ""))) (when (string= (downcase the-id) @@ -265,25 +282,18 @@ By setting following-method as yank-content." (setq overviews (cdr overviews))) (message "Not all partials found."))))) -(defun wl-mime-header-presentation-method (entity situation) - (let ((mmelmo-sort-field-list wl-message-sort-field-list)) - (mime-insert-header entity - wl-message-ignored-field-list - wl-message-visible-field-list) - (wl-highlight-headers))) - ;;; Setup methods. (defun wl-mime-setup () (set-alist 'mime-preview-quitting-method-alist - 'mmelmo-original-mode 'wl-message-exit) + 'wl-original-message-mode 'wl-message-exit) (set-alist 'mime-view-over-to-previous-method-alist - 'mmelmo-original-mode 'wl-message-exit) + 'wl-original-message-mode 'wl-message-exit) (set-alist 'mime-view-over-to-next-method-alist - 'mmelmo-original-mode 'wl-message-exit) + 'wl-original-message-mode 'wl-message-exit) (set-alist 'mime-preview-over-to-previous-method-alist - 'mmelmo-original-mode 'wl-message-exit) + 'wl-original-message-mode 'wl-message-exit) (set-alist 'mime-preview-over-to-next-method-alist - 'mmelmo-original-mode 'wl-message-exit) + 'wl-original-message-mode 'wl-message-exit) (add-hook 'wl-summary-redisplay-hook 'wl-message-delete-mime-out-buf) (add-hook 'wl-message-exit-hook 'wl-message-delete-mime-out-buf) @@ -292,17 +302,17 @@ By setting following-method as yank-content." '((type . message) (subtype . partial) (method . wl-mime-combine-message/partial-pieces) (request-partial-message-method . wl-message-request-partial) - (major-mode . mmelmo-original-mode))) + (major-mode . wl-original-message-mode))) (ctree-set-calist-strictly 'mime-acting-condition '((mode . "extract") - (major-mode . mmelmo-original-mode) + (major-mode . wl-original-message-mode) (method . wl-mime-save-content))) (set-alist 'mime-preview-following-method-alist - 'mmelmo-original-mode + 'wl-original-message-mode (function wl-message-follow-current-entity)) (set-alist 'mime-view-following-method-alist - 'mmelmo-original-mode + 'wl-original-message-mode (function wl-message-follow-current-entity)) (set-alist 'mime-edit-message-inserter-alist 'wl-draft-mode (function wl-draft-insert-current-message)) @@ -312,7 +322,7 @@ By setting following-method as yank-content." 'wl-draft-mode (cdr (assq 'mail-mode mime-edit-split-message-sender-alist))) (set-alist 'mime-raw-representation-type-alist - 'mmelmo-original-mode 'binary) + 'wl-original-message-mode 'binary) ;; Sort and highlight header fields. (or wl-message-ignored-field-list (setq wl-message-ignored-field-list @@ -321,10 +331,16 @@ By setting following-method as yank-content." (setq wl-message-visible-field-list mime-view-visible-field-list)) (set-alist 'mime-header-presentation-method-alist - 'mmelmo-original-mode - (function wl-mime-header-presentation-method)) - (add-hook 'mmelmo-entity-content-inserted-hook 'wl-highlight-body)) - + 'wl-original-message-mode + (function elmo-mime-insert-header)) + ;; To avoid overriding wl-draft-mode-map. + (when (boundp 'mime-setup-signature-key-alist) + (unless (assq 'wl-draft-mode mime-setup-signature-key-alist) + (setq mime-setup-signature-key-alist + (cons '(wl-draft-mode . "\C-c\C-w") + mime-setup-signature-key-alist)))) + (add-hook 'elmo-message-text-content-inserted-hook 'wl-highlight-body-all) + (add-hook 'elmo-message-header-inserted-hook 'wl-highlight-headers)) (require 'product) (product-provide (provide 'wl-mime) (require 'wl-version)) diff --git a/wl/wl-mule.el b/wl/wl-mule.el index bf29d38..a00456e 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -175,7 +175,7 @@ Special commands: (defun wl-draft-overload-functions () (wl-mode-line-buffer-identification) - (local-set-key "\C-c\C-s" 'wl-draft-send);; override +;; (local-set-key "\C-c\C-s" 'wl-draft-send);; override (wl-draft-overload-menubar)) ;; for "ja-mule-canna-2.3.mini" on PocketBSD diff --git a/wl/wl-refile.el b/wl/wl-refile.el index 467289f..8155e93 100644 --- a/wl/wl-refile.el +++ b/wl/wl-refile.el @@ -187,7 +187,7 @@ If RULE does not match ENTITY, returns nil." (string-match (car (car pairs)) value) - (setq guess (wl-refile-expand-newtext + (setq guess (wl-expand-newtext (wl-refile-evaluate-rule (cdr (car pairs)) entity) value))) @@ -208,39 +208,6 @@ If RULE does not match ENTITY, returns nil." entity) (elmo-msgdb-overview-entity-get-extra-field entity field)))) -(defun wl-refile-expand-newtext (newtext original) - (let ((len (length newtext)) - (pos 0) - c expanded beg N did-expand) - (while (< pos len) - (setq beg pos) - (while (and (< pos len) - (not (= (aref newtext pos) ?\\))) - (setq pos (1+ pos))) - (unless (= beg pos) - (push (substring newtext beg pos) expanded)) - (when (< pos len) - ;; We hit a \; expand it. - (setq did-expand t - pos (1+ pos) - c (aref newtext pos)) - (if (not (or (= c ?\&) - (and (>= c ?1) - (<= c ?9)))) - ;; \ followed by some character we don't expand. - (push (char-to-string c) expanded) - ;; \& or \N - (if (= c ?\&) - (setq N 0) - (setq N (- c ?0))) - (when (match-beginning N) - (push (substring original (match-beginning N) (match-end N)) - expanded)))) - (setq pos (1+ pos))) - (if did-expand - (apply (function concat) (nreverse expanded)) - newtext))) - (defun wl-refile-guess-by-rule (entity) (let ((rules wl-refile-rule-alist) guess) diff --git a/wl/wl-score.el b/wl/wl-score.el index fe8bb3a..50e29bc 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -101,7 +101,7 @@ (defvar wl-score-header-buffer-list nil) (defvar wl-score-alike-hashtb nil) -(defvar wl-score-edit-exit-func nil +(defvar wl-score-edit-exit-function nil "Function run on exit from the score buffer.") (make-variable-buffer-local 'wl-current-score-file) @@ -353,7 +353,7 @@ Set `wl-score-cache' nil." (defun wl-score-get-score-alist (&optional folder) (interactive) - (let* ((fld (or folder wl-summary-buffer-folder-name)) + (let* ((fld (or folder (wl-summary-buffer-folder-name))) (score-alist (reverse (wl-score-get-score-files wl-score-folder-alist fld))) alist scores) @@ -374,12 +374,13 @@ Set `wl-score-cache' nil." (let ((mark (car (wl-score-get 'mark alist))) (expunge (car (wl-score-get 'expunge alist))) (mark-and-expunge (car (wl-score-get 'mark-and-expunge alist))) + (temp (car (wl-score-get 'temp alist))) ; obsolate (target (car (wl-score-get 'target alist))) (important (car (wl-score-get 'important alist)))) (setq wl-summary-important-above (or important wl-summary-important-above)) (setq wl-summary-target-above - (or target wl-summary-target-above)) + (or target temp wl-summary-target-above)) (setq wl-summary-mark-below (or mark mark-and-expunge wl-summary-mark-below)) (setq wl-summary-expunge-below @@ -394,9 +395,9 @@ Set `wl-score-cache' nil." (expire (and wl-score-expiry-days (- now wl-score-expiry-days))) (overview (elmo-msgdb-get-overview - (or msgdb wl-summary-buffer-msgdb))) + (or msgdb (wl-summary-buffer-msgdb)))) (mark-alist (elmo-msgdb-get-mark-alist - (or msgdb wl-summary-buffer-msgdb))) + (or msgdb (wl-summary-buffer-msgdb)))) (wl-score-stop-add-entry not-add) entries news new num entry ov header) @@ -925,11 +926,11 @@ Set `wl-score-cache' nil." (expire (and wl-score-expiry-days (- now wl-score-expiry-days))) (roverview (reverse (elmo-msgdb-get-overview - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) msgs) (if (not expire) (mapcar 'car (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) ;; all messages + (wl-summary-buffer-msgdb))) ;; all messages (catch 'break (while roverview (if (< (wl-day-number @@ -945,8 +946,8 @@ Set `wl-score-cache' nil." (let ((num (wl-summary-message-number))) (if num (assoc (cdr (assq num (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) - (elmo-msgdb-get-overview wl-summary-buffer-msgdb))))) + (wl-summary-buffer-msgdb)))) + (elmo-msgdb-get-overview (wl-summary-buffer-msgdb)))))) (defun wl-score-get-header (header &optional extra) (let ((index (nth 2 (assoc header wl-score-header-index))) @@ -995,9 +996,9 @@ Set `wl-score-cache' nil." (setq alist (cdr alist)) (setq i (1+ i)) (set-buffer-modified-p nil))) - (when (and (get-buffer wl-message-buf-name) + (when (and (get-buffer wl-message-buffer) (setq mes-win (get-buffer-window - (get-buffer wl-message-buf-name)))) + (get-buffer wl-message-buffer)))) (select-window mes-win) (unless (eq (next-window) cur-win) (delete-window (next-window)))) @@ -1181,8 +1182,8 @@ Set `wl-score-cache' nil." (wl-score-save) (setq wl-score-cache nil) (setq wl-summary-scored nil) - (setq number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) - (wl-summary-score-headers nil wl-summary-buffer-msgdb + (setq number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) + (wl-summary-score-headers nil (wl-summary-buffer-msgdb) (unless arg (wl-summary-rescore-msgs number-alist))) (setq expunged (wl-summary-score-update-all-lines t)) @@ -1194,14 +1195,13 @@ Set `wl-score-cache' nil." (defun wl-summary-score-headers (&optional folder msgdb force-msgs not-add) "Do scoring if scoring is required." (let ((scores (wl-score-get-score-alist - (or folder wl-summary-buffer-folder-name)))) + (or folder (wl-summary-buffer-folder-name))))) (when scores (wl-score-headers scores msgdb force-msgs not-add)))) (defun wl-summary-score-update-all-lines (&optional update) (let* ((alist wl-summary-scored) (count (length alist)) - (folder wl-summary-buffer-folder-name) (i 0) (update-unread nil) num score dels visible score-mark mark-alist) @@ -1212,7 +1212,7 @@ Set `wl-score-cache' nil." score (cdar alist)) (when wl-score-debug (message "Scored %d with %d" score num) - (wl-push (list (elmo-string wl-summary-buffer-folder-name) num score) + (wl-push (list (elmo-string (wl-summary-buffer-folder-name)) num score) wl-score-trace)) (setq score-mark (wl-summary-get-score-mark num)) (and (setq visible (wl-summary-jump-to-msg num)) @@ -1243,22 +1243,22 @@ Set `wl-score-cache' nil." (/ (* i 100) count)))) (when dels (setq mark-alist - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (let ((marks dels)) (while marks (setq mark-alist (elmo-msgdb-mark-set mark-alist (pop marks) nil)))) - (elmo-mark-as-read wl-summary-buffer-folder-name - dels wl-summary-buffer-msgdb) - (elmo-msgdb-set-mark-alist wl-summary-buffer-msgdb mark-alist) + (elmo-folder-mark-as-read wl-summary-buffer-elmo-folder + dels) + (elmo-msgdb-set-mark-alist (wl-summary-buffer-msgdb) mark-alist) (wl-summary-delete-messages-on-buffer dels)) (when (and update update-unread) (let ((num-db (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) + (wl-summary-buffer-msgdb))) (mark-alist (elmo-msgdb-get-mark-alist - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) ;; Update Folder mode - (wl-folder-set-folder-updated wl-summary-buffer-folder-name + (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) (list 0 (wl-summary-count-unread mark-alist) @@ -1293,16 +1293,15 @@ Set `wl-score-cache' nil." (find-file-noselect file))) (sum-buf (current-buffer))) (if (string-match (concat "^" wl-summary-buffer-name) (buffer-name)) - (let ((cur-buf (current-buffer)) - (view-message-buffer (get-buffer wl-message-buf-name))) - (when view-message-buffer - (wl-select-buffer view-message-buffer) + (let ((cur-buf (current-buffer))) + (when wl-message-buffer + (wl-message-select-buffer wl-message-buffer) (delete-window) (select-window (get-buffer-window cur-buf))) - (wl-select-buffer edit-buffer)) + (wl-message-select-buffer edit-buffer)) (switch-to-buffer edit-buffer)) (wl-score-mode) - (setq wl-score-edit-exit-func 'wl-score-edit-done) + (setq wl-score-edit-exit-function 'wl-score-edit-done) (setq wl-score-edit-summary-buffer sum-buf) (make-local-variable 'wl-prev-winconf) (setq wl-prev-winconf winconf)) @@ -1355,7 +1354,7 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (setq major-mode 'wl-score-mode) (setq mode-name "Score") (lisp-mode-variables nil) - (make-local-variable 'wl-score-edit-exit-func) + (make-local-variable 'wl-score-edit-exit-function) (make-local-variable 'wl-score-edit-summary-buffer) (run-hooks 'emacs-lisp-mode-hook 'wl-score-mode-hook)) @@ -1387,8 +1386,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (wl-as-mime-charset wl-score-mode-mime-charset (save-buffer))) (let ((buf (current-buffer))) - (when wl-score-edit-exit-func - (funcall wl-score-edit-exit-func)) + (when wl-score-edit-exit-function + (funcall wl-score-edit-exit-function)) (kill-buffer buf))) (defun wl-score-edit-kill () @@ -1396,8 +1395,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (interactive) (let ((buf (current-buffer))) (set-buffer-modified-p nil) - (when wl-score-edit-exit-func - (funcall wl-score-edit-exit-func)) + (when wl-score-edit-exit-function + (funcall wl-score-edit-exit-function)) (kill-buffer buf))) (defun wl-score-edit-get-summary-buf () diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 20ceab1..ae60505 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -35,7 +35,7 @@ ;;; Code: ;; -(require 'elmo2) +(require 'elmo) (require 'elmo-multi) (require 'wl-message) (require 'wl-vars) @@ -65,8 +65,16 @@ (defvar wl-summary-mode-map nil) (defvar wl-current-summary-buffer nil) -(defvar wl-summary-buffer-msgdb nil) -(defvar wl-summary-buffer-folder-name nil) +(defvar wl-summary-buffer-elmo-folder nil) + +(defmacro wl-summary-buffer-folder-name () + (` (and wl-summary-buffer-elmo-folder + (elmo-folder-name-internal wl-summary-buffer-elmo-folder)))) + +(defmacro wl-summary-buffer-msgdb () + (` (and wl-summary-buffer-elmo-folder + (elmo-folder-msgdb wl-summary-buffer-elmo-folder)))) + (defvar wl-summary-buffer-folder-indicator nil) (defvar wl-summary-buffer-disp-msg nil) (defvar wl-summary-buffer-disp-folder nil) @@ -80,7 +88,6 @@ (defvar wl-summary-buffer-mime-charset nil) (defvar wl-summary-buffer-weekday-name-lang nil) (defvar wl-summary-buffer-thread-indent-set-alist nil) -(defvar wl-summary-buffer-message-redisplay-func nil) (defvar wl-summary-buffer-view 'thread) (defvar wl-summary-buffer-message-modified nil) (defvar wl-summary-buffer-mark-modified nil) @@ -94,10 +101,12 @@ (defvar wl-summary-buffer-prev-refile-destination nil) (defvar wl-summary-buffer-prev-copy-destination nil) (defvar wl-summary-buffer-saved-message nil) -(defvar wl-summary-buffer-prev-folder-func nil) -(defvar wl-summary-buffer-next-folder-func nil) -(defvar wl-summary-buffer-exit-func nil) +(defvar wl-summary-buffer-prev-folder-function nil) +(defvar wl-summary-buffer-next-folder-function nil) +(defvar wl-summary-buffer-exit-function nil) (defvar wl-summary-buffer-number-list nil) +(defvar wl-summary-buffer-msgdb nil) +(defvar wl-summary-buffer-folder-name nil) (defvar wl-thread-indent-level-internal nil) (defvar wl-thread-have-younger-brother-str-internal nil) @@ -112,24 +121,25 @@ (defvar wl-summary-alike-hashtb nil) (defvar wl-summary-search-buf-name " *wl-search-subject*") (defvar wl-summary-delayed-update nil) +(defvar wl-summary-search-buf-folder-name nil) -(defvar wl-summary-get-petname-func 'wl-address-get-petname-1) +(defvar wl-summary-get-petname-function 'wl-address-get-petname-1) -(defvar wl-summary-message-regexp "^ *\\([0-9]+\\)") +(defvar wl-summary-message-regexp "^ *\\(-?[0-9]+\\)") (defvar wl-summary-shell-command-last "") (defvar wl-ps-preprint-hook nil) (defvar wl-ps-print-hook nil) -(make-variable-buffer-local 'wl-summary-buffer-msgdb) +(make-variable-buffer-local 'wl-summary-buffer-elmo-folder) +(make-variable-buffer-local 'wl-summary-search-buf-folder-name) (make-variable-buffer-local 'wl-summary-buffer-disp-msg) (make-variable-buffer-local 'wl-summary-buffer-disp-folder) (make-variable-buffer-local 'wl-summary-buffer-refile-list) (make-variable-buffer-local 'wl-summary-buffer-copy-list) (make-variable-buffer-local 'wl-summary-buffer-target-mark-list) (make-variable-buffer-local 'wl-summary-buffer-delete-list) -(make-variable-buffer-local 'wl-summary-buffer-folder-name) (make-variable-buffer-local 'wl-summary-buffer-folder-indicator) (make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg) (make-variable-buffer-local 'wl-summary-buffer-unread-status) @@ -138,7 +148,6 @@ (make-variable-buffer-local 'wl-summary-buffer-mime-charset) (make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang) (make-variable-buffer-local 'wl-summary-buffer-thread-indent-set) -(make-variable-buffer-local 'wl-summary-buffer-message-redisplay-func) (make-variable-buffer-local 'wl-summary-buffer-view) (make-variable-buffer-local 'wl-summary-buffer-message-modified) (make-variable-buffer-local 'wl-summary-buffer-mark-modified) @@ -162,10 +171,12 @@ (make-variable-buffer-local 'wl-thread-vertical-str-internal) (make-variable-buffer-local 'wl-thread-horizontal-str-internal) (make-variable-buffer-local 'wl-thread-space-str-internal) -(make-variable-buffer-local 'wl-summary-buffer-prev-folder-func) -(make-variable-buffer-local 'wl-summary-buffer-next-folder-func) -(make-variable-buffer-local 'wl-summary-buffer-exit-func) +(make-variable-buffer-local 'wl-summary-buffer-prev-folder-function) +(make-variable-buffer-local 'wl-summary-buffer-next-folder-function) +(make-variable-buffer-local 'wl-summary-buffer-exit-function) (make-variable-buffer-local 'wl-summary-buffer-number-list) +(make-variable-buffer-local 'wl-summary-buffer-msgdb) +(make-variable-buffer-local 'wl-summary-buffer-folder-name) ;; internal functions (dummy) (unless (fboundp 'wl-summary-append-message-func-internal) @@ -182,8 +193,8 @@ (defun wl-summary-subject-filter-func-internal (subject) subject)) -(defmacro wl-summary-sticky-buffer-name (folder) - (` (concat wl-summary-buffer-name ":" (, folder)))) +(defmacro wl-summary-sticky-buffer-name (name) + (` (concat wl-summary-buffer-name ":" (, name)))) (defun wl-summary-default-subject (subject-string) (if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string) @@ -197,7 +208,7 @@ (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-summary-buffer-folder-name)) (wl-address-user-mail-address-p from) (cond ((and (setq tos (elmo-msgdb-overview-entity-get-to entity)) @@ -210,7 +221,7 @@ (eword-decode-string (if wl-use-petname (or - (funcall wl-summary-get-petname-func to) + (funcall wl-summary-get-petname-function to) (car (std11-extract-address-components to)) to) @@ -221,7 +232,7 @@ entity "newsgroups")) (setq retval (concat "Ng:" ng))))) (if wl-use-petname - (setq retval (or (funcall wl-summary-get-petname-func from) + (setq retval (or (funcall wl-summary-get-petname-function from) (car (std11-extract-address-components from)) from)) (setq retval from))) @@ -229,7 +240,7 @@ (defun wl-summary-simple-from (string) (if wl-use-petname - (or (funcall wl-summary-get-petname-func string) + (or (funcall wl-summary-get-petname-function string) (car (std11-extract-address-components string)) string) string)) @@ -378,7 +389,7 @@ (define-key wl-summary-mode-map "\e\r" 'wl-summary-prev-line-content) (define-key wl-summary-mode-map "g" 'wl-summary-goto-folder) (define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all) - (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync) +; (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync) (define-key wl-summary-mode-map "a" 'wl-summary-reply) (define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation) @@ -546,7 +557,7 @@ (setq mark-alist (cdr mark-alist))) ret-val)) -(defun wl-summary-count-unread (mark-alist &optional folder) +(defun wl-summary-count-unread (mark-alist) (let ((new 0) (unread 0) mark) @@ -571,7 +582,7 @@ If ARG is non-nil, Supersedes message" (interactive "P") (if arg (wl-summary-supersedes-message) - (if (string= wl-summary-buffer-folder-name wl-draft-folder) + (if (string= (wl-summary-buffer-folder-name) wl-draft-folder) (if (wl-summary-message-number) (unwind-protect (wl-draft-reedit (wl-summary-message-number)) @@ -583,8 +594,7 @@ If ARG is non-nil, Supersedes message" (let ((mmelmo-force-fetch-entire-message t)) (if (null (wl-summary-message-number)) (message "No message.") - (wl-summary-set-message-buffer-or-redisplay) - (set-buffer (wl-message-get-original-buffer)) + (set-buffer (wl-summary-get-original-buffer)) (wl-draft-edit-string (buffer-substring (point-min) (point-max))))))))) @@ -634,8 +644,7 @@ you." (message "No address specified.") (message "Resending message to %s..." address) (save-excursion - (let ((mmelmo-force-fetch-entire-message t)) - (wl-summary-set-message-buffer-or-redisplay) + (let ((original (wl-summary-get-original-buffer))) ;; We first set up a normal mail buffer. (set-buffer (get-buffer-create " *wl-draft-resend*")) (buffer-disable-undo (current-buffer)) @@ -655,7 +664,7 @@ you." (delete-region (point) (point-max)) (let ((beg (point))) ;; Insert the message to be resent. - (insert-buffer-substring (wl-message-get-original-buffer)) + (insert-buffer-substring original) (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) @@ -677,54 +686,36 @@ you." (kill-buffer (current-buffer))) (message "Resending message to %s...done" address)))) -(defun wl-summary-msgdb-load-async (folder) - "Loading msgdb and selecting FOLDER is executed asynchronously in IMAP4." - (if (and (elmo-folder-plugged-p folder) - (eq (elmo-folder-get-type folder) 'imap4)) - (let ((spec (elmo-folder-get-spec folder)) - session mailbox - msgdb response tag) - (unwind-protect - (progn - (setq session (elmo-imap4-get-session spec) - mailbox (elmo-imap4-spec-mailbox spec) - tag (elmo-imap4-send-command session - (list "select " - (elmo-imap4-mailbox - mailbox)))) - (setq msgdb (elmo-msgdb-load (elmo-string folder))) - (setq response (elmo-imap4-read-response session tag))) - (if response - (elmo-imap4-session-set-current-mailbox-internal session mailbox) - (and session - (elmo-imap4-session-set-current-mailbox-internal session nil)) - (message "Select mailbox %s failed" mailbox))) - msgdb) - (elmo-msgdb-load (elmo-string folder)))) - (defun wl-summary-buffer-set-folder (folder) - (setq wl-summary-buffer-folder-name folder) + (if (stringp folder) + (setq folder (wl-folder-get-elmo-folder folder))) + (setq wl-summary-buffer-elmo-folder folder) (setq wl-summary-buffer-folder-indicator (if (memq 'modeline wl-use-folder-petname) - (wl-folder-get-petname folder) - folder)) - (when (wl-summary-sticky-p) - (make-local-variable 'wl-message-buf-name) - (setq wl-message-buf-name (format "%s:%s" wl-message-buf-name folder))) + (wl-folder-get-petname (elmo-folder-name-internal folder)) + (elmo-folder-name-internal folder))) + (make-local-variable 'wl-message-buffer) (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value wl-folder-mime-charset-alist - folder) + (elmo-folder-name-internal folder)) wl-mime-charset)) (setq wl-summary-buffer-weekday-name-lang (or (wl-get-assoc-list-value wl-folder-weekday-name-lang-alist - folder) + (elmo-folder-name-internal folder)) wl-summary-weekday-name-lang)) (setq wl-summary-buffer-thread-indent-set (wl-get-assoc-list-value wl-folder-thread-indent-set-alist - folder)) - (setq wl-summary-buffer-persistent (wl-folder-persistent-p folder)) + (elmo-folder-name-internal folder))) + (setq wl-summary-buffer-persistent + (wl-folder-persistent-p (elmo-folder-name-internal folder))) + (elmo-folder-set-persistent-internal folder wl-summary-buffer-persistent) + ;; process duplicates. + (elmo-folder-set-process-duplicates-internal + folder (cdr (elmo-string-matched-assoc + (elmo-folder-name-internal folder) + wl-folder-process-duplicates-alist))) (setq wl-thread-indent-level-internal (or (nth 0 wl-summary-buffer-thread-indent-set) @@ -772,18 +763,13 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." ;;;(make-local-variable 'tab-width) ;;;(setq tab-width 1) (buffer-disable-undo (current-buffer)) - (if wl-use-semi - (setq wl-summary-buffer-message-redisplay-func - 'wl-mmelmo-message-redisplay) - (setq wl-summary-buffer-message-redisplay-func - 'wl-normal-message-redisplay)) (wl-mode-line-buffer-identification '("Wanderlust: " wl-summary-buffer-folder-indicator wl-summary-buffer-unread-status)) (easy-menu-add wl-summary-mode-menu) (when wl-summary-lazy-highlight - (make-local-hook 'window-scroll-functions) - (add-hook 'window-scroll-functions 'wl-highlight-summary-window nil t)) + (make-local-variable 'window-scroll-functions) + (add-hook 'window-scroll-functions 'wl-highlight-summary-window)) ;; This hook may contain the function `wl-setup-summary' for reasons ;; of system internal to accord facilities for the Emacs variants. (run-hooks 'wl-summary-mode-hook)) @@ -836,7 +822,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." "Rescan current folder without updating." (interactive) (let* ((cur-buf (current-buffer)) - (msgdb wl-summary-buffer-msgdb) + (msgdb (wl-summary-buffer-msgdb)) (overview (elmo-msgdb-get-overview msgdb)) (number-alist (elmo-msgdb-get-number-alist msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) @@ -861,7 +847,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (intern (format "wl-summary-overview-entity-compare-by-%s" sort-by)))) (message "Sorting by %s...done" sort-by) - (elmo-msgdb-set-overview wl-summary-buffer-msgdb + (elmo-msgdb-set-overview (wl-summary-buffer-msgdb) overview)) (setq curp overview) (set-buffer cur-buf) @@ -913,7 +899,9 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (setq expunged (wl-summary-score-update-all-lines))) (message "%d message(s) are expunged by scoring." (length expunged)))) (wl-summary-set-message-modified) - (wl-summary-count-unread mark-alist) + (wl-summary-count-unread + (elmo-msgdb-get-mark-alist + (elmo-folder-msgdb wl-summary-buffer-elmo-folder))) (wl-summary-update-modeline) (goto-char (point-max)) (forward-line -1) @@ -963,10 +951,14 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." "folder mode")) (defun wl-summary-set-message-modified () + (elmo-folder-set-message-modified-internal + wl-summary-buffer-elmo-folder t) (setq wl-summary-buffer-message-modified t)) (defun wl-summary-message-modified-p () wl-summary-buffer-message-modified) (defun wl-summary-set-mark-modified () + (elmo-folder-set-mark-modified-internal + wl-summary-buffer-elmo-folder t) (setq wl-summary-buffer-mark-modified t)) (defun wl-summary-mark-modified-p () wl-summary-buffer-mark-modified) @@ -975,41 +967,6 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-thread-modified-p () wl-summary-buffer-thread-modified) -(defun wl-summary-msgdb-save () - "Save msgdb if modified." - (when wl-summary-buffer-msgdb - (save-excursion - (let (path) - (when (wl-summary-message-modified-p) - (setq path (elmo-msgdb-expand-path wl-summary-buffer-folder-name)) - (elmo-msgdb-overview-save - path - (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) - (elmo-msgdb-number-save - path - (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) - (elmo-folder-set-info-max-by-numdb - (elmo-string wl-summary-buffer-folder-name) - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) - (setq wl-summary-buffer-message-modified nil) - (run-hooks 'wl-summary-buffer-message-saved-hook)) - (when (wl-summary-mark-modified-p) - (or path - (setq path (elmo-msgdb-expand-path - wl-summary-buffer-folder-name))) - (elmo-msgdb-mark-save - path - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) -;;; (elmo-folder-set-info-hashtb -;;; (elmo-string wl-summary-buffer-folder-name) -;;; nil nil -;;; 0 -;;; (+ wl-summary-buffer-new-count wl-summary-buffer-unread-count)) -;;; (setq wl-folder-info-alist-modified t) - (setq wl-summary-buffer-mark-modified nil) - (run-hooks 'wl-summary-buffer-mark-saved-hook)))))) - (defsubst wl-summary-cleanup-temp-marks (&optional sticky) (if (or wl-summary-buffer-refile-list wl-summary-buffer-copy-list @@ -1034,7 +991,8 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (setq wl-summary-scored nil)) ;; a subroutine for wl-summary-exit/wl-save-status -(defun wl-summary-save-status (&optional sticky) +;; Note that folder is not commited here. +(defun wl-summary-save-view (&optional sticky) ;; already in summary buffer. (when wl-summary-buffer-persistent ;; save the current summary buffer view. @@ -1042,9 +1000,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (or (wl-summary-message-modified-p) (wl-summary-mark-modified-p) (wl-summary-thread-modified-p))) - (wl-summary-save-view-cache)) - ;; save msgdb ... - (wl-summary-msgdb-save))) + (wl-summary-save-view-cache)))) (defun wl-summary-force-exit () "Exit current summary. Buffer is deleted even the buffer is sticky." @@ -1056,28 +1012,30 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (interactive "P") (let ((summary-buf (current-buffer)) (sticky (wl-summary-sticky-p)) - (message-buf (get-buffer wl-message-buf-name)) summary-win message-buf message-win folder-buf folder-win) - (if wl-summary-buffer-exit-func - (funcall wl-summary-buffer-exit-func) + (run-hooks 'wl-summary-exit-pre-hook) + (if wl-summary-buffer-exit-function + (funcall wl-summary-buffer-exit-function) (wl-summary-cleanup-temp-marks sticky) (unwind-protect ;; save summary status (progn - (wl-summary-save-status sticky) - (elmo-commit wl-summary-buffer-folder-name) - (if wl-use-scoring - (wl-score-save))) + (if (or force-exit + (not sticky)) + (elmo-folder-close wl-summary-buffer-elmo-folder) + (elmo-folder-commit wl-summary-buffer-elmo-folder) + (elmo-folder-check wl-summary-buffer-elmo-folder)) + (wl-summary-save-view sticky) + (if wl-use-scoring (wl-score-save))) ;; for sticky summary (wl-delete-all-overlays) (setq wl-summary-buffer-disp-msg nil) (elmo-kill-buffer wl-summary-search-buf-name) ;; delete message window if displayed. - (if (setq message-buf (get-buffer wl-message-buf-name)) - (if (setq message-win (get-buffer-window message-buf)) - (delete-window message-win))) + (if (and wl-message-buffer (get-buffer-window wl-message-buffer)) + (delete-window (get-buffer-window wl-message-buffer))) (if (and wl-summary-use-frame (> (length (visible-frame-list)) 1)) (delete-frame)) @@ -1114,41 +1072,12 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (not sticky)) (progn (set-buffer summary-buf) - (and (get-buffer wl-message-buf-name) - (kill-buffer wl-message-buf-name)) - ;; kill buffers of mime-view-caesar - (wl-kill-buffers - (format "^%s-([0-9 ]+)$" (regexp-quote wl-message-buf-name))) (kill-buffer summary-buf))) (run-hooks 'wl-summary-exit-hook))))) -(defun wl-summary-sync-force-update (&optional unset-cursor) +(defun wl-summary-sync-force-update (&optional unset-cursor no-check) (interactive) - (let ((msgdb-dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name)) - (type (elmo-folder-get-type wl-summary-buffer-folder-name)) - ret-val seen-list) - (unwind-protect - (progn - (if wl-summary-buffer-persistent - (setq seen-list (elmo-msgdb-seen-load msgdb-dir))) - (setq ret-val (wl-summary-sync-update3 seen-list unset-cursor)) - (if wl-summary-buffer-persistent - (progn - (if (and (eq type 'imap4) - (not (elmo-folder-plugged-p - wl-summary-buffer-folder-name))) - (let* ((msgdb wl-summary-buffer-msgdb) - (number-alist (elmo-msgdb-get-number-alist msgdb))) - (elmo-mark-as-read wl-summary-buffer-folder-name - (mapcar - (lambda (msgid) - (car (rassoc msgid number-alist))) - seen-list) msgdb))) - (elmo-msgdb-seen-save msgdb-dir nil)))) - (set-buffer (current-buffer))) - (if (interactive-p) - (message "%s" ret-val)) - ret-val)) + (wl-summary-sync-update unset-cursor nil no-check)) (defsubst wl-summary-sync-all-init () (wl-summary-cleanup-temp-marks) @@ -1157,8 +1086,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (wl-summary-set-mark-modified) (setq wl-thread-entity-hashtb (elmo-make-hash (* (length (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) 2))) - (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil)) + (wl-summary-buffer-msgdb))) 2))) (setq wl-thread-entity-list nil) (setq wl-thread-entities nil) (setq wl-summary-buffer-number-list nil) @@ -1170,41 +1098,13 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-sync (&optional unset-cursor force-range) (interactive) - (let* ((folder wl-summary-buffer-folder-name) + (let* ((folder wl-summary-buffer-elmo-folder) (inhibit-read-only t) (buffer-read-only nil) - (msgdb-dir (elmo-msgdb-expand-path - folder)) - (range (or force-range (wl-summary-input-range folder))) - mes seen-list killed-list) - (cond ((or (string= range "all") - (string= range "all-visible")) - ;; initialize buffer local databases. - (unless (elmo-folder-plugged-p folder) ; forbidden - (error "Unplugged")) - (setq seen-list - (nconc - (elmo-msgdb-mark-alist-to-seen-list - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb) - (elmo-msgdb-get-mark-alist - wl-summary-buffer-msgdb) - (concat wl-summary-important-mark - wl-summary-read-uncached-mark)) - (elmo-msgdb-seen-load msgdb-dir))) - (setq killed-list (elmo-msgdb-killed-list-load msgdb-dir)) - (elmo-clear-killed wl-summary-buffer-folder-name) - (condition-case nil - (setq mes (wl-summary-sync-update3 seen-list unset-cursor - (string= range "all"))) - (quit - ;; Resume killed-list if quit. - (message "") ; clear minibuffer. - (elmo-msgdb-killed-list-save msgdb-dir killed-list))) - (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen. - (if mes (message "%s" mes))) -;;; (wl-summary-sync-all folder t)) - ((string= range "rescan") + (msgdb-dir (elmo-folder-msgdb-path folder)) + (range (or force-range (wl-summary-input-range + (elmo-folder-name-internal folder))))) + (cond ((string= range "rescan") (let ((msg (wl-summary-message-number))) (wl-summary-rescan) (and msg (wl-summary-jump-to-msg msg)))) @@ -1215,16 +1115,16 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (and msg (wl-summary-jump-to-msg msg)))) ((or (string-match "last:" range) (string-match "first:" range)) - (wl-summary-goto-folder-subr (concat "/" range "/" folder) - 'force-update nil nil t)) - ((string= range "no-sync") - ;; do nothing. - ) + (wl-summary-goto-folder-subr + (wl-folder-get-elmo-folder (concat "/" range "/" + (elmo-folder-name-internal + folder))) + 'force-update nil nil t)) (t - (setq seen-list (elmo-msgdb-seen-load msgdb-dir)) - (setq mes (wl-summary-sync-update3 seen-list unset-cursor)) - (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen. - (if mes (message "%s" mes)))))) + (wl-summary-sync-update unset-cursor + (cond ((string= range "all") 'all) + ((string= range "all-visible") + 'visible-only))))))) (defvar wl-summary-edit-addresses-candidate-fields ;; First element becomes default. @@ -1309,41 +1209,40 @@ Optional argument ADDR-STR is used as a target address if specified." (if (null (wl-summary-message-number)) (message "No message.") (save-excursion - (wl-summary-set-message-buffer-or-redisplay)) - (let* ((charset wl-summary-buffer-mime-charset) - (candidates - (with-current-buffer (wl-message-get-original-buffer) - (wl-summary-edit-addresses-collect-candidate-fields - charset))) - address pair result) - (if addr-str - (setq address addr-str) - (when candidates - (setq address (car (car candidates))) - (setq address - (completing-read - (format "Target address (%s): " address) - (mapcar - (function (lambda (x) (cons (car x) (car x)))) - candidates) - nil nil nil nil address)))) - (when address - (setq pair (assoc address candidates)) - (unless pair - (setq pair (cons address nil))) - (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair))) - ;; update alias - (wl-status-update) - (setq address (assoc (car pair) wl-address-list)) - (if address - (message "%s, %s, <%s> is %s." - (nth 2 address) - (nth 1 address) - (nth 0 address) - result))) + (let* ((charset wl-summary-buffer-mime-charset) + (candidates + (with-current-buffer (wl-summary-get-original-buffer) + (wl-summary-edit-addresses-collect-candidate-fields + charset))) + address pair result) + (if addr-str + (setq address addr-str) + (when candidates + (setq address (car (car candidates))) + (setq address + (completing-read + (format "Target address (%s): " address) + (mapcar + (function (lambda (x) (cons (car x) (car x)))) + candidates) + nil nil nil nil address)))) + (when address + (setq pair (assoc address candidates)) + (unless pair + (setq pair (cons address nil))) + (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair))) + ;; update alias + (wl-status-update) + (setq address (assoc (car pair) wl-address-list)) + (if address + (message "%s, %s, <%s> is %s." + (nth 2 address) + (nth 1 address) + (nth 0 address) + result))) ;;; i'd like to update summary-buffer, but... ;;; (wl-summary-rescan) - (run-hooks 'wl-summary-edit-addresses-hook))))) + (run-hooks 'wl-summary-edit-addresses-hook)))))) (defun wl-summary-incorporate (&optional arg) "Check and prefetch all uncached messages. @@ -1359,12 +1258,11 @@ If ARG is non-nil, checking is omitted." "Returns status-mark. if skipped, returns nil." ;; prefetching procedure. (save-excursion - (let* ((msgdb wl-summary-buffer-msgdb) + (let* ((msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) (number-alist (elmo-msgdb-get-number-alist msgdb)) (message-id (cdr (assq number number-alist))) - (ov (assoc message-id - (elmo-msgdb-get-overview msgdb))) + (ov (elmo-msgdb-overview-get-entity message-id msgdb)) (entity ov) (size (elmo-msgdb-overview-entity-get-size ov)) (inhibit-read-only t) @@ -1374,7 +1272,7 @@ If ARG is non-nil, checking is omitted." (< size wl-prefetch-threshold)))) mark new-mark) (if (or arg - (null (elmo-cache-exists-p message-id))) + (null (elmo-file-cache-exists-p message-id))) (unwind-protect (progn (when (and size (not force-read) wl-prefetch-confirm) @@ -1402,48 +1300,24 @@ If ARG is non-nil, checking is omitted." (if force-read (save-excursion (save-match-data - (if (and (null (elmo-folder-plugged-p - wl-summary-buffer-folder-name)) - elmo-enable-disconnected-operation) - (progn;; append-queue for offline - (elmo-dop-prefetch-msgs - wl-summary-buffer-folder-name (list number)) - (setq new-mark - (cond - ((string= mark - wl-summary-unread-uncached-mark) - wl-summary-unread-cached-mark) - ((string= mark wl-summary-new-mark) - (setq wl-summary-buffer-new-count - (- wl-summary-buffer-new-count 1)) - (setq wl-summary-buffer-unread-count - (+ wl-summary-buffer-unread-count 1)) - wl-summary-unread-cached-mark) - ((or (null mark) - (string= mark wl-summary-read-uncached-mark)) - (setq wl-summary-buffer-unread-count - (+ wl-summary-buffer-unread-count 1)) - wl-summary-unread-cached-mark) - (t mark)))) - ;; online - (elmo-prefetch-msg wl-summary-buffer-folder-name - number - (wl-message-get-original-buffer) - msgdb) - (setq new-mark - (cond - ((string= mark - wl-summary-unread-uncached-mark) - wl-summary-unread-cached-mark) - ((string= mark wl-summary-new-mark) - (setq wl-summary-buffer-new-count - (- wl-summary-buffer-new-count 1)) - (setq wl-summary-buffer-unread-count - (+ wl-summary-buffer-unread-count 1)) - wl-summary-unread-cached-mark) - ((string= mark wl-summary-read-uncached-mark) - nil) - (t mark)))) + ;; online + (elmo-message-encache + wl-summary-buffer-elmo-folder + number) + (setq new-mark + (cond + ((string= mark + wl-summary-unread-uncached-mark) + wl-summary-unread-cached-mark) + ((string= mark wl-summary-new-mark) + (setq wl-summary-buffer-new-count + (- wl-summary-buffer-new-count 1)) + (setq wl-summary-buffer-unread-count + (+ wl-summary-buffer-unread-count 1)) + wl-summary-unread-cached-mark) + ((string= mark wl-summary-read-uncached-mark) + nil) + (t mark))) (setq mark-alist (elmo-msgdb-mark-set mark-alist number new-mark)) (or new-mark (setq new-mark " ")) @@ -1451,7 +1325,7 @@ If ARG is non-nil, checking is omitted." (wl-summary-set-mark-modified) (wl-summary-update-modeline) (wl-folder-update-unread - wl-summary-buffer-folder-name + (wl-summary-buffer-folder-name) (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count))) new-mark)))))))) @@ -1477,15 +1351,15 @@ If ARG is non-nil, checking is omitted." (goto-char (point-min)) (while (not (eobp)) (beginning-of-line) - (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)") + (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)") (setq mark (wl-match-buffer 2)) (setq msg (string-to-int (wl-match-buffer 1))) (if (or (and (null prefetch-marks) msg - (null (elmo-cache-exists-p + (null (elmo-file-cache-exists-p (cdr (assq msg (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)))))) + (wl-summary-buffer-msgdb))))))) (member mark prefetch-marks)) (setq targets (nconc targets (list msg)))) (setq entity (wl-thread-get-entity msg)) @@ -1531,16 +1405,17 @@ If ARG is non-nil, checking is omitted." (save-excursion (save-match-data (beginning-of-line) - (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)") + (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)") (goto-char (match-beginning 2)) (let ((inhibit-read-only t) (buffer-read-only nil) + (beg (match-beginning 2)) + (end (match-end 2)) mark) (setq mark (wl-summary-prefetch-msg (string-to-int (wl-match-buffer 1)) arg)) (when mark - (delete-region (match-beginning 2) - (match-end 2)) + (delete-region beg end) (insert mark) (if wl-summary-highlight (wl-highlight-summary-current-line))) @@ -1640,7 +1515,7 @@ If ARG is non-nil, checking is omitted." (while (not (eobp)) (wl-summary-mark-as-read t) (forward-line 1))))) - (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline)) (defun wl-summary-mark-as-unread-region (beg end) @@ -1673,7 +1548,7 @@ If ARG is non-nil, checking is omitted." (while (not (eobp)) (wl-summary-mark-as-unread) (forward-line 1))))) - (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline)) (defun wl-summary-mark-as-important-region (beg end) @@ -1704,16 +1579,16 @@ If ARG is non-nil, checking is omitted." (while (not (eobp)) (wl-summary-mark-as-important) (forward-line 1))))) - (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline)) (defun wl-summary-mark-as-read-all () (interactive) (if (or (not (interactive-p)) (y-or-n-p "Mark all messages as read? ")) - (let* ((folder wl-summary-buffer-folder-name) + (let* ((folder wl-summary-buffer-elmo-folder) (cur-buf (current-buffer)) - (msgdb wl-summary-buffer-msgdb) + (msgdb (wl-summary-buffer-msgdb)) ;;; (number-alist (elmo-msgdb-get-number-alist msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) (malist mark-alist) @@ -1722,17 +1597,16 @@ If ARG is non-nil, checking is omitted." (case-fold-search nil) msg mark) (message "Setting all msgs as read...") - (elmo-mark-as-read folder (wl-summary-collect-unread mark-alist) - msgdb) + (elmo-folder-mark-as-read folder (wl-summary-collect-unread mark-alist)) (save-excursion (goto-char (point-min)) - (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9 ]\\)" nil t) + (while (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9 ]\\)" nil t) (setq msg (string-to-int (wl-match-buffer 1))) (setq mark (wl-match-buffer 2)) (when (and (not (string= mark wl-summary-important-mark)) (not (string= mark wl-summary-read-uncached-mark))) (delete-region (match-beginning 2) (match-end 2)) - (if (or (not (elmo-use-cache-p folder msg)) + (if (or (not (elmo-message-use-cache-p folder msg)) (string= mark wl-summary-unread-cached-mark)) (progn (insert " ") @@ -1756,7 +1630,7 @@ If ARG is non-nil, checking is omitted." (wl-summary-set-mark-modified) (set-buffer cur-buf); why is this needed??? (elmo-msgdb-set-mark-alist msgdb mark-alist) - (wl-folder-update-unread wl-summary-buffer-folder-name 0) + (wl-folder-update-unread (wl-summary-buffer-folder-name) 0) (setq wl-summary-buffer-unread-count 0) (setq wl-summary-buffer-new-count 0) (wl-summary-update-modeline) @@ -1769,15 +1643,15 @@ If ARG is non-nil, checking is omitted." (save-excursion (let* ((inhibit-read-only t) (buffer-read-only nil) - (folder wl-summary-buffer-folder-name) - (msgdb wl-summary-buffer-msgdb) + (folder wl-summary-buffer-elmo-folder) + (msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) (number-alist (elmo-msgdb-get-number-alist msgdb)) (case-fold-search nil) mark number unread new-mark) ;;; (re-search-backward "^ *[0-9]+..[0-9]+/[0-9]+" nil t) ; set cursor line (beginning-of-line) - (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)") + (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)") (progn (setq mark (wl-match-buffer 2)) (cond @@ -1795,9 +1669,11 @@ If ARG is non-nil, checking is omitted." (delete-region (match-beginning 2) (match-end 2)) (goto-char (match-beginning 2)) (insert new-mark) - (elmo-cache-delete (cdr (assq number number-alist)) - wl-summary-buffer-folder-name - number) + (elmo-file-cache-delete + (elmo-file-cache-get-path + (elmo-message-field wl-summary-buffer-elmo-folder + number + 'message-id))) (setq mark-alist (elmo-msgdb-mark-set mark-alist number new-mark)) (elmo-msgdb-set-mark-alist msgdb mark-alist) @@ -1809,9 +1685,9 @@ If ARG is non-nil, checking is omitted." (defun wl-summary-resume-cache-status () "Resume the cache status of all messages in the current folder." (interactive) - (let* ((folder wl-summary-buffer-folder-name) + (let* ((folder wl-summary-buffer-elmo-folder) (cur-buf (current-buffer)) - (msgdb wl-summary-buffer-msgdb) + (msgdb (wl-summary-buffer-msgdb)) (number-alist (elmo-msgdb-get-number-alist msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) (inhibit-read-only t) @@ -1821,13 +1697,13 @@ If ARG is non-nil, checking is omitted." (message "Resuming cache status...") (save-excursion (goto-char (point-min)) - (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" nil t) + (while (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)" nil t) (setq msg (string-to-int (wl-match-buffer 1))) (setq mark (wl-match-buffer 2)) (setq msgid (cdr (assq msg number-alist))) (setq set-mark nil) - (if (elmo-cache-exists-p msgid folder msg) + (if (elmo-file-cache-exists-p msgid) (if (or (string= mark wl-summary-unread-uncached-mark) ; U -> ! (string= mark wl-summary-new-mark) ; N -> ! @@ -1858,7 +1734,7 @@ If ARG is non-nil, checking is omitted." (set-buffer-modified-p nil)))) (defun wl-summary-resume-marks-and-highlight () - (let* ((msgdb wl-summary-buffer-msgdb) + (let* ((msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) ;;; (number-alist (elmo-msgdb-get-number-alist msgdb)) (count (count-lines (point-min)(point-max))) @@ -1886,7 +1762,7 @@ If ARG is non-nil, checking is omitted." (message "Resuming all marks...done"))) (defun wl-summary-resume-marks () - (let* ((msgdb wl-summary-buffer-msgdb) + (let* ((msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) (number-alist (elmo-msgdb-get-number-alist msgdb)) (count (length mark-alist)) @@ -1958,10 +1834,10 @@ If ARG is non-nil, checking is omitted." (unless deleting-info 'no-msg)) (wl-thread-cleanup-symbols msgs2)) (wl-summary-count-unread - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline) (wl-folder-update-unread - wl-summary-buffer-folder-name + (wl-summary-buffer-folder-name) (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count))))) (defun wl-summary-set-as-read-mark-alist (mark-alist) @@ -1976,11 +1852,11 @@ If ARG is non-nil, checking is omitted." (while mark-alist (setq entity (car mark-alist)) (when (setq pair (assoc (cadr entity) marks)) - (if (elmo-use-cache-p wl-summary-buffer-folder-name - (caar mark-alist)) + (if (elmo-message-use-cache-p wl-summary-buffer-elmo-folder + (caar mark-alist)) (if (cdr pair) (setcar (cdr entity) (cdr pair)) - (setq ret-val (delete entity ret-val))) + (setq ret-val (delete entity ret-val))) (setq ret-val (delete entity ret-val)))) (setq mark-alist (cdr mark-alist))) ret-val)) @@ -2070,29 +1946,26 @@ If ARG is non-nil, checking is omitted." (defun wl-summary-sync-marks () "Update marks in summary." (interactive) - (let ((plugged (elmo-folder-plugged-p wl-summary-buffer-folder-name)) - (last-progress 0) + (let ((last-progress 0) (i 0) - mark-alist unread-marks msgs mark importants unreads - importants-in-db unreads-in-db has-imap4 diff diffs + mark-alist unread-marks importants unreads + importants-in-db unreads-in-db diff diffs mes num-ma progress) ;; synchronize marks. - (when (not (eq (elmo-folder-get-type - wl-summary-buffer-folder-name) + (when (not (eq (elmo-folder-type-internal + wl-summary-buffer-elmo-folder) 'internal)) (message "Updating marks...") (setq unread-marks (list wl-summary-unread-cached-mark wl-summary-unread-uncached-mark wl-summary-new-mark) - mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb) + mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)) num-ma (length mark-alist) - importants (elmo-list-folder-important - wl-summary-buffer-folder-name - (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) - unreads (elmo-list-folder-unread - wl-summary-buffer-folder-name - (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb) - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb) + importants (elmo-folder-list-importants + wl-summary-buffer-elmo-folder + wl-summary-important-mark) + unreads (elmo-folder-list-unreads + wl-summary-buffer-elmo-folder unread-marks)) (while mark-alist (if (string= (cadr (car mark-alist)) @@ -2157,125 +2030,72 @@ If ARG is non-nil, checking is omitted." (nthcdr (max (- len in) 0) appends)) appends))) -(defun wl-summary-sync-update3 (&optional seen-list unset-cursor sync-all) - "Update the summary view." +(defun wl-summary-sync-update (&optional unset-cursor sync-all no-check) + "Update the summary view to the newest folder status." (interactive) - (let* ((folder wl-summary-buffer-folder-name) - (cur-buf (current-buffer)) - (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) -;;; (location (elmo-msgdb-get-location msgdb)) + (let* ((folder wl-summary-buffer-elmo-folder) (case-fold-search nil) (elmo-mime-charset wl-summary-buffer-mime-charset) (inhibit-read-only t) (buffer-read-only nil) - diff initial-append-list append-list delete-list has-nntp - i num result + (elmo-folder-update-threshold wl-summary-update-confirm-threshold) gc-message - in-folder - in-db curp - overview-append - entity ret-val crossed crossed2 - update-thread update-top-list mark - expunged msgs unreads importants) -;;; (setq seen-list nil) ;for debug. + overview number-alist mark-alist + curp num i new-msgdb + append-list delete-list crossed + update-thread update-top-list + expunged mes sync-result) + (unless wl-summary-buffer-elmo-folder + (error "(Internal error) Folder is not set:%s" (buffer-name + (current-buffer)))) (fset 'wl-summary-append-message-func-internal (wl-summary-get-append-message-func)) ;; Flush pending append operations (disconnected operation). - (setq seen-list - (wl-summary-flush-pending-append-operations seen-list)) + ;;(setq seen-list + ;;(wl-summary-flush-pending-append-operations seen-list)) (goto-char (point-max)) (wl-folder-confirm-existence folder 'force) - (message "Checking folder diff...") - (elmo-commit folder) - (setq in-folder (elmo-list-folder folder sync-all)) - (setq in-db (unless sync-all (sort (mapcar 'car number-alist) '<))) - (if (not elmo-use-killed-list) - (setq diff (if (eq (elmo-folder-get-type folder) 'multi) - (elmo-multi-list-bigger-diff in-folder in-db) - (elmo-list-bigger-diff in-folder in-db))) - (setq diff (elmo-list-diff in-folder in-db))) - (setq initial-append-list (car diff)) - (setq delete-list (cadr diff)) - (message "Checking folder diff...done") - ;; Confirm appended message number. - (setq append-list (wl-summary-confirm-appends initial-append-list)) - (when (and elmo-use-killed-list - (not (eq (length initial-append-list) - (length append-list))) - (setq diff (elmo-list-diff initial-append-list append-list))) - (elmo-msgdb-append-to-killed-list folder (car diff))) - ;; Setup sync-all - (if sync-all (wl-summary-sync-all-init)) - ;; Don't delete important-marked msgs other than 'internal. - (unless (eq (elmo-folder-get-type folder) 'internal) - (setq delete-list - (wl-summary-delete-important-msgs-from-list delete-list - mark-alist))) - (if (and has-nntp - (elmo-nntp-max-number-precedes-list-active-p)) - ;; XXX this does not work correctly in rare case. - (setq delete-list - (wl-summary-delete-canceled-msgs-from-list - delete-list - wl-summary-buffer-msgdb))) - (if (or (equal diff '(nil nil)) - (equal diff '(nil)) - (and (eq (length delete-list) 0) - (eq (length initial-append-list) 0))) + (setq sync-result (elmo-folder-synchronize + folder + wl-summary-new-mark + wl-summary-unread-uncached-mark + wl-summary-unread-cached-mark + wl-summary-read-uncached-mark + wl-summary-important-mark + sync-all no-check)) + (setq new-msgdb (nth 0 sync-result)) + (setq delete-list (nth 1 sync-result)) + (setq crossed (nth 2 sync-result)) + (if (or (and sync-all sync-result) + sync-result) (progn - ;; For max-number update... - (if (and (elmo-folder-contains-type folder 'nntp) - (elmo-nntp-max-number-precedes-list-active-p) - (elmo-update-number folder wl-summary-buffer-msgdb)) - (wl-summary-set-message-modified) - (setq ret-val (format "No update is needed for \"%s\"" folder)))) - (when delete-list - (message "Deleting...") - (elmo-msgdb-delete-msgs folder delete-list - wl-summary-buffer-msgdb t) ; reserve cache. -;;; (set-buffer cur-buf) - (wl-summary-delete-messages-on-buffer delete-list "Deleting...") - (message "Deleting...done")) -;;; (set-buffer cur-buf) - ;; Change "New" marks to "Uncached Unread" marks. - (wl-summary-set-status-marks mark-alist - wl-summary-new-mark - wl-summary-unread-uncached-mark) - (wl-summary-set-status-marks-on-buffer - wl-summary-new-mark - wl-summary-unread-uncached-mark) - (setq num (length append-list)) - (if append-list - (progn + ;; Setup sync-all + (if sync-all (wl-summary-sync-all-init)) +; (if (and has-nntp +; (elmo-nntp-max-number-precedes-list-active-p)) + ;; XXX this does not work correctly in rare case. +; (setq delete-list +; (wl-summary-delete-canceled-msgs-from-list +; delete-list +; (wl-summary-buffer-msgdb)))) + (when delete-list + (wl-summary-delete-messages-on-buffer delete-list "Deleting...") + (message "Deleting...done")) + (wl-summary-set-status-marks-on-buffer + wl-summary-new-mark + wl-summary-unread-uncached-mark) + (setq append-list (elmo-msgdb-get-overview new-msgdb)) + (setq curp append-list) + (setq num (length curp)) + (when append-list (setq i 0) - (setq result (elmo-msgdb-create - folder - append-list - wl-summary-new-mark - wl-summary-unread-cached-mark ; ! - wl-summary-read-uncached-mark ; u ;; XXXX - wl-summary-important-mark - seen-list)) - ;; delete duplicated messages. - (when (elmo-folder-contains-multi folder) - (setq crossed (elmo-multi-delete-crossposts - wl-summary-buffer-msgdb result)) - (setq result (cdr crossed)) - (setq crossed (car crossed))) - (setq overview-append (car result)) - (setq wl-summary-buffer-msgdb - (elmo-msgdb-append wl-summary-buffer-msgdb result t)) ;; set these value for append-message-func - (setq overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) + (setq overview (elmo-msgdb-get-overview + (elmo-folder-msgdb folder))) (setq number-alist (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) + (elmo-folder-msgdb folder))) (setq mark-alist (elmo-msgdb-get-mark-alist - wl-summary-buffer-msgdb)) -;;; (setq location (elmo-msgdb-get-location msgdb)) - (setq curp overview-append) - (setq num (length curp)) + (elmo-folder-msgdb folder))) (setq wl-summary-delayed-update nil) (elmo-kill-buffer wl-summary-search-buf-name) (while curp @@ -2287,14 +2107,14 @@ If ARG is non-nil, checking is omitted." (wl-append update-top-list update-thread)) (if elmo-use-database (elmo-database-msgid-put - (car entity) folder + (car entity) (elmo-folder-name-internal folder) (elmo-msgdb-overview-entity-get-number entity))) (setq curp (cdr curp)) (when (> num elmo-display-progress-threshold) (setq i (+ i 1)) (if (or (zerop (% i 5)) (= i num)) (elmo-display-progress - 'wl-summary-sync-update3 "Updating thread..." + 'wl-summary-sync-update "Updating thread..." (/ (* i 100) num))))) (when wl-summary-delayed-update (while wl-summary-delayed-update @@ -2313,57 +2133,54 @@ If ARG is non-nil, checking is omitted." update-top-list) (wl-thread-update-indent-string-thread (elmo-uniq-list update-top-list))) - (message "Updating thread...done") -;;; (set-buffer cur-buf) - )) - (unless (eq wl-summary-buffer-view 'thread) - (wl-summary-make-number-list)) - (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) - (when (and sync-all (eq wl-summary-buffer-view 'thread)) - (elmo-kill-buffer wl-summary-search-buf-name) - (message "Inserting thread...") - (setq wl-thread-entity-cur 0) - (wl-thread-insert-top) - (message "Inserting thread...done")) - (if elmo-use-database - (elmo-database-close)) - (run-hooks 'wl-summary-sync-updated-hook) - (setq ret-val (format "Updated (-%d/+%d) message(s)" + (message "Updating thread...done")) + (unless (eq wl-summary-buffer-view 'thread) + (wl-summary-make-number-list)) + (wl-summary-set-message-modified) + (wl-summary-set-mark-modified) + (when (and sync-all (eq wl-summary-buffer-view 'thread)) + (elmo-kill-buffer wl-summary-search-buf-name) + (message "Inserting thread...") + (setq wl-thread-entity-cur 0) + (wl-thread-insert-top) + (message "Inserting thread...done")) + (if elmo-use-database + (elmo-database-close)) + (run-hooks 'wl-summary-sync-updated-hook) + (setq mes (format "Updated (-%d/+%d) message(s)" (length delete-list) num))) + (setq mes (format + "No updates for \"%s\"" (elmo-folder-name-internal folder)))) ;; synchronize marks. (if wl-summary-auto-sync-marks (wl-summary-sync-marks)) ;; scoring (when wl-use-scoring (setq wl-summary-scored nil) - (wl-summary-score-headers nil wl-summary-buffer-msgdb + (wl-summary-score-headers nil (wl-summary-buffer-msgdb) (and sync-all (wl-summary-rescore-msgs number-alist)) sync-all) (when (and wl-summary-scored (setq expunged (wl-summary-score-update-all-lines))) - (setq ret-val (concat ret-val - (format " (%d expunged)" - (length expunged)))))) - ;; crosspost - (setq crossed2 (wl-summary-update-crosspost)) - (if (or crossed crossed2) - (let ((crosses (+ (or crossed 0) - (or crossed2 0)))) - (setq ret-val - (if ret-val - (concat ret-val - (format " (%d crosspost)" crosses)) - (format "%d crosspost message(s)" crosses)))) - (and ret-val - (setq ret-val (concat ret-val ".")))) + (setq mes (concat mes + (format " (%d expunged)" + (length expunged)))))) + (if (and crossed (> crossed 0)) + (setq mes + (if mes + (concat mes + (format " (%d crosspost)" crossed)) + (format "%d crosspost message(s)" crossed))) + (and mes (setq mes (concat mes ".")))) ;; Update Folder mode - (wl-folder-set-folder-updated folder (list 0 - (wl-summary-count-unread - (elmo-msgdb-get-mark-alist - wl-summary-buffer-msgdb)) - (length in-folder))) + (wl-folder-set-folder-updated + (elmo-folder-name-internal folder) + (list 0 + (wl-summary-count-unread + (elmo-msgdb-get-mark-alist + (elmo-folder-msgdb folder))) + (elmo-folder-messages folder))) (wl-summary-update-modeline) (wl-summary-buffer-number-column-detect t) ;; @@ -2381,10 +2198,11 @@ If ARG is non-nil, checking is omitted." wl-summary-partial-highlight-above-lines wl-summary-highlight-partial-threshold))) (wl-highlight-summary (point) (point-max)))))) + (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder)) (wl-delete-all-overlays) (set-buffer-modified-p nil) - ret-val)) - + (if mes (message "%s" mes)))) + (defun wl-summary-set-score-mark (mark) (save-excursion (beginning-of-line) @@ -2392,7 +2210,7 @@ If ARG is non-nil, checking is omitted." (buffer-read-only nil) msg-num cur-mark) - (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)") + (when (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)") (setq msg-num (string-to-int (wl-match-buffer 1))) (setq cur-mark (wl-match-buffer 2)) (when (member cur-mark (list " " @@ -2459,75 +2277,39 @@ If ARG is non-nil, checking is omitted." (defun wl-summary-message-number () (save-excursion (beginning-of-line) - (if (looking-at "^ *\\([0-9]+\\)") + (if (looking-at "^ *\\(-?[0-9]+\\)") (string-to-int (wl-match-buffer 1)) nil))) (defun wl-summary-move (src dsts-msgs) (let* ((dsts (car dsts-msgs)) ; (+foo +bar) ;;; (msgs (cdr dsts-msgs)) ; (1 2 3) -;;; (msgdb wl-summary-buffer-msgdb) +;;; (msgdb (wl-summary-buffer-msgdb)) ;;; result) ) (while dsts (setq dsts (cdr dsts))))) -(defun wl-summary-flush-pending-append-operations (&optional seen-list) - "Execute append operations that are done while offline status." - (when (and (elmo-folder-plugged-p wl-summary-buffer-folder-name) - elmo-enable-disconnected-operation) - (let* ((resumed-list (elmo-dop-append-list-load - wl-summary-buffer-folder-name t)) - (append-list (elmo-dop-append-list-load - wl-summary-buffer-folder-name)) - (appends (append resumed-list append-list)) - (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) - dels pair) - (when appends - (while appends - (if (setq pair (rassoc (car appends) number-alist)) - (setq dels (append dels (list (car pair))))) - (setq appends (cdr appends))) - (when dels - (setq seen-list - (elmo-msgdb-add-msgs-to-seen-list-subr - dels - wl-summary-buffer-msgdb - (concat wl-summary-important-mark - wl-summary-read-uncached-mark) - seen-list)) - (message "Resuming summary status...") - (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name - dels wl-summary-buffer-msgdb t) - (wl-summary-delete-messages-on-buffer dels) - (message "Resuming summary status...done")) - ;; delete resume-file - (elmo-dop-append-list-save wl-summary-buffer-folder-name nil t) - (when append-list - (elmo-dop-flush-pending-append-operations - wl-summary-buffer-folder-name append-list))))) - seen-list) - (defun wl-summary-delete-all-msgs () (interactive) (let ((cur-buf (current-buffer)) - (dels (elmo-list-folder wl-summary-buffer-folder-name))) + (dels (elmo-folder-list-messages wl-summary-buffer-elmo-folder))) (set-buffer cur-buf) (if (null dels) (message "No message to delete.") (if (y-or-n-p (format "%s has %d message(s). Delete all? " - wl-summary-buffer-folder-name + (wl-summary-buffer-folder-name) (length dels))) (progn (message "Deleting...") - (elmo-delete-msgs wl-summary-buffer-folder-name dels - wl-summary-buffer-msgdb) - (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name - dels wl-summary-buffer-msgdb) -;;; (elmo-msgdb-save wl-summary-buffer-folder-name nil) + (elmo-folder-delete-messages + wl-summary-buffer-elmo-folder dels) + (elmo-msgdb-delete-msgs (wl-summary-buffer-msgdb) + dels) +;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil) (wl-summary-set-message-modified) (wl-summary-set-mark-modified) - (wl-folder-set-folder-updated wl-summary-buffer-folder-name + (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) (list 0 0 0)) ;;; for thread. ;;; (setq wl-thread-top-entity '(nil t nil nil)) @@ -2590,14 +2372,17 @@ If ARG, without confirm." (wl-folder-get-entity-id entity)))) (wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t)) -(defun wl-summary-sticky-p (&optional fld) - (if fld - (get-buffer (wl-summary-sticky-buffer-name fld)) +(defun wl-summary-sticky-p (&optional folder) + (if folder + (get-buffer (wl-summary-sticky-buffer-name + (elmo-folder-name-internal folder))) (not (string= wl-summary-buffer-name (buffer-name))))) -(defun wl-summary-always-sticky-folder-p (fld) +(defun wl-summary-always-sticky-folder-p (folder) (or (eq t wl-summary-always-sticky-folder-list) - (wl-string-match-member fld wl-summary-always-sticky-folder-list))) + (wl-string-match-member + (elmo-folder-name-internal folder) + wl-summary-always-sticky-folder-list))) (defun wl-summary-stick (&optional force) "Make current summary buffer sticky." @@ -2608,30 +2393,32 @@ If ARG, without confirm." (wl-summary-toggle-disp-msg 'off) (wl-summary-switch-to-clone-buffer (wl-summary-sticky-buffer-name - wl-summary-buffer-folder-name)) + (wl-summary-buffer-folder-name))) ;;; ???hang up ;;; (rename-buffer (wl-summary-sticky-buffer-name -;;; wl-summary-buffer-folder-name))) - (message "Folder `%s' is now sticky." wl-summary-buffer-folder-name)))) +;;; (wl-summary-buffer-folder-name)))) + (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name))))) (defun wl-summary-switch-to-clone-buffer (buffer-name) (let ((cur-buf (current-buffer)) (msg (wl-summary-message-number)) (buf (get-buffer-create buffer-name)) - (folder wl-summary-buffer-folder-name) + (folder wl-summary-buffer-elmo-folder) (copy-variables (append '(wl-summary-buffer-view wl-summary-buffer-refile-list wl-summary-buffer-delete-list wl-summary-buffer-copy-list wl-summary-buffer-target-mark-list - wl-summary-buffer-msgdb + wl-summary-buffer-elmo-folder wl-summary-buffer-number-column wl-summary-buffer-number-regexp wl-summary-buffer-message-modified wl-summary-buffer-mark-modified wl-summary-buffer-thread-modified - wl-summary-buffer-number-list) + wl-summary-buffer-number-list + wl-summary-buffer-msgdb + wl-summary-buffer-folder-name) (and (eq wl-summary-buffer-view 'thread) '(wl-thread-entity-hashtb wl-thread-entities @@ -2661,7 +2448,7 @@ If ARG, without confirm." (switch-to-buffer buf) (kill-buffer cur-buf) (wl-summary-count-unread - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline) (if msg (if (eq wl-summary-buffer-view 'thread) @@ -2675,74 +2462,57 @@ If ARG, without confirm." (get-buffer (wl-summary-sticky-buffer-name folder))) (get-buffer wl-summary-buffer-name))) -(defun wl-summary-get-buffer-create (folder &optional force-sticky) +(defun wl-summary-get-buffer-create (name &optional force-sticky) (if force-sticky (get-buffer-create - (wl-summary-sticky-buffer-name folder)) - (or (get-buffer (wl-summary-sticky-buffer-name folder)) + (wl-summary-sticky-buffer-name name)) + (or (get-buffer (wl-summary-sticky-buffer-name name)) (get-buffer-create wl-summary-buffer-name)))) -(defun wl-summary-disp-msg (folder disp-msg) - (let (disp mes-win) - (if (and disp-msg - wl-summary-buffer-disp-msg) - (let ((view-message-buffer (get-buffer wl-message-buf-name)) - (number (wl-summary-message-number)) - cur-folder cur-number sel-win) - (when view-message-buffer - (save-excursion - (set-buffer view-message-buffer) - (setq cur-folder wl-message-buffer-cur-folder - cur-number wl-message-buffer-cur-number)) - (when (and (string= folder cur-folder) - (eq number cur-number)) - (setq sel-win (selected-window)) - (wl-select-buffer view-message-buffer) - (select-window sel-win) - (setq disp t))))) - (if (not disp) - (setq wl-summary-buffer-disp-msg nil)) - (when (and (not disp) - (setq mes-win (wl-message-buffer-window))) - (delete-window mes-win) - (run-hooks 'wl-summary-toggle-disp-off-hook)))) - (defun wl-summary-make-number-list () (setq wl-summary-buffer-number-list (mapcar (lambda (x) (elmo-msgdb-overview-entity-get-number x)) - (elmo-msgdb-get-overview wl-summary-buffer-msgdb)))) + (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))))) (defun wl-summary-auto-select-msg-p (unread-msg) (and unread-msg (not (string= (cadr (assoc unread-msg (elmo-msgdb-get-mark-alist - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) wl-summary-important-mark)))) -(defun wl-summary-goto-folder-subr (&optional folder scan-type other-window +(defun wl-summary-goto-folder-subr (&optional name scan-type other-window sticky interactive scoring) "Display target folder on summary." (interactive) (let* ((keep-cursor (memq this-command wl-summary-keep-cursor-command)) - (fld (or folder (wl-summary-read-folder wl-default-folder))) - (cur-fld wl-summary-buffer-folder-name) - buf mes hilit reuse-buf + (name (or name (wl-summary-read-folder wl-default-folder))) + (cur-fld wl-summary-buffer-elmo-folder) + folder buf mes hilit reuse-buf retval entity) - (if (string= fld "") - (setq fld wl-default-folder)) - (when (and (not (string= cur-fld fld)) ; folder is moved. + (if (string= name "") + (setq name wl-default-folder)) + (setq folder (wl-folder-get-elmo-folder name)) + (when (and (not (string= + (and cur-fld + (elmo-folder-name-internal cur-fld)) + (elmo-folder-name-internal folder))) ; folder is moved. (eq major-mode 'wl-summary-mode)) ; called in summary. - (setq wl-summary-last-visited-folder wl-summary-buffer-folder-name) + (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name)) + (run-hooks 'wl-summary-exit-pre-hook) (wl-summary-cleanup-temp-marks (wl-summary-sticky-p)) - (wl-summary-save-status 'keep)) ;; keep current buffer, anyway. - (setq buf (wl-summary-get-buffer-create fld sticky)) + (wl-summary-save-view 'keep) ; keep current buffer, anyway. + (elmo-folder-commit wl-summary-buffer-elmo-folder)) + (setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder) + sticky)) (setq reuse-buf (save-excursion (set-buffer buf) - (string= fld wl-summary-buffer-folder-name))) + (string= (elmo-folder-name-internal folder) + (wl-summary-buffer-folder-name)))) (unwind-protect (if reuse-buf (if interactive @@ -2753,24 +2523,23 @@ If ARG, without confirm." (set-buffer buf) (unless (eq major-mode 'wl-summary-mode) (wl-summary-mode)) - (wl-summary-buffer-set-folder fld) + (wl-summary-buffer-set-folder folder) (setq wl-summary-buffer-disp-msg nil) (setq wl-summary-buffer-last-displayed-msg nil) (setq wl-summary-buffer-current-msg nil) (let ((case-fold-search nil) (inhibit-read-only t) (buffer-read-only nil)) - ;; Load msgdb - (setq wl-summary-buffer-msgdb nil) ; new msgdb - (setq wl-summary-buffer-msgdb - (wl-summary-msgdb-load-async fld)) - (if (null wl-summary-buffer-msgdb) - (setq wl-summary-buffer-msgdb - (elmo-msgdb-load (elmo-string fld)))) + ;; Select folder + (elmo-folder-open folder 'load-msgdb) + ;; For compatibility + (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder)) + (setq wl-summary-buffer-folder-name (elmo-folder-name-internal + folder)) (erase-buffer) ;; Resume summary view (if wl-summary-cache-use - (let* ((dir (elmo-msgdb-expand-path fld)) + (let* ((dir (elmo-folder-msgdb-path folder)) (cache (expand-file-name wl-summary-cache-file dir)) (view (expand-file-name wl-summary-view-file dir))) (when (file-exists-p cache) @@ -2784,18 +2553,18 @@ If ARG, without confirm." (setq wl-summary-buffer-view (wl-summary-load-file-object view))) (if (eq wl-summary-buffer-view 'thread) - (wl-thread-resume-entity fld) - (wl-summary-make-number-list))) + (wl-thread-resume-entity folder) + (wl-summary-make-number-list))) (setq wl-summary-buffer-view (wl-summary-load-file-object (expand-file-name wl-summary-view-file - (elmo-msgdb-expand-path fld)))) + (elmo-folder-msgdb-path folder)))) (wl-summary-rescan)) (wl-summary-count-unread - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline))) (wl-summary-buffer-number-column-detect t) - (wl-summary-disp-msg fld (and reuse-buf keep-cursor)) + (wl-summary-toggle-disp-msg (if wl-summary-buffer-disp-msg 'on 'off)) (unless (and reuse-buf keep-cursor) ;(setq hilit wl-summary-highlight) (unwind-protect @@ -2805,7 +2574,7 @@ If ARG, without confirm." (if (and (not scan-type) interactive (not wl-ask-range)) - (setq scan-type (wl-summary-get-sync-range fld))) + (setq scan-type (wl-summary-get-sync-range folder))) (cond ((eq scan-type nil) (wl-summary-sync 'unset-cursor)) @@ -2814,12 +2583,13 @@ If ARG, without confirm." ((eq scan-type 'no-sync)) ((or (eq scan-type 'force-update) (eq scan-type 'update)) - (setq mes (wl-summary-sync-force-update 'unset-cursor))))) + (setq mes (wl-summary-sync-force-update + 'unset-cursor 'no-check))))) (if interactive (switch-to-buffer buf) (set-buffer buf)) ;; stick always-sticky-folder - (when (wl-summary-always-sticky-folder-p fld) + (when (wl-summary-always-sticky-folder-p folder) (or (wl-summary-sticky-p) (wl-summary-stick t))) (run-hooks 'wl-summary-prepared-pre-hook) (set-buffer-modified-p nil) @@ -2856,9 +2626,6 @@ If ARG, without confirm." wl-summary-highlight-partial-threshold))) (wl-highlight-summary (point) (point-max))) (wl-highlight-summary (point-min) (point-max)))) - (if (null wl-summary-buffer-msgdb) ;; one more try. - (setq wl-summary-buffer-msgdb - (elmo-msgdb-load (elmo-string fld)))) (if (eq retval 'disp-msg) (wl-summary-redisplay)) (if mes (message "%s" mes)) @@ -2867,7 +2634,8 @@ If ARG, without confirm." ;; set current entity-id (if (and (not folder) (setq entity - (wl-folder-search-entity-by-name fld + (wl-folder-search-entity-by-name (elmo-folder-name-internal + folder) wl-folder-entity 'folder))) ;; entity-id is unknown. @@ -2996,14 +2764,14 @@ If ARG, without confirm." (defun wl-summary-search-by-subject (entity overview) (let ((buf (get-buffer-create wl-summary-search-buf-name)) - (folder-name wl-summary-buffer-folder-name) + (folder-name (wl-summary-buffer-folder-name)) match founds found-entity) (save-excursion (set-buffer buf) (let ((case-fold-search t)) - (when (or (not (string= wl-summary-buffer-folder-name folder-name)) + (when (or (not (string= wl-summary-search-buf-folder-name folder-name)) (zerop (buffer-size))) - (setq wl-summary-buffer-folder-name folder-name) + (setq wl-summary-search-buf-folder-name folder-name) (wl-summary-insert-headers overview (function @@ -3134,8 +2902,8 @@ If ARG, without confirm." (let* (eol (inhibit-read-only t) (buffer-read-only nil) - (folder wl-summary-buffer-folder-name) - (msgdb wl-summary-buffer-msgdb) + (folder wl-summary-buffer-elmo-folder) + (msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) ;;; (number-alist (elmo-msgdb-get-number-alist msgdb)) new-mark visible mark) @@ -3160,7 +2928,7 @@ If ARG, without confirm." (re-search-forward (format (concat "^ *\\(" (if number (int-to-string number) - "[0-9]+") + "-?[0-9]+") "\\)[^0-9]\\(%s\\|%s\\)") wl-summary-read-uncached-mark " ") eol t)) @@ -3171,14 +2939,14 @@ If ARG, without confirm." (setq new-mark (if (string= mark wl-summary-read-uncached-mark) wl-summary-unread-uncached-mark - (if (elmo-use-cache-p folder number) + (if (elmo-message-use-cache-p folder number) wl-summary-unread-mark wl-summary-unread-uncached-mark)))) ;; server side mark (unless no-server-update - (unless (elmo-mark-as-unread folder (list number) - msgdb) - (error "Setting mark failed"))) + (save-match-data + (unless (elmo-folder-unmark-read folder (list number)) + (error "Setting mark failed")))) (when visible (delete-region (match-beginning 2) (match-end 2)) (insert new-mark)) @@ -3192,7 +2960,7 @@ If ARG, without confirm." (+ 1 wl-summary-buffer-unread-count)) (wl-summary-update-modeline) (wl-folder-update-unread - folder + (wl-summary-buffer-folder-name) (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count))) (wl-summary-set-mark-modified) @@ -3317,7 +3085,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (message "No marks") (save-excursion (let ((del-fld (wl-summary-get-delete-folder - wl-summary-buffer-folder-name)) + (wl-summary-buffer-folder-name))) (start (point)) (unread-marks (list wl-summary-unread-cached-mark wl-summary-unread-uncached-mark @@ -3346,24 +3114,23 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (goto-char start) ; avoid moving cursor to ; the bottom line. (while dst-msgs -;;; (elmo-msgdb-add-msgs-to-seen-list -;;; (car (car dst-msgs)) ;dst-folder -;;; (cdr (car dst-msgs)) ;msgs -;;; wl-summary-buffer-msgdb -;;; (concat wl-summary-important-mark -;;; wl-summary-read-uncached-mark)) (setq result nil) (condition-case nil - (setq result (elmo-move-msgs wl-summary-buffer-folder-name - (cdr (car dst-msgs)) - (car (car dst-msgs)) - wl-summary-buffer-msgdb - refile-len - refile-executed - (not (null (cdr dst-msgs))) - nil ; no-delete - nil ; same-number - unread-marks)) + (setq result (elmo-folder-move-messages + wl-summary-buffer-elmo-folder + (cdr (car dst-msgs)) + (if (eq 'null (car (car dst-msgs))) + 'null + (wl-folder-get-elmo-folder + (car (car dst-msgs)))) + (wl-summary-buffer-msgdb) + refile-len + refile-executed + (not (null (cdr dst-msgs))) + nil ; no-delete + nil ; same-number + unread-marks + t)) (error nil)) (if result ; succeeded. (progn @@ -3372,7 +3139,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." ;; update refile-alist. (setq wl-summary-buffer-refile-list (wl-delete-associations (cdr (car dst-msgs)) - wl-summary-buffer-refile-list))) + wl-summary-buffer-refile-list))) (setq refile-failures (+ refile-failures (length (cdr (car dst-msgs)))))) (setq refile-executed (+ refile-executed (length (cdr (car dst-msgs))))) @@ -3381,24 +3148,21 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." ;; begin cOpy... (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list)) (while dst-msgs -;;; (elmo-msgdb-add-msgs-to-seen-list -;;; (car (car dst-msgs)) ;dst-folder -;;; (cdr (car dst-msgs)) ;msgs -;;; wl-summary-buffer-msgdb -;;; (concat wl-summary-important-mark -;;; wl-summary-read-uncached-mark)) (setq result nil) (condition-case nil - (setq result (elmo-move-msgs wl-summary-buffer-folder-name - (cdr (car dst-msgs)) - (car (car dst-msgs)) - wl-summary-buffer-msgdb - copy-len - copy-executed - (not (null (cdr dst-msgs))) - t ; t is no-delete (copy) - nil ; same number - unread-marks)) + (setq result (elmo-folder-move-messages + wl-summary-buffer-elmo-folder + (cdr (car dst-msgs)) + (wl-folder-get-elmo-folder + (car (car dst-msgs))) + (wl-summary-buffer-msgdb) + copy-len + copy-executed + (not (null (cdr dst-msgs))) + t ; t is no-delete (copy) + nil ; same number + unread-marks + t)) (error nil)) (if result ; succeeded. (progn @@ -3432,7 +3196,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (let ((fld (completing-read (format "Folder name %s(%s): " (or purpose "") default) - (or wl-folder-completion-func + (or wl-folder-completion-function (if (memq 'read-folder wl-use-folder-petname) (wl-folder-get-entity-with-petname) wl-folder-entity-hashtb)) @@ -3446,8 +3210,13 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (error "Not supported folder name: %s" fld)) (unless no-create (if ignore-error - (ignore-errors (wl-folder-confirm-existence fld)) - (wl-folder-confirm-existence fld))) + (condition-case nil + (wl-folder-confirm-existence + (wl-folder-get-elmo-folder + fld)) + (error)) + (wl-folder-confirm-existence (wl-folder-get-elmo-folder + fld)))) fld)) (defun wl-summary-print-destination (msg-num folder) @@ -3500,7 +3269,7 @@ If folder is read-only, message should be copied. See `wl-refile-policy-alist' for more details." (interactive) (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist - wl-summary-buffer-folder-name))) + (wl-summary-buffer-folder-name)))) (cond ((eq policy 'copy) (if (interactive-p) (call-interactively 'wl-summary-copy) @@ -3521,12 +3290,11 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (let* ((buffer-num (wl-summary-message-number)) (msg-num (or number buffer-num)) (msgid (and msg-num - (cdr (assq msg-num - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))))) + (elmo-message-field wl-summary-buffer-elmo-folder + msg-num 'message-id))) (entity (and msg-num (elmo-msgdb-overview-get-entity - msg-num wl-summary-buffer-msgdb))) + msg-num (wl-summary-buffer-msgdb)))) (variable (intern (format "wl-summary-buffer-%s-list" copy-or-refile))) folder mark already tmp-folder) @@ -3550,8 +3318,9 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (or (wl-refile-guess entity) wl-trash-folder) (format "for %s" copy-or-refile))))) ;; Cache folder hack by okada@opaopa.org - (if (and (eq (car (elmo-folder-get-spec - (wl-folder-get-realname folder))) 'cache) + (if (and (eq (elmo-folder-type-internal + (wl-folder-get-elmo-folder + (wl-folder-get-realname folder))) 'cache) (not (string= folder (setq tmp-folder (concat "'cache/" @@ -3560,14 +3329,8 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (progn (setq folder tmp-folder) (message "Force refile to %s." folder))) - (if (string= folder wl-summary-buffer-folder-name) + (if (string= folder (wl-summary-buffer-folder-name)) (error "Same folder")) - (unless (or (elmo-folder-plugged-p wl-summary-buffer-folder-name) - (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) 'pipe) - (elmo-folder-plugged-p - (elmo-pipe-spec-dst (elmo-folder-get-spec wl-summary-buffer-folder-name)))) - (elmo-cache-exists-p msgid)) - (error "Unplugged (no cache or msgid)")) (if (or (string= folder wl-queue-folder) (string= folder wl-draft-folder)) (error "Don't %s messages to %s" copy-or-refile folder)) @@ -3621,11 +3384,11 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (if (and (eq wl-summary-buffer-view 'thread) open-all) (wl-thread-open-all)) - (let* ((spec wl-summary-buffer-folder-name) + (let* ((spec (wl-summary-buffer-folder-name)) (overview (elmo-msgdb-get-overview - wl-summary-buffer-msgdb)) + (wl-summary-buffer-msgdb))) (mark-alist (elmo-msgdb-get-mark-alist - wl-summary-buffer-msgdb)) + (wl-summary-buffer-msgdb))) checked-dsts (count 0) number dst thr-entity) @@ -3638,10 +3401,10 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (wl-folder-get-realname (wl-refile-guess-by-rule (elmo-msgdb-overview-get-entity - number wl-summary-buffer-msgdb)))) + number (wl-summary-buffer-msgdb))))) (not (equal dst spec))) (when (not (member dst checked-dsts)) - (wl-folder-confirm-existence dst) + (wl-folder-confirm-existence (wl-folder-get-elmo-folder dst)) (setq checked-dsts (cons dst checked-dsts))) (if (wl-summary-refile dst number) (incf count)) @@ -3661,7 +3424,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (when (and (setq dst (wl-refile-guess-by-rule (elmo-msgdb-overview-get-entity - (car messages) wl-summary-buffer-msgdb))) + (car messages) (wl-summary-buffer-msgdb)))) (not (equal dst spec))) (if (wl-summary-refile dst (car messages)) (incf count)) @@ -3689,7 +3452,7 @@ If optional argument NUMBER is specified, unmark message specified by NUMBER." (setq visible t)) ;; Delete mark on buffer. (when (and visible - (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")) + (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)")) (goto-char (match-end 2)) (or number (setq number (string-to-int (wl-match-buffer 1)))) @@ -3771,10 +3534,10 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." ;; guess by first msg (let* ((msgid (cdr (assq (wl-summary-message-number) (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)))) + (wl-summary-buffer-msgdb))))) (function (intern (format "wl-summary-%s" copy-or-refile))) (entity (assoc msgid (elmo-msgdb-get-overview - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) folder) (if entity (setq folder (wl-summary-read-folder (wl-refile-guess entity) @@ -3858,12 +3621,12 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (wl-summary-target-mark-region (point-min) (point-max)) (setq wl-summary-buffer-target-mark-list (mapcar 'car - (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)))) + (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))))) (defun wl-summary-delete-all-mark (mark) (goto-char (point-min)) (let ((case-fold-search nil)) - (while (re-search-forward (format "^ *[0-9]+%s" + (while (re-search-forward (format "^ *-?[0-9]+%s" (regexp-quote mark)) nil t) (wl-summary-unmark)) (cond ((string= mark "*") @@ -3911,9 +3674,9 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (defun wl-summary-pick (&optional from-list delete-marks) (interactive) (let ((result (elmo-msgdb-search - wl-summary-buffer-folder-name + wl-summary-buffer-elmo-folder (elmo-read-search-condition wl-summary-pick-field-default) - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) (if delete-marks (let ((mlist wl-summary-buffer-target-mark-list)) (while mlist @@ -3932,10 +3695,12 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." "Exit from current virtual folder." (interactive) (if (eq 'filter - (elmo-folder-get-type wl-summary-buffer-folder-name)) - (wl-summary-goto-folder-subr (nth 2 (elmo-folder-get-spec - wl-summary-buffer-folder-name)) - 'update nil nil t) + (elmo-folder-type-internal wl-summary-buffer-elmo-folder)) + (wl-summary-goto-folder-subr + (elmo-folder-name-internal + (elmo-filter-folder-target-internal + wl-summary-buffer-elmo-folder)) + 'update nil nil t) (error "This folder is not filtered"))) (defun wl-summary-virtual (&optional arg) @@ -3948,7 +3713,7 @@ If ARG, exit virtual folder." (elmo-read-search-condition wl-summary-pick-field-default) "/" - wl-summary-buffer-folder-name) + (wl-summary-buffer-folder-name)) 'update nil nil t))) (defun wl-summary-delete-all-temp-marks () @@ -3992,7 +3757,7 @@ If ARG, exit virtual folder." (buffer-read-only nil) msg-num cur-mark) - (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)") + (when (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)") (setq msg-num (string-to-int (wl-match-buffer 1))) (setq cur-mark (wl-match-buffer 2)) (goto-char (match-end 1)) @@ -4043,7 +3808,7 @@ If ARG, exit virtual folder." (when (wl-summary-jump-to-msg (car mlist)) (wl-summary-unmark) (when new-mark - (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)") + (when (looking-at "^ *-?[0-9]+[^0-9]\\([^0-9]\\)") (delete-region (match-beginning 1) (match-end 1))) (goto-char (match-beginning 1)) (insert new-mark) @@ -4071,10 +3836,10 @@ If ARG, exit virtual folder." (when (re-search-forward regexp nil t) (setq msgid (cdr (assq (setq number (wl-summary-message-number)) (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) entity (assoc msgid (elmo-msgdb-get-overview - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) (if (null entity) (error "Cannot %s" copy-or-refile)) (funcall function @@ -4135,7 +3900,7 @@ If ARG, exit virtual folder." (delq (car mlist) wl-summary-buffer-target-mark-list)) (setq mlist (cdr mlist))) (wl-summary-count-unread - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline)))) (defun wl-summary-target-mark-mark-as-unread () @@ -4165,7 +3930,7 @@ If ARG, exit virtual folder." (delq (car mlist) wl-summary-buffer-target-mark-list)) (setq mlist (cdr mlist))) (wl-summary-count-unread - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline)))) (defun wl-summary-target-mark-mark-as-important () @@ -4195,7 +3960,7 @@ If ARG, exit virtual folder." (delq (car mlist) wl-summary-buffer-target-mark-list)) (setq mlist (cdr mlist))) (wl-summary-count-unread - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (wl-summary-update-modeline)))) (defun wl-summary-target-mark-save () @@ -4230,8 +3995,8 @@ If ARG, exit virtual folder." (let* (eol (inhibit-read-only t) (buffer-read-only nil) - (folder wl-summary-buffer-folder-name) - (msgdb wl-summary-buffer-msgdb) + (folder wl-summary-buffer-elmo-folder) + (msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) ;;; (number-alist (elmo-msgdb-get-number-alist msgdb)) (case-fold-search nil) @@ -4244,7 +4009,7 @@ If ARG, exit virtual folder." (beginning-of-line) (if (or (not visible) (looking-at - (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$" + (format "^ *\\(-?[0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$" (regexp-quote wl-summary-read-uncached-mark) (regexp-quote wl-summary-unread-uncached-mark) (regexp-quote wl-summary-unread-cached-mark) @@ -4267,14 +4032,16 @@ If ARG, exit virtual folder." (setq number (or number (string-to-int (wl-match-buffer 1)))) ;; set server side mark... (setq new-mark (if (and uncached - (if (elmo-use-cache-p folder number) + (if (elmo-message-use-cache-p folder number) (not (elmo-folder-local-p folder))) (not cached)) wl-summary-read-uncached-mark nil)) (if (not leave-server-side-mark-untouched) - (setq marked (elmo-mark-as-read folder - (list number) msgdb))) + (save-match-data + (setq marked (elmo-folder-mark-as-read + folder + (list number))))) (if (or leave-server-side-mark-untouched marked) (progn @@ -4286,7 +4053,7 @@ If ARG, exit virtual folder." (1- wl-summary-buffer-new-count)))) (wl-summary-update-modeline) (wl-folder-update-unread - folder + (wl-summary-buffer-folder-name) (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count)) (when (or stat cached) @@ -4299,11 +4066,7 @@ If ARG, exit virtual folder." (elmo-msgdb-set-mark-alist msgdb mark-alist) (wl-summary-set-mark-modified)) (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line nil nil t)) - (if (not notcrosses) - (wl-summary-set-crosspost nil - (and wl-summary-buffer-disp-msg - (interactive-p))))) + (wl-highlight-summary-current-line nil nil t))) (if mark (message "Warning: Changing mark failed."))))) (set-buffer-modified-p nil) (if stat @@ -4315,15 +4078,15 @@ If ARG, exit virtual folder." mark no-server-update) (interactive) - (if (eq (elmo-folder-get-type wl-summary-buffer-folder-name) + (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) 'internal) (error "Cannot process mark in this folder")) (save-excursion (let* (eol (inhibit-read-only t) (buffer-read-only nil) - (folder wl-summary-buffer-folder-name) - (msgdb wl-summary-buffer-msgdb) + (folder wl-summary-buffer-elmo-folder) + (msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) (number-alist (elmo-msgdb-get-number-alist msgdb)) message-id visible) @@ -4333,7 +4096,7 @@ If ARG, exit virtual folder." (setq mark (or mark (cadr (assq number mark-alist))))) (setq visible t)) (when visible - (if (null (wl-summary-message-number)) + (if (null (setq number (wl-summary-message-number))) (progn (message "No message.") (setq visible nil)) @@ -4343,20 +4106,27 @@ If ARG, exit virtual folder." "..../..") nil t)) ; set cursor line ) (beginning-of-line) - (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t) + (if (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)" eol t) (progn (setq number (or number (string-to-int (wl-match-buffer 1)))) (setq mark (or mark (wl-match-buffer 2))) - (setq message-id (cdr (assq number number-alist))) + (setq message-id (elmo-message-field + wl-summary-buffer-elmo-folder + number + 'message-id)) (if (string= mark wl-summary-important-mark) (progn ;; server side mark - (unless no-server-update - (elmo-unmark-important folder (list number) msgdb) - (elmo-msgdb-global-mark-delete message-id)) - ;; Remove cache if local folder. - (if (elmo-folder-local-p folder) - (elmo-cache-delete message-id folder number)) + (save-match-data + (unless no-server-update + (elmo-folder-unmark-important folder (list number)) + (elmo-msgdb-global-mark-delete message-id)) + ;; Remove cache if local folder. + (if (and (elmo-folder-local-p folder) + (not (eq 'mark + (elmo-folder-type-internal folder)))) + (elmo-file-cache-delete + (elmo-file-cache-get-path message-id)))) (when visible (delete-region (match-beginning 2) (match-end 2)) (insert " ")) @@ -4365,8 +4135,9 @@ If ARG, exit virtual folder." number nil))) ;; server side mark - (unless no-server-update - (elmo-mark-as-important folder (list number) msgdb)) + (save-match-data + (unless no-server-update + (elmo-folder-mark-as-important folder (list number)))) (when visible (delete-region (match-beginning 2) (match-end 2)) (insert wl-summary-important-mark)) @@ -4375,10 +4146,7 @@ If ARG, exit virtual folder." (string-to-int (wl-match-buffer 1)) wl-summary-important-mark)) ;; Force cache message!! - (save-match-data - (unless (elmo-cache-exists-p message-id) - (elmo-force-cache-msg folder number message-id - (elmo-msgdb-get-location msgdb)))) + (elmo-message-encache folder number) (unless no-server-update (elmo-msgdb-global-mark-set message-id wl-summary-important-mark))) @@ -4499,11 +4267,12 @@ If ARG, exit virtual folder." (setq wl-summary-buffer-number-column (or (if (and update - (setq end (if (re-search-forward "^ *[0-9]+[^0-9]" nil t) + (setq end (if (re-search-forward + "^ *-?[0-9]+[^0-9]" nil t) (point)))) (- end (progn (beginning-of-line) (point)) 1)) (wl-get-assoc-list-value wl-summary-number-column-alist - wl-summary-buffer-folder-name) + (wl-summary-buffer-folder-name)) wl-summary-default-number-column)) (setq wl-summary-buffer-number-regexp (wl-repeat-string "." wl-summary-buffer-number-column))))) @@ -4515,32 +4284,31 @@ If ARG, exit virtual folder." (elmo-date-get-week year month mday)))) (defvar wl-summary-move-spec-plugged-alist - (list (cons 'new (list (cons 't nil) - (cons 'p wl-summary-new-mark) - (cons 'p (wl-regexp-opt - (list wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark))) - (cons 'p (regexp-quote wl-summary-important-mark)))) - (cons 'unread (list (cons 't nil) - (cons 'p (wl-regexp-opt - (list wl-summary-new-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark))) - (cons 'p (regexp-quote - wl-summary-important-mark)))))) + (` ((new . ((t . nil) + (p . (, wl-summary-new-mark)) + (p . (, (wl-regexp-opt + (list wl-summary-unread-uncached-mark + wl-summary-unread-cached-mark)))) + (p . (, (regexp-quote wl-summary-important-mark))))) + (unread . ((t . nil) + (p . (, (wl-regexp-opt + (list wl-summary-new-mark + wl-summary-unread-uncached-mark + wl-summary-unread-cached-mark)))) + (p . (, (regexp-quote wl-summary-important-mark)))))))) (defvar wl-summary-move-spec-unplugged-alist - (list (cons 'new (list (cons 't nil) - (cons 'p wl-summary-unread-cached-mark) - (cons 'p (regexp-quote wl-summary-important-mark)))) - (cons 'unread (list (cons 't nil) - (cons 'p wl-summary-unread-cached-mark) - (cons 'p (regexp-quote - wl-summary-important-mark)))))) + (` ((new . ((t . nil) + (p . (, wl-summary-unread-cached-mark)) + (p . (, (regexp-quote wl-summary-important-mark))))) + (unread . ((t . nil) + (p . (, wl-summary-unread-cached-mark)) + (p . (, (regexp-quote wl-summary-important-mark)))))))) (defsubst wl-summary-next-message (num direction hereto) (let ((cur-spec (cdr (assq wl-summary-move-order - (if (elmo-folder-plugged-p wl-summary-buffer-folder-name) + (if (elmo-folder-plugged-p + wl-summary-buffer-elmo-folder) wl-summary-move-spec-plugged-alist wl-summary-move-spec-unplugged-alist)))) (nums (memq num (if (eq direction 'up) @@ -4554,20 +4322,20 @@ If ARG, exit virtual folder." (while cur-spec (setq nums nums2) (cond ((eq (car (car cur-spec)) 'p) - (if (setq marked-list (elmo-msgdb-list-messages-mark-match - wl-summary-buffer-msgdb + (if (setq marked-list (elmo-folder-list-messages-mark-match + wl-summary-buffer-elmo-folder (cdr (car cur-spec)))) (while nums (if (memq (car nums) marked-list) (throw 'done (car nums))) (setq nums (cdr nums))))) ((eq (car (car cur-spec)) 't) - (while nums - (if (and wl-summary-buffer-target-mark-list - (memq (car nums) - wl-summary-buffer-target-mark-list)) - (throw 'done (car nums))) - (setq nums (cdr nums))))) + (if wl-summary-buffer-target-mark-list + (while nums + (if (memq (car nums) + wl-summary-buffer-target-mark-list) + (throw 'done (car nums))) + (setq nums (cdr nums)))))) (setq cur-spec (cdr cur-spec)))) (car nums)))) @@ -4594,7 +4362,7 @@ If ARG, exit virtual folder." (defun wl-summary-save-view-cache () (save-excursion - (let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name)) + (let* ((dir (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder)) (cache (expand-file-name wl-summary-cache-file dir)) (view (expand-file-name wl-summary-view-file dir)) (save-view wl-summary-buffer-view) @@ -4632,7 +4400,7 @@ If ARG, exit virtual folder." (elmo-folder-plugged-p folder) (wl-get-assoc-list-value wl-folder-sync-range-alist - folder)) + (elmo-folder-name-internal folder))) wl-default-sync-range))) ;; redefined for wl-summary-sync-update @@ -4657,10 +4425,9 @@ If ARG, exit virtual folder." (defun wl-summary-toggle-disp-folder (&optional arg) (interactive) - (let (fld-buf fld-win - (view-message-buffer (wl-message-get-buffer-create)) - (cur-buf (current-buffer)) - (summary-win (get-buffer-window (current-buffer)))) + (let ((cur-buf (current-buffer)) + (summary-win (get-buffer-window (current-buffer))) + fld-buf fld-win) (cond ((eq arg 'on) (setq wl-summary-buffer-disp-folder t) @@ -4671,8 +4438,9 @@ If ARG, exit virtual folder." ((eq arg 'off) (setq wl-summary-buffer-disp-folder nil) ;; hide your wl-message window! - (wl-select-buffer view-message-buffer) - (delete-window) + (when (buffer-live-p wl-message-buffer) + (wl-message-select-buffer wl-message-buffer) + (delete-window)) (select-window (get-buffer-window cur-buf)) ;; display wl-folder window!! (if (setq fld-buf (get-buffer wl-folder-buffer-name)) @@ -4696,7 +4464,8 @@ If ARG, exit virtual folder." (setq wl-summary-buffer-disp-folder t))) (if (not wl-summary-buffer-disp-folder) ;; hide message window - (let ((mes-win (get-buffer-window view-message-buffer)) + (let ((mes-win (and wl-message-buffer + (get-buffer-window wl-message-buffer))) (wl-stay-folder-window t)) (if mes-win (delete-window mes-win)) ;; hide your folder window @@ -4709,13 +4478,14 @@ If ARG, exit virtual folder." (run-hooks 'wl-summary-toggle-disp-folder-off-hook) ;; resume message window. (when mes-win - (wl-select-buffer view-message-buffer) + (wl-message-select-buffer wl-message-buffer) (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook) (select-window (get-buffer-window cur-buf))) ) ;; hide message window - (let ((mes-win (get-buffer-window view-message-buffer)) - (wl-stay-folder-window t)) + (let ((wl-stay-folder-window t) + (mes-win (and wl-message-buffer + (get-buffer-window wl-message-buffer)))) (if mes-win (delete-window mes-win)) (select-window (get-buffer-window cur-buf)) ;; display wl-folder window!! @@ -4733,7 +4503,7 @@ If ARG, exit virtual folder." ;; resume message window. (run-hooks 'wl-summary-toggle-disp-folder-on-hook) (when mes-win - (wl-select-buffer view-message-buffer) + (wl-message-select-buffer wl-message-buffer) (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook) (select-window (get-buffer-window cur-buf)))) )))) @@ -4741,29 +4511,32 @@ If ARG, exit virtual folder." (defun wl-summary-toggle-disp-msg (&optional arg) (interactive) - (let (fld-buf fld-win - (view-message-buffer (wl-message-get-buffer-create)) - (cur-buf (current-buffer)) + (let ((cur-buf (current-buffer)) + fld-buf fld-win summary-win) (cond ((eq arg 'on) (setq wl-summary-buffer-disp-msg t) - ;; hide your folder window - (if (and (not wl-stay-folder-window) - (setq fld-buf (get-buffer wl-folder-buffer-name))) - (if (setq fld-win (get-buffer-window fld-buf)) - (delete-window fld-win)))) + (save-excursion + ;; hide your folder window + (if (and (not wl-stay-folder-window) + (setq fld-buf (get-buffer wl-folder-buffer-name))) + (if (setq fld-win (get-buffer-window fld-buf)) + (unless (one-window-p fld-win) + (delete-window fld-win)))))) ((eq arg 'off) (wl-delete-all-overlays) (setq wl-summary-buffer-disp-msg nil) (save-excursion - (wl-select-buffer view-message-buffer) - (delete-window) - (and (get-buffer-window cur-buf) - (select-window (get-buffer-window cur-buf))) + (when (buffer-live-p wl-message-buffer) + (wl-message-select-buffer wl-message-buffer) + (delete-window) + (and (get-buffer-window cur-buf) + (select-window (get-buffer-window cur-buf)))) (run-hooks 'wl-summary-toggle-disp-off-hook))) (t - (if (get-buffer-window view-message-buffer) ; already displayed + (if (and wl-message-buffer + (get-buffer-window wl-message-buffer)) ; already displayed (setq wl-summary-buffer-disp-msg nil) (setq wl-summary-buffer-disp-msg t)) (if wl-summary-buffer-disp-msg @@ -4776,7 +4549,7 @@ If ARG, exit virtual folder." (run-hooks 'wl-summary-toggle-disp-on-hook)) (wl-delete-all-overlays) (save-excursion - (wl-select-buffer view-message-buffer) + (wl-message-select-buffer wl-message-buffer) (delete-window) (select-window (get-buffer-window cur-buf)) (run-hooks 'wl-summary-toggle-disp-off-hook)) @@ -4784,6 +4557,7 @@ If ARG, exit virtual folder." ))))) (defun wl-summary-next-line-content () + "Show next line of the message." (interactive) (let ((cur-buf (current-buffer))) (wl-summary-toggle-disp-msg 'on) @@ -4808,37 +4582,32 @@ If ARG, exit virtual folder." (wl-message-prev-page)) (defsubst wl-summary-no-mime-p (folder) - (wl-string-match-member folder wl-summary-no-mime-folder-list)) - -(defun wl-summary-set-message-buffer-or-redisplay (&optional ignore-original) - ;; if current message is not displayed, display it. - ;; return t if exists. - (let ((folder wl-summary-buffer-folder-name) + (wl-string-match-member (elmo-folder-name-internal folder) + wl-summary-no-mime-folder-list)) + +(defun wl-summary-set-message-buffer-or-redisplay (&rest args) + "Set message buffer. +If message is not displayed yet, display it. +Return t if message exists." + (let ((folder wl-summary-buffer-elmo-folder) (number (wl-summary-message-number)) - cur-folder cur-number message-last-pos - (view-message-buffer (wl-message-get-buffer-create))) - (save-excursion - (set-buffer view-message-buffer) - (setq cur-folder wl-message-buffer-cur-folder) - (setq cur-number wl-message-buffer-cur-number)) - (if (and (not ignore-original) - (not - (and (eq number (wl-message-original-buffer-number)) - (string= folder (wl-message-original-buffer-folder))))) + cur-folder cur-number message-last-pos) + (when (buffer-live-p wl-message-buffer) + (save-window-excursion + (wl-message-select-buffer wl-message-buffer) + (setq cur-folder wl-message-buffer-cur-folder) + (setq cur-number wl-message-buffer-cur-number))) + (if (and (string= (elmo-folder-name-internal folder) (or cur-folder "")) + (eq number (or cur-number 0))) (progn - (if (wl-summary-no-mime-p folder) - (wl-summary-redisplay-no-mime folder number) - (wl-summary-redisplay-internal folder number)) - nil) - (if (and (string= folder (or cur-folder "")) - (eq number (or cur-number 0))) - (progn - (set-buffer view-message-buffer) - t) - (if (wl-summary-no-mime-p folder) - (wl-summary-redisplay-no-mime folder number) - (wl-summary-redisplay-internal folder number)) - nil)))) + (set-buffer wl-message-buffer) + t) + (if (wl-summary-no-mime-p folder) + (wl-summary-redisplay-no-mime folder number) + (wl-summary-redisplay-internal folder number)) + (when (buffer-live-p wl-message-buffer) + (set-buffer wl-message-buffer)) + nil))) (defun wl-summary-target-mark-forward (&optional arg) (interactive "P") @@ -4880,11 +4649,12 @@ If ARG, exit virtual folder." (wl-summary-jump-to-msg (car mlist)) (wl-summary-reply arg t) (goto-char (point-max)) - (setq start-point (point)) + (setq start-point (point-marker)) (setq draft-buf (current-buffer)) (save-window-excursion (while mlist (set-buffer summary-buf) + (delete-other-windows) (wl-summary-jump-to-msg (car mlist)) (wl-summary-redisplay) (set-buffer draft-buf) @@ -4908,13 +4678,13 @@ If ARG, exit virtual folder." (interactive) (let* ((original (wl-summary-message-number)) (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: ")))) - (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) + (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) msg otherfld schar (errmsg (format "No message with id \"%s\" in the folder." msgid))) (if (setq msg (car (rassoc msgid number-alist))) ;;; (wl-summary-jump-to-msg-internal -;;; wl-summary-buffer-folder-name msg 'no-sync) +;;; (wl-summary-buffer-folder-name) msg 'no-sync) (progn (wl-thread-jump-to-msg msg) t) @@ -4929,10 +4699,11 @@ If ARG, exit virtual folder." t ; succeed. ;; Back to original. (wl-summary-jump-to-msg-internal - wl-summary-buffer-folder-name original 'no-sync)) + (wl-summary-buffer-folder-name) original 'no-sync)) (cond ((eq wl-summary-search-via-nntp 'confirm) + (require 'elmo-nntp) (message "Search message in nntp server \"%s\" ?" - elmo-default-nntp-server) + elmo-nntp-default-server) (setq schar (read-char)) (cond ((eq schar ?y) (wl-summary-jump-to-msg-by-message-id-via-nntp msgid)) @@ -4956,19 +4727,19 @@ If ARG, exit virtual folder." user server port type spec) (if server-spec (if (string-match "^-" server-spec) - (setq spec (elmo-nntp-get-spec server-spec) - user (nth 2 spec) - server (nth 3 spec) - port (nth 4 spec) - type (nth 5 spec)) + (setq spec (wl-folder-get-elmo-folder server-spec) + user (elmo-net-folder-user-internal spec) + server (elmo-net-folder-server-internal spec) + port (elmo-net-folder-port-internal spec) + type (elmo-net-folder-stream-type-internal spec)) (setq server server-spec))) (when (setq ret (elmo-nntp-get-newsgroup-by-msgid msgid - (or server elmo-default-nntp-server) - (or user elmo-default-nntp-user) - (or port elmo-default-nntp-port) - (or type elmo-default-nntp-stream-type))) - (setq newsgroups (wl-parse-newsgroups ret)) + (or server elmo-nntp-default-server) + (or user elmo-nntp-default-user) + (or port elmo-nntp-default-port) + (or type elmo-nntp-default-stream-type))) + (setq newsgroups (elmo-nntp-parse-newsgroups ret)) (setq folder (concat "-" (car newsgroups) (elmo-nntp-folder-postfix user server port type))) (catch 'found @@ -4983,12 +4754,12 @@ If ARG, exit virtual folder." (if ret (wl-summary-jump-to-msg-internal folder nil 'update msgid) (message "No message id \"%s\" in nntp server \"%s\"." - msgid (or server elmo-default-nntp-server)) + msgid (or server elmo-nntp-default-server)) nil))) (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid) (let (wl-auto-select-first entity) - (if (or (string= folder wl-summary-buffer-folder-name) + (if (or (string= folder (wl-summary-buffer-folder-name)) (y-or-n-p (format "Message was found in the folder \"%s\". Jump to it? " @@ -5001,7 +4772,7 @@ If ARG, exit virtual folder." (setq msg (car (rassoc msgid (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))))) + (wl-summary-buffer-msgdb)))))) (setq entity (wl-folder-search-entity-by-name folder wl-folder-entity 'folder)) @@ -5090,26 +4861,22 @@ If ARG, exit virtual folder." "Reply to current message. Default is \"wide\" reply. Reply to author if invoked with ARG." (interactive "P") - (let ((folder wl-summary-buffer-folder-name) + (let ((folder wl-summary-buffer-elmo-folder) (number (wl-summary-message-number)) (summary-buf (current-buffer)) mes-buf) - (if number - (unwind-protect - (progn - (wl-summary-redisplay-internal folder number) - (wl-select-buffer - (get-buffer (setq mes-buf (wl-current-message-buffer)))) - (set-buffer mes-buf) - (goto-char (point-min)) - (or wl-draft-use-frame - (split-window-vertically)) - (other-window 1) - (when (setq mes-buf (wl-message-get-original-buffer)) - (wl-draft-reply mes-buf arg summary-buf) - (unless without-setup-hook - (run-hooks 'wl-mail-setup-hook))) - t))))) + (when number + (save-excursion + (wl-summary-redisplay-internal folder number)) + (setq mes-buf wl-message-buffer) + (wl-message-select-buffer wl-message-buffer) + (set-buffer mes-buf) + (goto-char (point-min)) + (when (setq mes-buf (wl-message-get-original-buffer)) + (wl-draft-reply mes-buf arg summary-buf) + (unless without-setup-hook + (run-hooks 'wl-mail-setup-hook))) + t))) (defun wl-summary-write () "Write a new draft from Summary." @@ -5132,7 +4899,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (interactive) (let (newsgroups to cc) ;; default FOLDER is current buffer folder - (setq folder (or folder wl-summary-buffer-folder-name)) + (setq folder (or folder (wl-summary-buffer-folder-name))) (let ((flist wl-summary-write-current-folder-functions) guess-list) (while flist @@ -5153,15 +4920,17 @@ Use function list is `wl-summary-write-current-folder-functions'." (defun wl-summary-forward (&optional without-setup-hook) "" (interactive) - (let ((folder wl-summary-buffer-folder-name) + (let ((folder wl-summary-buffer-elmo-folder) (number (wl-summary-message-number)) (summary-buf (current-buffer)) (wl-draft-forward t) + mes-buf entity subject num) (if (null number) (message "No message.") - (wl-summary-redisplay-internal folder number) - (wl-select-buffer (get-buffer wl-message-buf-name)) + (wl-summary-redisplay-internal nil nil 'force-reload) + (setq mes-buf wl-message-buffer) + (wl-message-select-buffer mes-buf) (or wl-draft-use-frame (split-window-vertically)) (other-window 1) @@ -5169,16 +4938,9 @@ Use function list is `wl-summary-write-current-folder-functions'." (if summary-buf (save-excursion (set-buffer summary-buf) - (setq num (wl-summary-message-number)) - (setq entity (assoc (cdr (assq num - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) - (elmo-msgdb-get-overview - wl-summary-buffer-msgdb))) - (and entity - (setq subject - (or (elmo-msgdb-overview-entity-get-subject entity) - ""))))) + (setq subject + (or (elmo-message-field folder number 'subject) "")))) + (set-buffer mes-buf) (wl-draft-forward subject summary-buf) (unless without-setup-hook (run-hooks 'wl-mail-setup-hook))))) @@ -5189,48 +4951,26 @@ Use function list is `wl-summary-write-current-folder-functions'." (wl-summary-read)) (defun wl-summary-read () - "" + "Proceed reading message in the summary buffer." (interactive) - (let ((folder wl-summary-buffer-folder-name) - (number (wl-summary-message-number)) - cur-folder cur-number message-last-pos - (view-message-buffer (get-buffer-create wl-message-buf-name)) - (sticky-buf-name (and (wl-summary-sticky-p) wl-message-buf-name)) - (summary-buf-name (buffer-name))) - (save-excursion - (set-buffer view-message-buffer) - (when (and sticky-buf-name - (not (wl-local-variable-p 'wl-message-buf-name - (current-buffer)))) - (make-local-variable 'wl-message-buf-name) - (setq wl-message-buf-name sticky-buf-name) - (make-local-variable 'wl-message-buffer-cur-summary-buffer) - (setq wl-message-buffer-cur-summary-buffer summary-buf-name)) - (setq cur-folder wl-message-buffer-cur-folder) - (setq cur-number wl-message-buffer-cur-number)) + (let ((cur-buf (current-buffer))) (wl-summary-toggle-disp-msg 'on) - (if (and (string= folder cur-folder) - (eq number cur-number)) - (progn - (if (wl-summary-next-page) - (wl-summary-down t))) -;;; (wl-summary-scroll-up-content))) - (if (wl-summary-no-mime-p folder) - (wl-summary-redisplay-no-mime folder number) - (wl-summary-redisplay-internal folder number))))) + (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original) + (set-buffer cur-buf) + (if (wl-message-next-page) + (wl-summary-down t))))) (defun wl-summary-prev (&optional interactive) "" (interactive) (if wl-summary-move-direction-toggle (setq wl-summary-move-direction-downward nil)) - (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name)) - (skip-mark-regexp (mapconcat + (let ((skip-mark-regexp (mapconcat 'regexp-quote wl-summary-skip-mark-list "")) goto-next regex-list regex next-entity finfo) (beginning-of-line) - (if (elmo-folder-plugged-p wl-summary-buffer-folder-name) + (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder) (setq regex (format "^%s[^%s]" wl-summary-buffer-number-regexp skip-mark-regexp)) @@ -5247,8 +4987,8 @@ Use function list is `wl-summary-write-current-folder-functions'." (if wl-summary-buffer-disp-msg (wl-summary-redisplay))) (if (or interactive (interactive-p)) - (if wl-summary-buffer-prev-folder-func - (funcall wl-summary-buffer-prev-folder-func) + (if wl-summary-buffer-prev-folder-function + (funcall wl-summary-buffer-prev-folder-function) (when wl-auto-select-next (setq next-entity (wl-summary-get-prev-folder)) (if next-entity @@ -5264,13 +5004,12 @@ Use function list is `wl-summary-write-current-folder-functions'." (interactive) (if wl-summary-move-direction-toggle (setq wl-summary-move-direction-downward t)) - (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name)) - (skip-mark-regexp (mapconcat + (let ((skip-mark-regexp (mapconcat 'regexp-quote wl-summary-skip-mark-list "")) goto-next regex regex-list next-entity finfo) (end-of-line) - (if (elmo-folder-plugged-p wl-summary-buffer-folder-name) + (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder) (setq regex (format "^%s[^%s]" wl-summary-buffer-number-regexp skip-mark-regexp)) @@ -5287,8 +5026,8 @@ Use function list is `wl-summary-write-current-folder-functions'." (if wl-summary-buffer-disp-msg (wl-summary-redisplay)) (if (or interactive (interactive-p)) - (if wl-summary-buffer-next-folder-func - (funcall wl-summary-buffer-next-folder-func) + (if wl-summary-buffer-next-folder-function + (funcall wl-summary-buffer-next-folder-function) (when wl-auto-select-next (setq next-entity (wl-summary-get-next-folder)) (if next-entity @@ -5309,8 +5048,8 @@ Use function list is `wl-summary-write-current-folder-functions'." (wl-summary-redisplay)) (if (or interactive (interactive-p)) - (if wl-summary-buffer-prev-folder-func - (funcall wl-summary-buffer-prev-folder-func) + (if wl-summary-buffer-prev-folder-function + (funcall wl-summary-buffer-prev-folder-function) (let (next-entity finfo) (when wl-auto-select-next (progn @@ -5367,8 +5106,8 @@ Use function list is `wl-summary-write-current-folder-functions'." (wl-summary-redisplay)) (if (or interactive (interactive-p)) - (if wl-summary-buffer-next-folder-func - (funcall wl-summary-buffer-next-folder-func) + (if wl-summary-buffer-next-folder-function + (funcall wl-summary-buffer-next-folder-function) (let (next-entity finfo) (when wl-auto-select-next (setq next-entity (wl-summary-get-next-unread-folder))) @@ -5398,19 +5137,17 @@ Use function list is `wl-summary-write-current-folder-functions'." (defun wl-summary-redisplay (&optional arg) (interactive "P") (if (and (not arg) - (wl-summary-no-mime-p wl-summary-buffer-folder-name)) + (wl-summary-no-mime-p wl-summary-buffer-elmo-folder)) (wl-summary-redisplay-no-mime) (wl-summary-redisplay-internal nil nil arg))) (defsubst wl-summary-redisplay-internal (&optional folder number force-reload) (interactive) - (let* ((msgdb wl-summary-buffer-msgdb) - (fld (or folder wl-summary-buffer-folder-name)) + (let* ((msgdb (wl-summary-buffer-msgdb)) + (folder (or folder wl-summary-buffer-elmo-folder)) (num (or number (wl-summary-message-number))) (wl-mime-charset wl-summary-buffer-mime-charset) (default-mime-charset wl-summary-buffer-mime-charset) - (wl-message-redisplay-func - wl-summary-buffer-message-redisplay-func) fld-buf fld-win thr-entity) (if (and wl-thread-open-reading-thread (eq wl-summary-buffer-view 'thread) @@ -5430,44 +5167,42 @@ Use function list is `wl-summary-write-current-folder-functions'." (if (setq fld-win (get-buffer-window fld-buf)) (delete-window fld-win))) (setq wl-current-summary-buffer (current-buffer)) - (if (wl-message-redisplay fld num 'mime msgdb - (or force-reload - ;; if draft folder, force reload. - (string= fld wl-draft-folder))) - (wl-summary-mark-as-read nil - ;; cached, then change server-mark. - (if wl-message-cache-used - nil - ;; plugged, then leave server-mark. - (if (and - (not - (elmo-folder-local-p - wl-summary-buffer-folder-name)) - (elmo-folder-plugged-p - wl-summary-buffer-folder-name)) - 'leave)) - t ; displayed - nil - 'cached ; cached by reading. - ) - ) + (wl-summary-mark-as-read + nil + ;; not fetched, then change server-mark. + (if (wl-message-redisplay folder num 'mime + (or force-reload + (string= (elmo-folder-name-internal + folder) + wl-draft-folder))) + nil + ;; plugged, then leave server-mark. + (if (and + (not + (elmo-folder-local-p + wl-summary-buffer-elmo-folder)) + (elmo-folder-plugged-p + wl-summary-buffer-elmo-folder)) + 'leave)) + t ; displayed + nil + 'cached ; cached by reading. + ) (setq wl-summary-buffer-current-msg num) (when wl-summary-recenter (recenter (/ (- (window-height) 2) 2)) (if (not wl-summary-width) (wl-horizontal-recenter))) (wl-highlight-summary-displaying) - (wl-cache-prefetch-next fld num (current-buffer)) + (wl-message-buffer-prefetch-next folder num (current-buffer) + wl-summary-buffer-mime-charset) (run-hooks 'wl-summary-redisplay-hook)) (message "No message to display.")))) (defun wl-summary-redisplay-no-mime (&optional folder number) (interactive) - (let* ((msgdb wl-summary-buffer-msgdb) - (fld (or folder wl-summary-buffer-folder-name)) + (let* ((fld (or folder wl-summary-buffer-elmo-folder)) (num (or number (wl-summary-message-number))) - (wl-mime-charset wl-summary-buffer-mime-charset) - (default-mime-charset wl-summary-buffer-mime-charset) wl-break-pages) (if num (progn @@ -5475,9 +5210,9 @@ Use function list is `wl-summary-write-current-folder-functions'." (setq wl-summary-buffer-last-displayed-msg wl-summary-buffer-current-msg) (setq wl-current-summary-buffer (current-buffer)) - (wl-normal-message-redisplay fld num 'no-mime msgdb - ;; if draft folder, force reload. - (string= fld wl-draft-folder)) + (wl-message-redisplay fld num 'as-is + (string= (elmo-folder-name-internal fld) + wl-draft-folder)) (wl-summary-mark-as-read nil nil t) (setq wl-summary-buffer-current-msg num) (when wl-summary-recenter @@ -5492,21 +5227,19 @@ Use function list is `wl-summary-write-current-folder-functions'." (defun wl-summary-redisplay-all-header (&optional folder number) (interactive) - (let* ((msgdb wl-summary-buffer-msgdb) - (fld (or folder wl-summary-buffer-folder-name)) + (let* ((fld (or folder wl-summary-buffer-elmo-folder)) (num (or number (wl-summary-message-number))) (wl-mime-charset wl-summary-buffer-mime-charset) - (default-mime-charset wl-summary-buffer-mime-charset) - (wl-message-redisplay-func wl-summary-buffer-message-redisplay-func)) + (default-mime-charset wl-summary-buffer-mime-charset)) (if num (progn (setq wl-summary-buffer-disp-msg t) (setq wl-summary-buffer-last-displayed-msg wl-summary-buffer-current-msg) (setq wl-current-summary-buffer (current-buffer)) - (if (wl-message-redisplay fld num 'all-header msgdb - ;; if draft folder, force reload. - (string= fld wl-draft-folder)) + (if (wl-message-redisplay fld num 'all-header + (string= (elmo-folder-name-internal fld) + wl-draft-folder)) (wl-summary-mark-as-read nil nil t)) (setq wl-summary-buffer-current-msg num) (when wl-summary-recenter @@ -5520,12 +5253,12 @@ Use function list is `wl-summary-write-current-folder-functions'." (defun wl-summary-jump-to-current-message () (interactive) (let (message-buf message-win) - (if (setq message-buf (get-buffer wl-message-buf-name)) + (if (setq message-buf wl-message-buffer) (if (setq message-win (get-buffer-window message-buf)) (select-window message-win) - (wl-select-buffer (get-buffer wl-message-buf-name))) + (wl-message-select-buffer wl-message-buffer)) (wl-summary-redisplay) - (wl-select-buffer (get-buffer wl-message-buf-name))) + (wl-message-select-buffer wl-message-buffer)) (goto-char (point-min)))) (defun wl-summary-cancel-message () @@ -5540,7 +5273,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (set-buffer message-buf)) (unless (wl-message-news-p) (set-buffer summary-buf) - (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) + (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) 'nntp) (y-or-n-p "Cannot get Newsgroups. Fetch again? ")) (progn @@ -5589,7 +5322,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (set-buffer message-buf)) (unless (wl-message-news-p) (set-buffer summary-buf) - (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) + (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) 'nntp) (y-or-n-p "Cannot get Newsgroups. Fetch again? ")) (progn @@ -5610,7 +5343,7 @@ Use function list is `wl-summary-write-current-folder-functions'." "Supersedes: " message-id "\n" (and followup-to (concat "Followup-To: " followup-to "\n"))))) - (set-buffer (wl-message-get-original-buffer)) + (if message-buf (set-buffer message-buf)) (wl-draft-edit-string (buffer-substring (point-min) (point-max))))))) (defun wl-summary-save (&optional arg wl-save-dir) @@ -5692,13 +5425,10 @@ Use function list is `wl-summary-write-current-folder-functions'." (if (or (not (interactive-p)) (y-or-n-p "Print ok? ")) (progn - (let* ((message-buffer (get-buffer wl-message-buf-name)) -;;; (summary-buffer (get-buffer wl-summary-buffer-name)) - (buffer (generate-new-buffer " *print*"))) - (set-buffer message-buffer) + (let ((buffer (generate-new-buffer " *print*"))) (copy-to-buffer buffer (point-min) (point-max)) (set-buffer buffer) - (funcall wl-print-buffer-func) + (funcall wl-print-buffer-function) (kill-buffer buffer))) (message ""))))) @@ -5712,18 +5442,17 @@ Use function list is `wl-summary-write-current-folder-functions'." (let ((summary-buffer (current-buffer)) wl-break-pages) (save-excursion -;;; (wl-summary-set-message-buffer-or-redisplay) - (wl-summary-redisplay-internal) - (let* ((message-buffer (get-buffer wl-message-buf-name)) - (buffer (generate-new-buffer " *print*")) + (wl-summary-set-message-buffer-or-redisplay) + ;; (wl-summary-redisplay-internal) + (let* ((buffer (generate-new-buffer " *print*")) (entity (progn (set-buffer summary-buffer) (assoc (cdr (assq (wl-summary-message-number) (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) (elmo-msgdb-get-overview - wl-summary-buffer-msgdb)))) + (wl-summary-buffer-msgdb))))) (wl-ps-subject (and entity (or (elmo-msgdb-overview-entity-get-subject entity) @@ -5735,7 +5464,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (and entity (or (elmo-msgdb-overview-entity-get-date entity) "")))) (run-hooks 'wl-ps-preprint-hook) - (set-buffer message-buffer) + (set-buffer wl-message-buffer) (copy-to-buffer buffer (point-min) (point-max)) (set-buffer buffer) (unwind-protect @@ -5746,7 +5475,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (list "/pagenumberstring load" (concat "(" wl-ps-date ")")))) (run-hooks 'wl-ps-print-hook) - (funcall wl-ps-print-buffer-func filename)) + (funcall wl-ps-print-buffer-function filename)) (kill-buffer buffer))))) (message "")))) @@ -5754,119 +5483,24 @@ Use function list is `wl-summary-write-current-folder-functions'." (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print)) (defun wl-summary-folder-info-update () - (let ((folder (elmo-string wl-summary-buffer-folder-name)) + (let ((folder (elmo-string (wl-summary-buffer-folder-name))) (num-db (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) + (wl-summary-buffer-msgdb)))) (wl-folder-set-folder-updated folder (list 0 (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count) (length num-db))))) -(defun wl-summary-get-newsgroups () - (let ((spec-list (elmo-folder-get-primitive-spec-list - (elmo-string wl-summary-buffer-folder-name))) - ng-list) - (while spec-list - (when (eq (caar spec-list) 'nntp) - (wl-append ng-list (list (nth 1 (car spec-list))))) - (setq spec-list (cdr spec-list))) - ng-list)) - -(defun wl-summary-set-crosspost (&optional type redisplay) - (let* ((number (wl-summary-message-number)) - (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name - number)) - (folder (nth 1 spec)) - message-buf newsgroups) - (when (eq (car spec) 'nntp) - (if redisplay - (wl-summary-redisplay)) - (save-excursion - (if (setq message-buf (wl-message-get-original-buffer)) - (set-buffer message-buf)) - (setq newsgroups (std11-field-body "newsgroups"))) - (when newsgroups - (let* ((msgdb wl-summary-buffer-msgdb) - (num-db (elmo-msgdb-get-number-alist msgdb)) - (ng-list (wl-summary-get-newsgroups)) ;; for multi folder - crosspost-folders) - (when (setq crosspost-folders - (elmo-list-delete ng-list - (wl-parse-newsgroups newsgroups t))) - (elmo-crosspost-message-set (cdr (assq number num-db)) ;;message-id - crosspost-folders - type) ;;not used - (setq wl-crosspost-alist-modified t))))))) - -(defun wl-summary-is-crosspost-folder (spec-list fld-list) - (let (fld flds) - (while spec-list - (if (and (eq (caar spec-list) 'nntp) - (member (setq fld (nth 1 (car spec-list))) fld-list)) - (wl-append flds (list fld))) - (setq spec-list (cdr spec-list))) - flds)) - -(defun wl-summary-update-crosspost () - (let* ((msgdb wl-summary-buffer-msgdb) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - (spec-list (elmo-folder-get-primitive-spec-list - (elmo-string wl-summary-buffer-folder-name))) - (alist elmo-crosspost-message-alist) - (crossed 0) - mark ngs num) - (when (assq 'nntp spec-list) - (while alist - (when (setq ngs - (wl-summary-is-crosspost-folder - spec-list - (nth 1 (car alist)))) - (when (setq num (car (rassoc (caar alist) number-alist))) - (if (and (setq mark (cadr (assq num mark-alist))) - (member mark (list wl-summary-new-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark))) - (setq crossed (1+ crossed))) - (if (wl-summary-jump-to-msg num) - (wl-summary-mark-as-read t);; opened - (wl-summary-mark-as-read t nil nil num)));; closed - ;; delete if message does't exists. - (elmo-crosspost-message-delete (caar alist) ngs) - (setq wl-crosspost-alist-modified t)) - (setq alist (cdr alist)))) - (if (> crossed 0) - crossed))) - -(defun wl-crosspost-alist-load () - (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load)) - (setq wl-crosspost-alist-modified nil)) - -(defun wl-crosspost-alist-save () - (when wl-crosspost-alist-modified - ;; delete non-exists newsgroups - (let ((alist elmo-crosspost-message-alist) - newsgroups) - (while alist - (setq newsgroups - (elmo-delete-if - '(lambda (x) - (not (intern-soft x wl-folder-newsgroups-hashtb))) - (nth 1 (car alist)))) - (if newsgroups - (setcar (cdar alist) newsgroups) - (setq elmo-crosspost-message-alist - (delete (car alist) elmo-crosspost-message-alist))) - (setq alist (cdr alist))) - (elmo-crosspost-alist-save elmo-crosspost-message-alist) - (setq wl-crosspost-alist-modified nil)))) +(defun wl-summary-get-original-buffer () + "Get original buffer for the current summary." + (save-excursion + (wl-summary-set-message-buffer-or-redisplay) + (wl-message-get-original-buffer))) (defun wl-summary-pack-number (&optional arg) (interactive "P") - (setq wl-summary-buffer-msgdb - (elmo-pack-number - wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg)) + (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder) (let (wl-use-scoring) (wl-summary-rescan))) @@ -5885,7 +5519,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (set-buffer summary-buf) (wl-summary-jump-to-msg (car mlist)) (wl-summary-redisplay) - (set-buffer (setq orig-buf (wl-message-get-original-buffer))) + (set-buffer (setq orig-buf (wl-summary-get-original-buffer))) (goto-char (point-min)) (cond ((= i 1) ; first (if (setq filename (wl-message-uu-substring @@ -5938,40 +5572,41 @@ Use function list is `wl-summary-write-current-folder-functions'." (message "Saved as %s" filename))) (kill-buffer tmp-buf))))) -(defun wl-summary-drop-unsync () - "Drop all unsync messages." - (interactive) - (if (elmo-folder-pipe-p wl-summary-buffer-folder-name) - (error "You cannot drop unsync messages in this folder")) - (if (or (not (interactive-p)) - (y-or-n-p "Drop all unsync messages? ")) - (let* ((folder-list (elmo-folder-get-primitive-folder-list - wl-summary-buffer-folder-name)) - (is-multi (elmo-multi-p wl-summary-buffer-folder-name)) - (sum 0) - (multi-num 0) - pair) - (message "Dropping...") - (while folder-list - (setq pair (elmo-max-of-folder (car folder-list))) - (when is-multi ;; dirty hack... - (incf multi-num) - (setcar pair (+ (* multi-num elmo-multi-divide-number) - (car pair)))) - (elmo-msgdb-set-number-alist - wl-summary-buffer-msgdb - (nconc - (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb) - (list (cons (car pair) nil)))) - (setq sum (+ sum (cdr pair))) - (setq folder-list (cdr folder-list))) - (wl-summary-set-message-modified) - (wl-folder-set-folder-updated wl-summary-buffer-folder-name - (list 0 - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count) - sum)) - (message "Dropping...done")))) +;; Someday +;; (defun wl-summary-drop-unsync () +;; "Drop all unsync messages." +;; (interactive) +;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name)) +;; (error "You cannot drop unsync messages in this folder")) +;; (if (or (not (interactive-p)) +;; (y-or-n-p "Drop all unsync messages? ")) +;; (let* ((folder-list (elmo-folder-get-primitive-folder-list +;; (wl-summary-buffer-folder-name))) +;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name))) +;; (sum 0) +;; (multi-num 0) +;; pair) +;; (message "Dropping...") +;; (while folder-list +;; (setq pair (elmo-folder-message-numbers (car folder-list))) +;; (when is-multi ;; dirty hack... +;; (incf multi-num) +;; (setcar pair (+ (* multi-num elmo-multi-divide-number) +;; (car pair)))) +;; (elmo-msgdb-set-number-alist +;; (wl-summary-buffer-msgdb) +;; (nconc +;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)) +;; (list (cons (car pair) nil)))) +;; (setq sum (+ sum (cdr pair))) +;; (setq folder-list (cdr folder-list))) +;; (wl-summary-set-message-modified) +;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) +;; (list 0 +;; (+ wl-summary-buffer-unread-count +;; wl-summary-buffer-new-count) +;; sum)) +;; (message "Dropping...done")))) (defun wl-summary-default-get-next-msg (msg) (or (wl-summary-next-message msg @@ -5982,71 +5617,6 @@ Use function list is `wl-summary-write-current-folder-functions'." wl-summary-buffer-number-list (reverse wl-summary-buffer-number-list)))))) -(defsubst wl-cache-prefetch-p (fld &optional num) - (cond ((and num wl-cache-prefetch-folder-type-list) - (memq - (elmo-folder-number-get-type fld num) - wl-cache-prefetch-folder-type-list)) - (wl-cache-prefetch-folder-type-list - (let ((list wl-cache-prefetch-folder-type-list) - type) - (catch 'done - (while (setq type (pop list)) - (if (elmo-folder-contains-type fld type) - (throw 'done t)))))) - ((consp wl-cache-prefetch-folder-list) - (wl-string-match-member fld wl-cache-prefetch-folder-list)) - (t - wl-cache-prefetch-folder-list))) - -(defconst wl-cache-prefetch-idle-time - (if (featurep 'lisp-float-type) (/ (float 1) (float 10)) 1)) - -(defun wl-cache-prefetch-next (fld msg &optional summary) - (if (wl-cache-prefetch-p fld) - (if elmo-use-buffer-cache -;;; (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.") - (save-excursion - (set-buffer (or summary (get-buffer wl-summary-buffer-name))) - (let ((next (funcall wl-cache-prefetch-get-next-func msg))) - (when (and next - (wl-cache-prefetch-p fld next)) - (if (not (fboundp 'run-with-idle-timer)) - (when (sit-for wl-cache-prefetch-idle-time) - (wl-cache-prefetch-message fld next summary)) - (run-with-idle-timer - wl-cache-prefetch-idle-time - nil - 'wl-cache-prefetch-message fld next summary) - (sit-for 0)))))))) - -(defvar wl-cache-prefetch-debug nil) -(defun wl-cache-prefetch-message (folder msg summary &optional next) - (when (buffer-live-p summary) - (save-excursion - (set-buffer summary) - (when (string= folder wl-summary-buffer-folder-name) - (unless next - (setq next msg)) - (let* ((msgdb wl-summary-buffer-msgdb) - (message-id (cdr (assq next - (elmo-msgdb-get-number-alist msgdb))))) - (if (not (elmo-buffer-cache-hit (list folder next message-id))) - (let* ((size (elmo-msgdb-overview-entity-get-size - (assoc message-id - (elmo-msgdb-get-overview msgdb))))) - (when (or (elmo-local-file-p folder next) - (not (and (integerp size) - wl-cache-prefetch-threshold - (>= size wl-cache-prefetch-threshold) - (not (elmo-cache-exists-p message-id - folder next))))) - (if wl-cache-prefetch-debug - (message "Reading %d..." msg)) - (elmo-buffer-cache-message folder next msgdb nil 'unread) - (if wl-cache-prefetch-debug - (message "Reading %d... done" msg)))))))))) - (defun wl-summary-save-current-message () "Save current message for `wl-summary-yank-saved-message'." (interactive) diff --git a/wl/wl-template.el b/wl/wl-template.el index ca8a42d..0129e5a 100644 --- a/wl/wl-template.el +++ b/wl/wl-template.el @@ -134,10 +134,9 @@ ARG is ignored." ; ARG ignored this version (?) (setq wl-template (car (nth wl-template-cur-num wl-template-alist))) mail-header-separator) (wl-highlight-message (point-min) (point-max) t) - (and wl-highlight-x-face-func - (funcall - wl-highlight-x-face-func - (point-min) (re-search-forward mail-header-separator nil t))) + (when wl-highlight-x-face-function + (funcall wl-highlight-x-face-function + (point-min) (re-search-forward mail-header-separator nil t))) (setq mode-line-process (concat ":" wl-template)) (set-buffer-modified-p nil)))) diff --git a/wl/wl-thread.el b/wl/wl-thread.el index da99f95..eb52fd9 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -58,11 +58,11 @@ (let (entities top-list) (setq entities (wl-summary-load-file-object (expand-file-name wl-thread-entity-file - (elmo-msgdb-expand-path fld)))) + (elmo-folder-msgdb-path fld)))) (setq top-list (wl-summary-load-file-object (expand-file-name wl-thread-entity-list-file - (elmo-msgdb-expand-path fld)))) + (elmo-folder-msgdb-path fld)))) (message "Resuming thread structure...") ;; set obarray value. (setq wl-thread-entity-hashtb (elmo-make-hash (* (length entities) 2))) @@ -349,11 +349,12 @@ ENTITY is returned." (cur 0) entity) (while (not (eobp)) - (unless (wl-thread-entity-get-opened - (setq entity (wl-thread-get-entity - (wl-summary-message-number)))) - (wl-thread-entity-force-open entity)) - (wl-thread-goto-bottom-of-sub-thread) + (if (wl-thread-entity-get-opened + (setq entity (wl-thread-get-entity + (wl-summary-message-number)))) + (forward-line 1) + (wl-thread-force-open) + (wl-thread-goto-bottom-of-sub-thread)) (when (> len elmo-display-progress-threshold) (setq cur (1+ cur)) (elmo-display-progress @@ -367,7 +368,7 @@ ENTITY is returned." (defun wl-thread-open-all-unread () (interactive) - (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (let ((mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) mark) (while mark-alist (if (setq mark (nth 1 (car mark-alist))) @@ -387,8 +388,8 @@ ENTITY is returned." (defsubst wl-thread-update-line-on-buffer-sub (entity msg &optional parent-msg) (let* ((entity (or entity (wl-thread-get-entity msg))) (parent-msg (or parent-msg (wl-thread-entity-get-parent entity))) - (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (overview (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))) + (mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (buffer-read-only nil) (inhibit-read-only t) overview-entity temp-mark summary-line invisible-top dest-pair) @@ -406,13 +407,13 @@ ENTITY is returned." (t (setq temp-mark (wl-summary-get-score-mark msg)))) (when (setq overview-entity (elmo-msgdb-overview-get-entity - msg wl-summary-buffer-msgdb)) + msg (wl-summary-buffer-msgdb))) (setq summary-line (wl-summary-overview-create-summary-line msg overview-entity (elmo-msgdb-overview-get-entity - parent-msg wl-summary-buffer-msgdb) + parent-msg (wl-summary-buffer-msgdb)) nil mark-alist (if wl-thread-insert-force-opened @@ -428,13 +429,13 @@ ENTITY is returned." (if (not (setq invisible-top (wl-thread-entity-parent-invisible-p entity))) (wl-summary-update-thread - (elmo-msgdb-overview-get-entity msg wl-summary-buffer-msgdb) + (elmo-msgdb-overview-get-entity msg (wl-summary-buffer-msgdb)) overview mark-alist entity (and parent-msg (elmo-msgdb-overview-get-entity - parent-msg wl-summary-buffer-msgdb))) + parent-msg (wl-summary-buffer-msgdb)))) ;; currently invisible.. update closed line. (wl-thread-update-children-number invisible-top))))) @@ -517,7 +518,7 @@ ENTITY is returned." (while msgs (setq children (wl-thread-entity-get-children (setq entity (wl-thread-get-entity (car msgs))))) - (when (elmo-msgdb-overview-get-entity (car msgs) wl-summary-buffer-msgdb) + (when (elmo-msgdb-overview-get-entity (car msgs) (wl-summary-buffer-msgdb)) (wl-append ret-val (list (car msgs))) (setq children nil)) (setq msgs (cdr msgs)) @@ -687,7 +688,7 @@ Message is inserted to the summary buffer." mark-alist child-entity (elmo-msgdb-overview-get-entity - parent-msg wl-summary-buffer-msgdb)) + parent-msg (wl-summary-buffer-msgdb))) (when parent ;; use thread structure. (wl-thread-entity-get-nearly-older-brother @@ -788,7 +789,7 @@ Message is inserted to the summary buffer." (defun wl-thread-msg-mark-as-important (msg) "Set mark as important for invisible MSG. Modeline is not changed." - (let* ((msgdb wl-summary-buffer-msgdb) + (let* ((msgdb (wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist msgdb)) cur-mark) (setq cur-mark (cadr (assq msg mark-alist))) @@ -894,7 +895,7 @@ Message is inserted to the summary buffer." (/ (* cur 100) len))))))) (defsubst wl-thread-insert-entity-sub (indent entity parent-entity all) - (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (let ((mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) msg-num overview-entity temp-mark @@ -913,7 +914,7 @@ Message is inserted to the summary buffer." (setq temp-mark (wl-summary-get-score-mark msg-num))) (setq overview-entity (elmo-msgdb-overview-get-entity - (nth 0 entity) wl-summary-buffer-msgdb)) + (nth 0 entity) (wl-summary-buffer-msgdb))) ;;; (wl-delete-all-overlays) (when overview-entity (setq summary-line @@ -921,7 +922,7 @@ Message is inserted to the summary buffer." msg-num overview-entity (elmo-msgdb-overview-get-entity - (nth 0 parent-entity) wl-summary-buffer-msgdb) + (nth 0 parent-entity) (wl-summary-buffer-msgdb)) (1+ indent) mark-alist (if wl-thread-insert-force-opened @@ -1034,8 +1035,8 @@ Message is inserted to the summary buffer." (defun wl-thread-get-children-msgs-uncached (msg &optional uncached-marks) (let ((children-msgs (wl-thread-get-children-msgs msg)) - (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) + (mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) + (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) mark uncached-list) (while children-msgs @@ -1045,9 +1046,11 @@ Message is inserted to the summary buffer." mark-alist))) (member mark uncached-marks)) (and (not uncached-marks) - (null (elmo-cache-exists-p - (cdr (assq (car children-msgs) - number-alist))))))) + (null (elmo-file-cache-exists-p + (elmo-message-field + wl-summary-buffer-elmo-folder + (car children-msgs) + 'message-id)))))) (wl-append uncached-list (list (car children-msgs)))) (setq children-msgs (cdr children-msgs))) uncached-list)) diff --git a/wl/wl-util.el b/wl/wl-util.el index d949fe1..f8c94a2 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -57,14 +57,8 @@ (list 'nconc val func) (list 'setq val func))) -(defun wl-parse (string regexp &optional matchn) - (or matchn (setq matchn 1)) - (let (list) - (store-match-data nil) - (while (string-match regexp string (match-end 0)) - (setq list (cons (substring string (match-beginning matchn) - (match-end matchn)) list))) - (nreverse list))) +(defalias 'wl-parse 'elmo-parse) +(make-obsolete 'wl-parse 'elmo-parse) (defun wl-delete-duplicates (list &optional all hack-addresses) "Delete duplicate equivalent strings from the LIST. @@ -303,17 +297,6 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses, (defalias 'wl-string 'elmo-string) (make-obsolete 'wl-string 'elmo-string) -(defun wl-parse-newsgroups (string &optional subscribe-only) - (let* ((nglist (wl-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")) - ret-val) - (if (not subscribe-only) - nglist - (while nglist - (if (intern-soft (car nglist) wl-folder-newsgroups-hashtb) - (wl-append ret-val (list (car nglist)))) - (setq nglist (cdr nglist))) - ret-val))) - ;; Check if active region exists or not. (if (boundp 'mark-active) (defmacro wl-region-exists-p () @@ -529,10 +512,10 @@ that `read' can handle, whenever this is possible." (setq fld-name nil)) (if (eq (length (setq port (elmo-match-string 2 url))) 0) - (setq port (int-to-string elmo-default-nntp-port))) + (setq port (int-to-string elmo-nntp-default-port))) (if (eq (length (setq server (elmo-match-string 1 url))) 0) - (setq server elmo-default-nntp-server)) + (setq server elmo-nntp-default-server)) (setq folder (concat "-" fld-name "@" server ":" port)) (if (eq (length (setq msg (elmo-match-string 4 url))) 0) @@ -552,7 +535,7 @@ that `read' can handle, whenever this is possible." (` (save-excursion (if (buffer-live-p wl-current-summary-buffer) (set-buffer wl-current-summary-buffer)) - wl-message-buf-name))) + wl-message-buffer))) (defmacro wl-kill-buffers (regexp) (` (mapcar (function @@ -662,15 +645,15 @@ that `read' can handle, whenever this is possible." ">")) ;;; Profile loading. -(defvar wl-load-profile-func 'wl-local-load-profile) +(defvar wl-load-profile-function 'wl-local-load-profile) (defun wl-local-load-profile () "Load `wl-init-file'." (message "Initializing ...") (load wl-init-file 'noerror 'nomessage)) (defun wl-load-profile () - "Call `wl-load-profile-func' function." - (funcall wl-load-profile-func)) + "Call `wl-load-profile-function' function." + (funcall wl-load-profile-function)) ;;; @@ -829,10 +812,11 @@ This function is imported from Emacs 20.7." (flist (or wl-biff-check-folder-list (list wl-default-folder))) folder) (if (eq (length flist) 1) - (wl-biff-check-folder-async (car flist) (interactive-p)) + (wl-biff-check-folder-async (wl-folder-get-elmo-folder + (car flist)) (interactive-p)) (unwind-protect (while flist - (setq folder (car flist) + (setq folder (wl-folder-get-elmo-folder (car flist)) flist (cdr flist)) (when (elmo-folder-plugged-p folder) (setq new-mails @@ -842,19 +826,20 @@ This function is imported from Emacs 20.7." (wl-biff-notify new-mails (interactive-p))))))) (defun wl-biff-check-folder (folder) - (if (eq (elmo-folder-get-type folder) 'pop3) + (if (eq (elmo-folder-type folder) 'pop3) ;; pop3 biff should share the session. (prog2 - (elmo-commit folder) ; Close session. - (wl-folder-check-one-entity folder) - (elmo-commit folder)) + (elmo-folder-check folder) + (wl-folder-check-one-entity (elmo-folder-name-internal folder)) + (elmo-folder-close folder)) (let ((elmo-network-session-name-prefix "BIFF-")) - (wl-folder-check-one-entity folder)))) + (wl-folder-check-one-entity (elmo-folder-name-internal folder))))) (defun wl-biff-check-folder-async-callback (diff data) (if (nth 1 data) (with-current-buffer (nth 1 data) - (wl-folder-entity-hashtb-set wl-folder-entity-hashtb (nth 0 data) + (wl-folder-entity-hashtb-set wl-folder-entity-hashtb + (nth 0 data) (list (car diff) 0 (cdr diff)) (current-buffer)))) (setq wl-folder-info-alist-modified t) @@ -864,21 +849,21 @@ This function is imported from Emacs 20.7." (defun wl-biff-check-folder-async (folder notify-minibuf) (when (elmo-folder-plugged-p folder) - (let ((type (elmo-folder-get-type folder))) - (if (and (eq type 'imap4) - (wl-folder-use-server-diff-p folder)) - ;; Check asynchronously only when IMAP4 and use server diff. - (progn - (setq elmo-folder-diff-async-callback - 'wl-biff-check-folder-async-callback) - (setq elmo-folder-diff-async-callback-data - (list folder (get-buffer wl-folder-buffer-name) - notify-minibuf)) - (let ((elmo-network-session-name-prefix "BIFF-")) - (elmo-folder-diff-async folder))) - (wl-biff-notify (car (wl-biff-check-folder folder)) - notify-minibuf) - (setq wl-biff-check-folders-running nil))))) + (if (and (eq (elmo-folder-type-internal folder) 'imap4) + (elmo-folder-use-flag-p folder)) + ;; Check asynchronously only when IMAP4 and use server diff. + (progn + (setq elmo-folder-diff-async-callback + 'wl-biff-check-folder-async-callback) + (setq elmo-folder-diff-async-callback-data + (list (elmo-folder-name-internal folder) + (get-buffer wl-folder-buffer-name) + notify-minibuf)) + (let ((elmo-network-session-name-prefix "BIFF-")) + (elmo-folder-diff-async folder))) + (wl-biff-notify (car (wl-biff-check-folder folder)) + notify-minibuf) + (setq wl-biff-check-folders-running nil)))) (if (and (fboundp 'regexp-opt) (not (featurep 'xemacs))) @@ -892,6 +877,39 @@ is enclosed by at least one regexp grouping construct." (concat open-paren (mapconcat 'regexp-quote strings "\\|") close-paren)))) +(defun wl-expand-newtext (newtext original) + (let ((len (length newtext)) + (pos 0) + c expanded beg N did-expand) + (while (< pos len) + (setq beg pos) + (while (and (< pos len) + (not (= (aref newtext pos) ?\\))) + (setq pos (1+ pos))) + (unless (= beg pos) + (push (substring newtext beg pos) expanded)) + (when (< pos len) + ;; We hit a \; expand it. + (setq did-expand t + pos (1+ pos) + c (aref newtext pos)) + (if (not (or (= c ?\&) + (and (>= c ?1) + (<= c ?9)))) + ;; \ followed by some character we don't expand. + (push (char-to-string c) expanded) + ;; \& or \N + (if (= c ?\&) + (setq N 0) + (setq N (- c ?0))) + (when (match-beginning N) + (push (substring original (match-beginning N) (match-end N)) + expanded)))) + (setq pos (1+ pos))) + (if did-expand + (apply (function concat) (nreverse expanded)) + newtext))) + (require 'product) (product-provide (provide 'wl-util) (require 'wl-version)) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 49e8850..64bf9a4 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -32,6 +32,7 @@ ;; (require 'elmo-vars) +(require 'elmo-util) (if (module-installed-p 'custom) (require 'custom)) @@ -163,17 +164,17 @@ If you don't have multiple e-mail addresses, you don't have to set this." string) :group 'wl) -(defcustom wl-summary-from-func 'wl-summary-default-from +(defcustom wl-summary-from-function 'wl-summary-default-from "*A function for displaying sender (From: field) information." :type 'function :group 'wl-summary) -(defcustom wl-summary-subject-func 'wl-summary-default-subject +(defcustom wl-summary-subject-function 'wl-summary-default-subject "*A function for displaying subject." :type 'function :group 'wl-summary) -(defcustom wl-summary-subject-filter-func 'wl-summary-default-subject-filter +(defcustom wl-summary-subject-filter-function 'wl-summary-default-subject-filter "*A filter function for comparing subjects." :type 'function :group 'wl-summary) @@ -301,36 +302,36 @@ If nil, don't authenticate." (defcustom wl-pop-before-smtp-user nil "*POP3 user name to send mail using POP-before-SMTP. -If nil, `elmo-default-pop3-user' is used. +If nil, `elmo-pop3-default-user' is used. To use POP-before-SMTP, -(setq wl-draft-send-mail-func 'wl-draft-send-mail-with-pop-before-smtp)" +(setq wl-draft-send-mail-function 'wl-draft-send-mail-with-pop-before-smtp)" :type '(choice (const :tag "none" nil) string) :group 'wl) (defcustom wl-pop-before-smtp-server nil "*POP3 server for POP-before-SMTP. -If nil, `elmo-default-pop3-server' is used." +If nil, `elmo-pop3-default-server' is used." :type '(choice (const :tag "none" nil) string) :group 'wl) (defcustom wl-pop-before-smtp-port nil "*POP3 port for POP-before-SMTP. -If nil, `elmo-default-pop3-port' is used." +If nil, `elmo-pop3-default-port' is used." :type '(choice (const :tag "none" nil) integer string) :group 'wl) (defcustom wl-pop-before-smtp-stream-type nil "*Stream type for POP-before-SMTP. -If nil, `elmo-default-pop3-stream-type' is used." +If nil, `elmo-pop3-default-stream-type' is used." :type 'boolean :group 'wl) (defcustom wl-pop-before-smtp-authenticate-type nil "*Default Authentication type for POP-before-SMTP. -If nil, `elmo-default-pop3-authenticate-type' is used." +If nil, `elmo-pop3-default-authenticate-type' is used." :type '(choice (const :tag "none" nil) (const :tag "APOP" "apop") (const :tag "POP3" "user")) @@ -338,26 +339,26 @@ If nil, `elmo-default-pop3-authenticate-type' is used." (defcustom wl-nntp-posting-server nil "*NNTP server name to post news. -If nil, `elmo-default-nntp-server' is used." +If nil, `elmo-nntp-default-server' is used." :type '(choice (const :tag "none" nil) string) :group 'wl) (defcustom wl-nntp-posting-user nil "*NNTP user name to post news for authinfo. -If nil, `elmo-default-nntp-user' is used. +If nil, `elmo-nntp-default-user' is used. If nil, don't authenticate." :type '(choice (const :tag "none" nil) string) :group 'wl) (defcustom wl-nntp-posting-port nil "*NNTP port to post news. -If nil, `elmo-default-nntp-port' is used." +If nil, `elmo-nntp-default-port' is used." :type '(choice (const :tag "none" nil) integer string) :group 'wl) (defcustom wl-nntp-posting-stream-type nil "*Stream type for posting Netnews. -If nil, `elmo-default-nntp-stream-type' is used." +If nil, `elmo-nntp-default-stream-type' is used." :type 'boolean :group 'wl) @@ -456,6 +457,8 @@ reasons of system internal to accord facilities for the Emacs variants.") "A hook called when Message is displayed.") (defvar wl-message-exit-hook nil "A hook called when quit message.") +(defvar wl-summary-exit-pre-hook nil + "A hook called before exit summary mode.") (defvar wl-summary-exit-hook nil "A hook called when exit summary mode.") (defvar wl-highlight-headers-hook nil @@ -508,22 +511,24 @@ reasons of system internal to accord facilities for the Emacs variants.") "A hook called when score mode is started.") (defvar wl-make-plugged-hook nil "A hook called when make plugged alist.") +(defvar wl-biff-notify-hook '(beep) + "A hook called when a biff-notification is invoked.") (defvar wl-plugged-exit-hook nil "A hook called when exit plugged mode.") ;;;; functions for draft -(defcustom wl-draft-send-func 'wl-draft-normal-send-func +(defcustom wl-draft-send-function 'wl-draft-normal-send-func "A function to send message." :type 'function :group 'wl-draft) -(defcustom wl-draft-send-news-func 'wl-draft-elmo-nntp-send +(defcustom wl-draft-send-news-function 'wl-draft-elmo-nntp-send "A function to send news." :type 'function :group 'wl-draft) -(defcustom wl-draft-send-mail-func 'wl-draft-send-mail-with-smtp +(defcustom wl-draft-send-mail-function 'wl-draft-send-mail-with-smtp "A function to send mail. Prepared candidates are 'wl-draft-send-mail-with-smtp, 'wl-draft-send-mail-with-qmail and 'wl-draft-send-mail-with-pop-before-smtp." @@ -1048,12 +1053,12 @@ Available if only `wl-summary-lazy-highlight' is nil." :type 'file :group 'wl-summary) -(defcustom wl-print-buffer-func 'lpr-buffer +(defcustom wl-print-buffer-function 'lpr-buffer "A function to print current buffer." :type 'function :group 'wl-pref) -(defcustom wl-ps-print-buffer-func +(defcustom wl-ps-print-buffer-function (if window-system 'ps-print-buffer-with-faces 'ps-print-buffer) "A function to print current buffer with ps-print." :type 'function @@ -1273,7 +1278,7 @@ with wl-highlight-folder-many-face." :group 'wl-summary :group 'wl-pref) -(defcustom wl-generate-mailer-string-func 'wl-generate-user-agent-string +(defcustom wl-generate-mailer-string-function 'wl-generate-user-agent-string "A function to create X-Mailer field string ." :type 'function :group 'wl-draft) @@ -1286,7 +1291,7 @@ with wl-highlight-folder-many-face." (const light)) :group 'wl-highlight) -(defcustom wl-highlight-x-face-func nil +(defcustom wl-highlight-x-face-function nil "A function to display X-Face." :type 'function :group 'wl-highlight) @@ -1535,16 +1540,6 @@ e.x. :type '(repeat (regexp :tag "Folder Regexp")) :group 'wl-pref) -(defcustom wl-cache-prefetch-get-next-func 'wl-summary-default-get-next-msg - "*A function to get message number when prefetch next message." - :type 'function - :group 'wl-pref) - -;; obsolete -;(defvar wl-no-cache-folder-list '("^\\$.*") -; "All folders that match this list won't be cached when reading messages. -;Each elements are regexp of folder name.") - (defcustom wl-summary-always-sticky-folder-list nil "All folders that match this list has sticky summary. Each elements are regexp of folder name." @@ -1553,7 +1548,7 @@ Each elements are regexp of folder name." (repeat (regexp :tag "Folder Regexp"))) :group 'wl-pref) -(defcustom wl-no-save-folder-list '("^/.*$") +(defcustom wl-no-save-folder-list '("^/.*$" "^\\[.*$") "All folders that match this list won't save its msgdb. Each elements are regexp of folder name." :type '(repeat (regexp :tag "Folder Regexp")) @@ -1569,7 +1564,8 @@ Each elements are regexp of folder name." '(("^-alt\\.chinese" . big5) ("^-relcom\\." . koi8-r) ("^-tw\\." . big5) - ("^-han\\." . euc-kr)) + ("^-han\\." . euc-kr) + ("@sponichi" . shift_jis)) "Charset alist. If no match, `wl-mime-charset' is used." :type '(repeat (cons (regexp :tag "Folder Regexp") (symbol :tag "Charset"))) :group 'wl-summary @@ -1649,6 +1645,19 @@ If nil, always use default." :type 'boolean :group 'wl-pref) +(defcustom wl-folder-process-duplicates-alist nil + "Specify process type of duplicated messages. +It should be a list of cons cell like: (REGEXP . TYPE) +REGEXP is a regular expression string of folder name. +TYPE is one of the symbols `hide' or `read'. +`hide' means hide duplicated messages. +`read' means mark as read duplicated messages. +If TYPE is nil, do nothing for duplicated messages." + :type '(repeat (cons (regexp :tag "Folder regexp") + (choice (const :tag "Hide" kill) + (const :tag "Mark as read" read)))) + :group 'wl-folder) + (defcustom wl-folder-move-cur-folder nil "*Non-nil, move to current folder on folder-mode when goto folder." :type 'boolean @@ -1793,7 +1802,7 @@ ex. :type 'string :group 'wl-folder) -(defcustom wl-fldmgr-sort-func 'wl-fldmgr-sort-standard +(defcustom wl-fldmgr-sort-function 'wl-fldmgr-sort-standard "*A function to sort folder." :type 'function :group 'wl-folder) @@ -1919,7 +1928,7 @@ list : reserved specified permanent marks." :group 'wl-expire) ;; for wl-expire-archive-{number1|number2|date} -(defcustom wl-expire-archive-get-folder-func +(defcustom wl-expire-archive-get-folder-function 'wl-expire-archive-get-folder "*A function to get archive folder name." :type 'function @@ -2096,7 +2105,7 @@ If it is a number, only numbers will be highlighted." (const :tag "don't highlight" nil)) :group 'wl-highlight) -(defcustom wl-highlight-signature-search-func 'wl-highlight-signature-search +(defcustom wl-highlight-signature-search-function 'wl-highlight-signature-search "Function to search signature area in the message body." :type 'function :group 'wl-highlight) @@ -2183,6 +2192,10 @@ a symbol `bitmap', `xbm' or `xpm' in order to force the image format." "*Icon file for archive folder.") (defvar wl-pipe-folder-icon "pipe.xpm" "*Icon file for pipe folder.") +(defvar wl-nmz-folder-icon "nmz.xpm" + "*Icon file for namazu folder.") +(defvar wl-shimbun-folder-icon "shimbun.xpm" + "*Icon file for shimbun folder.") (defvar wl-maildir-folder-icon "maildir.xpm" "*Icon file for maildir folder.") (defvar wl-empty-trash-folder-icon "trash-e.xpm" @@ -2228,6 +2241,34 @@ a symbol `bitmap', `xbm' or `xpm' in order to force the image format." (defvar wl-plugged-port-indent 4) (defvar wl-plugged-queue-status-column 25) +;; Obsolete variables. +(elmo-define-obsolete-variable 'wl-summary-from-func + 'wl-summary-from-function) +(elmo-define-obsolete-variable 'wl-summary-subject-func + 'wl-summary-subject-function) +(elmo-define-obsolete-variable 'wl-summary-subject-filter-func + 'wl-summary-subject-filter-function) +(elmo-define-obsolete-variable 'wl-draft-send-func + 'wl-draft-send-function) +(elmo-define-obsolete-variable 'wl-draft-send-news-func + 'wl-draft-send-news-function) +(elmo-define-obsolete-variable 'wl-draft-send-mail-func + 'wl-draft-send-mail-function) +(elmo-define-obsolete-variable 'wl-print-buffer-func + 'wl-print-buffer-function) +(elmo-define-obsolete-variable 'wl-ps-print-buffer-func + 'wl-ps-print-buffer-function) +(elmo-define-obsolete-variable 'wl-generate-mailer-string-func + 'wl-generate-mailer-string-function) +(elmo-define-obsolete-variable 'wl-highlight-x-face-func + 'wl-highlight-x-face-function) +(elmo-define-obsolete-variable 'wl-fldmgr-sort-func + 'wl-fldmgr-sort-function) +(elmo-define-obsolete-variable 'wl-expire-archive-get-folder-func + 'wl-expire-archive-get-folder-function) +(elmo-define-obsolete-variable 'wl-highlight-signature-search-func + 'wl-highlight-signature-search-function) + (require 'product) (product-provide (provide 'wl-vars) (require 'wl-version)) diff --git a/wl/wl-version.el b/wl/wl-version.el index c1280bd..bc7f5e0 100644 --- a/wl/wl-version.el +++ b/wl/wl-version.el @@ -46,8 +46,13 @@ "Wanderlust" nil (eval-when-compile (product-version (product-find 'elmo-version))) ; equals to ELMO version. - "Smooth")) + "Too Funky")) +(defconst wl-version-status nil + "Wanderlust verstion status. For override default rule. +If nil, use default rule.") + + ;; set version-string (product-version-as-string 'wl-version) @@ -62,22 +67,12 @@ (message "%s" product-info) product-info))) -(defvar wl-version-status-alist - '(((zerop (% (nth 1 (product-version (product-find 'wl-version))) 2)) - . "stable") - (t . "beta")) - "An alist to define the version status.") - (defun wl-version-status () - "Return version status (\"stable\" or \"beta\")." - (let ((salist wl-version-status-alist) - status) - (while salist - (when (eval (car (car salist))) - (setq status (cdr (car salist))) - (setq salist nil)) - (setq salist (cdr salist))) - status)) + "Return version status string." + (or wl-version-status + (if (zerop (% (nth 1 (product-version (product-find 'wl-version))) 2)) + "stable" + "beta"))) ;; avoid compile warnings (defvar mule-version) @@ -90,7 +85,7 @@ (defvar mime-editor/codename) (defun wl-generate-user-agent-string () - "A candidate of `wl-generate-mailer-string-func'. + "A candidate of `wl-generate-mailer-string-function'. Insert User-Agent field instead of X-Mailer field." (concat "User-Agent: " (wl-generate-user-agent-string-1 diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 8e95570..7612bcd 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -284,7 +284,7 @@ ((string= fld-name wl-queue-folder);; queue folder (get 'wl-folder-queue-glyph 'glyph)) (;; and one of many other folders - (setq type (elmo-folder-get-type fld-name)) + (setq type (elmo-folder-type fld-name)) (get (intern (format "wl-folder-%s-glyph" type)) 'glyph)))))) (let ((end (point-at-eol))) (when wl-use-highlight-mouse-line @@ -350,7 +350,7 @@ (put-text-property 0 len 'begin-glyph (get 'wl-folder-queue-glyph 'glyph) string) - (if (setq type (elmo-folder-get-type folder)) + (if (setq type (elmo-folder-type folder)) (put-text-property 0 len 'begin-glyph (get (intern (format "wl-folder-%s-glyph" type)) @@ -371,6 +371,8 @@ (wl-folder-archive-glyph . wl-archive-folder-icon) (wl-folder-pipe-glyph . wl-pipe-folder-icon) (wl-folder-maildir-glyph . wl-maildir-folder-icon) + (wl-folder-nmz-glyph . wl-nmz-folder-icon) + (wl-folder-shimbun-glyph . wl-shimbun-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) @@ -512,7 +514,7 @@ Special commands: (defun wl-draft-overload-functions () (wl-mode-line-buffer-identification) - (local-set-key "\C-c\C-s" 'wl-draft-send);; override + ;; (local-set-key "\C-c\C-s" 'wl-draft-send);; override (wl-xmas-setup-draft-toolbar) (wl-draft-overload-menubar)) diff --git a/wl/wl.el b/wl/wl.el index 1c6acd6..349c5bc 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -31,7 +31,7 @@ ;;; Code: ;; -(require 'elmo2) +(require 'elmo) (require 'wl-version) ; reduce recursive-load-depth ;; from x-face.el @@ -69,6 +69,7 @@ (require 'wl-highlight) (eval-when-compile + (require 'cl) (require 'smtp) (require 'wl-score) (unless wl-on-nemacs @@ -106,8 +107,7 @@ (let ((summaries (wl-collect-summary))) (while summaries (set-buffer (pop summaries)) - (wl-summary-msgdb-save) - ;; msgdb is saved, but cache is not saved yet. + (elmo-folder-commit wl-summary-buffer-elmo-folder) (wl-summary-set-message-modified)))) (setq wl-biff-check-folders-running nil) (if wl-plugged @@ -118,14 +118,14 @@ (if (and wl-draft-enable-queuing wl-auto-flush-queue) (wl-draft-queue-flush)) - (when (and (eq major-mode 'wl-summary-mode) - (elmo-folder-plugged-p wl-summary-buffer-folder-name)) - (let* ((msgdb-dir (elmo-msgdb-expand-path - wl-summary-buffer-folder-name)) - (seen-list (elmo-msgdb-seen-load msgdb-dir))) - (setq seen-list - (wl-summary-flush-pending-append-operations seen-list)) - (elmo-msgdb-seen-save msgdb-dir seen-list))) +;; (when (and (eq major-mode 'wl-summary-mode) +;; (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)) +;; (let* ((msgdb-dir (elmo-folder-msgdb-path +;; wl-summary-buffer-elmo-folder)) +;; (seen-list (elmo-msgdb-seen-load msgdb-dir))) +;; (setq seen-list +;; (wl-summary-flush-pending-append-operations seen-list)) +;; (elmo-msgdb-seen-save msgdb-dir seen-list))) (run-hooks 'wl-plugged-hook)) (wl-biff-stop) (run-hooks 'wl-unplugged-hook)) @@ -134,9 +134,9 @@ ;;; wl-plugged-mode (defvar wl-plugged-port-label-alist - (list (cons elmo-default-nntp-port "nntp") - (cons elmo-default-imap4-port "imap4") - (cons elmo-default-pop3-port "pop3"))) + (list (cons 119 "nntp") + (cons 143 "imap4") + (cons 110 "pop3"))) ;;(cons elmo-pop-before-smtp-port "pop3") (defconst wl-plugged-switch-variables @@ -235,7 +235,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (defun wl-plugged-sending-queue-info () ;; sending queue status (let (alist msgs sent-via server port) - (setq msgs (elmo-list-folder wl-queue-folder)) + (setq msgs (elmo-folder-list-messages + (wl-folder-get-elmo-folder wl-queue-folder))) (while msgs (setq sent-via (wl-draft-queue-info-operation (car msgs) 'get-sent-via)) (while sent-via @@ -267,28 +268,40 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (defun wl-plugged-dop-queue-info () ;; dop queue status (let* ((count 0) - elmo-dop-queue dop-queue last alist server-info + (elmo-dop-queue (copy-sequence elmo-dop-queue)) + dop-queue last alist server-info ope operation) - (elmo-dop-queue-load) + ;(elmo-dop-queue-load) (elmo-dop-queue-merge) (setq dop-queue (sort elmo-dop-queue '(lambda (a b) - (string< (car a) (car b))))) + (string< (elmo-dop-queue-fname a) + (elmo-dop-queue-fname b))))) (wl-append dop-queue (list nil)) ;; terminate(dummy) - (setq last (caar dop-queue)) ;; first + (when (car dop-queue) + (setq last (elmo-dop-queue-fname (car dop-queue)))) ;; first (while dop-queue - (setq ope (cons (nth 1 (car dop-queue)) - (length (nth 2 (car dop-queue))))) - (if (string= last (caar dop-queue)) + (when (car dop-queue) + (setq ope (cons (elmo-dop-queue-method (car dop-queue)) + (length + (if (listp + (car + (elmo-dop-queue-arguments (car dop-queue)))) + (car (elmo-dop-queue-arguments + (car dop-queue)))))))) + (if (and (car dop-queue) + (string= last (elmo-dop-queue-fname (car dop-queue)))) (wl-append operation (list ope)) ;;(setq count (1+ count)) - (when (and last (setq server-info (elmo-folder-portinfo last))) + (when (and last (setq server-info (elmo-net-port-info + (wl-folder-get-elmo-folder last)))) (setq alist (wl-append-assoc-list (cons (car server-info) (nth 1 server-info)) ;; server port (cons last operation) alist))) - (setq last (caar dop-queue) - operation (list ope))) + (when (car dop-queue) + (setq last (elmo-dop-queue-fname (car dop-queue)) + operation (list ope)))) (setq dop-queue (cdr dop-queue))) alist)) @@ -336,8 +349,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (wl-plugged-sending-queue-status qinfo)))) (insert line "\n")) (while alist - (setq server (caaar alist) - port (cdaar alist) + (setq server (nth 0 (caar alist)) + port (nth 1 (caar alist)) label (nth 1 (car alist)) plugged (nth 2 (car alist)) time (nth 3 (car alist))) @@ -419,6 +432,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (wl-plugged-redrawing-switch wl-plugged-port-indent plugged time) (setq alist (cdr alist)))) + (sit-for 0) (set-buffer-modified-p nil)) (defun wl-plugged-change () @@ -448,7 +462,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (enlarge-window (- window-lines (window-height))) (when (fboundp 'pos-visible-in-window-p) (goto-char (point-min)) - (while (and (<= (window-height) max-lines) + (while (and (< (window-height) max-lines) (not (pos-visible-in-window-p (1- (point-max))))) (enlarge-window 2)))) (error)) @@ -497,20 +511,23 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (name (elmo-match-buffer 3)) (plugged (not (string= switch wl-plugged-plug-on))) (alist wl-plugged-alist) - server port) + server port stream-type name-1) (cond ((eq indent wl-plugged-port-indent) ;; toggle port plug (cond ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name) - (setq port (string-to-int (elmo-match-string 2 name)))) + (setq port (string-to-int (elmo-match-string 2 name))) + (if (string-match "!" (setq name-1 (elmo-match-string 1 name))) + (setq stream-type + (intern (substring name-1 (match-end 0)))))) (t (setq port name))) (setq server (wl-plugged-get-server)) - (elmo-set-plugged plugged server port nil alist)) + (elmo-set-plugged plugged server port stream-type nil alist)) ((eq indent wl-plugged-server-indent) ;; toggle server plug - (elmo-set-plugged plugged name nil nil alist)) + (elmo-set-plugged plugged name nil nil nil alist)) ((eq indent 0) ;; toggle all plug - (elmo-set-plugged plugged nil nil nil alist))) + (elmo-set-plugged plugged nil nil nil nil alist))) ;; redraw (wl-plugged-redrawing wl-plugged-alist) ;; show plugged status in modeline @@ -530,7 +547,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (interactive) (let ((cur-point (point))) (setq wl-plugged-switch (not wl-plugged-switch)) - (elmo-set-plugged wl-plugged-switch nil nil nil wl-plugged-alist) + (elmo-set-plugged wl-plugged-switch nil nil nil nil wl-plugged-alist) (wl-plugged-redrawing wl-plugged-alist) (goto-char cur-point) (setq wl-plugged-alist-modified t) @@ -612,17 +629,18 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (save-excursion (let ((summaries (wl-collect-summary))) (while summaries - (set-buffer (car summaries)) - (unless keep-summary - (wl-summary-cleanup-temp-marks)) - (wl-summary-save-status keep-summary) - (unless keep-summary - (kill-buffer (car summaries))) + (with-current-buffer (car summaries) + (unless keep-summary + (wl-summary-cleanup-temp-marks)) + (wl-summary-save-view keep-summary) + (elmo-folder-commit wl-summary-buffer-elmo-folder) + (unless keep-summary + (kill-buffer (car summaries)))) (setq summaries (cdr summaries)))))) (wl-refile-alist-save) (wl-folder-info-save) (and (featurep 'wl-fldmgr) (wl-fldmgr-exit)) - (wl-crosspost-alist-save) + (elmo-crosspost-message-alist-save) (message "Saving summary and folder status...done")) (defun wl-exit () @@ -634,72 +652,52 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (run-hooks 'wl-exit-hook) (wl-save-status) (wl-folder-cleanup-variables) - (elmo-cleanup-variables) + (wl-message-buffer-cache-clean-up) (wl-kill-buffers (format "^\\(%s\\)$" (mapconcat 'identity - (list (format "%s\\(:.*\\)?" - (default-value 'wl-message-buf-name)) - wl-original-buf-name - wl-folder-buffer-name + (list wl-folder-buffer-name wl-plugged-buf-name) "\\|"))) - (elmo-buffer-cache-clean-up) - (if (fboundp 'mmelmo-cleanup-entity-buffers) - (mmelmo-cleanup-entity-buffers)) (if (and wl-folder-use-frame (> (length (visible-frame-list)) 1)) - (delete-frame)) + (delete-frame)) (setq wl-init nil) (unless wl-on-nemacs (remove-hook 'kill-emacs-hook 'wl-save-status)) t) - (message "") ;; empty minibuffer. + (message "") ; empty minibuffer. ) -(defun wl-init (&optional arg) +(defun wl-init () (when (not wl-init) (setq elmo-plugged wl-plugged) - (let (succeed demo-buf) - (if wl-demo - (setq demo-buf (wl-demo))) - (unless wl-on-nemacs - (add-hook 'kill-emacs-hook 'wl-save-status)) - (unwind-protect - (progn - (wl-address-init) - (wl-draft-setup) - (wl-refile-alist-setup) - (wl-crosspost-alist-load) - (if wl-use-semi - (progn - (require 'wl-mime) - (setq elmo-use-semi t)) - (require 'tm-wl) - (setq elmo-use-semi nil)) - ;; defined above. - (wl-mime-setup) - (fset 'wl-summary-from-func-internal - (symbol-value 'wl-summary-from-func)) - (fset 'wl-summary-subject-func-internal - (symbol-value 'wl-summary-subject-func)) - (fset 'wl-summary-subject-filter-func-internal - (symbol-value 'wl-summary-subject-filter-func)) - (setq elmo-no-from wl-summary-no-from-message) - (setq elmo-no-subject wl-summary-no-subject-message) - (setq succeed t) - (progn - (message "Checking environment...") - (wl-check-environment arg) - (message "Checking environment...done"))) - (if demo-buf - (kill-buffer demo-buf)) - (if succeed - (setq wl-init t)) - ;; This hook may contain the functions `wl-plugged-init-icons' and - ;; `wl-biff-init-icons' for reasons of system internal to accord - ;; facilities for the Emacs variants. - (run-hooks 'wl-init-hook))))) + (unless wl-on-nemacs + (add-hook 'kill-emacs-hook 'wl-save-status)) + (wl-address-init) + (wl-draft-setup) + (wl-refile-alist-setup) + (if wl-use-semi + (progn + (require 'wl-mime) + (setq elmo-use-semi t)) + (require 'tm-wl) + (setq elmo-use-semi nil)) + ;; defined above. + (wl-mime-setup) + (fset 'wl-summary-from-func-internal + (symbol-value 'wl-summary-from-function)) + (fset 'wl-summary-subject-func-internal + (symbol-value 'wl-summary-subject-function)) + (fset 'wl-summary-subject-filter-func-internal + (symbol-value 'wl-summary-subject-filter-function)) + (setq elmo-no-from wl-summary-no-from-message) + (setq elmo-no-subject wl-summary-no-subject-message) + (setq wl-init t) + ;; This hook may contain the functions `wl-plugged-init-icons' and + ;; `wl-biff-init-icons' for reasons of system internal to accord + ;; facilities for the Emacs variants. + (run-hooks 'wl-init-hook))) (defun wl-check-environment (no-check-folder) (unless (featurep 'mime-setup) @@ -725,55 +723,79 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (error "Please set `wl-message-id-domain'")) ;; folders (when (not no-check-folder) - (if (not (eq (elmo-folder-get-type wl-draft-folder) 'localdir)) - (error "%s is not allowed for draft folder" wl-draft-folder)) - (unless (elmo-folder-exists-p wl-draft-folder) - (if (y-or-n-p - (format "Draft Folder %s does not exist, create it? " - wl-draft-folder)) - (elmo-create-folder wl-draft-folder) - (error "Draft Folder is not created"))) - (if (and wl-draft-enable-queuing - (not (elmo-folder-exists-p wl-queue-folder))) + (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) + (queue-folder (wl-folder-get-elmo-folder wl-queue-folder)) + (trash-folder (wl-folder-get-elmo-folder wl-trash-folder)) + (lost+found-folder (wl-folder-get-elmo-folder + elmo-lost+found-folder))) + (if (not (elmo-folder-message-file-p draft-folder)) + (error "%s is not allowed for draft folder" wl-draft-folder)) + (unless (elmo-folder-exists-p draft-folder) (if (y-or-n-p - (format "Queue Folder %s does not exist, create it? " - wl-queue-folder)) - (elmo-create-folder wl-queue-folder) - (error "Queue Folder is not created")))) - (when (not (eq no-check-folder 'wl-draft)) - (unless (elmo-folder-exists-p wl-trash-folder) - (if (y-or-n-p - (format "Trash Folder %s does not exist, create it? " - wl-trash-folder)) - (elmo-create-folder wl-trash-folder) - (error "Trash Folder is not created"))) - (unless (elmo-folder-exists-p elmo-lost+found-folder) - (elmo-create-folder elmo-lost+found-folder))) - ;; tmp dir - (unless (file-exists-p wl-tmp-dir) - (if (y-or-n-p - (format "Temp directory (to save multipart) %s does not exist, create it now? " - wl-tmp-dir)) - (make-directory wl-tmp-dir) - (error "Temp directory is not created")))) + (format "Draft Folder %s does not exist, create it? " + wl-draft-folder)) + (elmo-folder-create draft-folder) + (error "Draft Folder is not created"))) + (if (and wl-draft-enable-queuing + (not (elmo-folder-exists-p queue-folder))) + (if (y-or-n-p + (format "Queue Folder %s does not exist, create it? " + wl-queue-folder)) + (elmo-folder-create queue-folder) + (error "Queue Folder is not created"))) + (when (not (eq no-check-folder 'wl-draft)) + (unless (elmo-folder-exists-p trash-folder) + (if (y-or-n-p + (format "Trash Folder %s does not exist, create it? " + wl-trash-folder)) + (elmo-folder-create trash-folder) + (error "Trash Folder is not created"))) + (unless (elmo-folder-exists-p lost+found-folder) + (elmo-folder-create lost+found-folder))) + ;; tmp dir + (unless (file-exists-p wl-tmp-dir) + (if (y-or-n-p + (format "Temp directory (to save multipart) %s does not exist, create it now? " + wl-tmp-dir)) + (make-directory wl-tmp-dir) + (error "Temp directory is not created")))))) ;;;###autoload (defun wl (&optional arg) "Start Wanderlust -- Yet Another Message Interface On Emacsen. If ARG (prefix argument) is specified, folder checkings are skipped." (interactive "P") - (or wl-init (wl-load-profile)) - (unwind-protect - (wl-init arg) - (wl-plugged-init (wl-folder arg)) - (sit-for 0)) - (unwind-protect - (unless arg - (run-hooks 'wl-auto-check-folder-pre-hook) - (wl-folder-auto-check) - (run-hooks 'wl-auto-check-folder-hook)) - (unless arg (wl-biff-start)) - (run-hooks 'wl-hook))) + (unless wl-init + (wl-load-profile)) + (elmo-init) + (let (demo-buf) + (unless wl-init + (if wl-demo (setq demo-buf (wl-demo)))) + (wl-init) + (unless wl-init + (condition-case nil + (progn + (message "Checking environment...") + (wl-check-environment arg) + (message "Checking environment...done")) + (error) + (quit))) + (condition-case obj + (progn + (wl-plugged-init (wl-folder arg)) + (unless arg + (run-hooks 'wl-auto-check-folder-pre-hook) + (wl-folder-auto-check) + (run-hooks 'wl-auto-check-folder-hook)) + (unless arg (wl-biff-start))) + (error + (if (buffer-live-p demo-buf) + (kill-buffer demo-buf)) + (signal (car obj)(cdr obj))) + (quit)) + (if (buffer-live-p demo-buf) + (kill-buffer demo-buf))) + (run-hooks 'wl-hook)) ;; Define some autoload functions WL might use. (eval-and-compile -- 1.7.10.4