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.
* WL-MK (wl-detect-info-directory): Call `info-initialize' for
Emacs21.
+2001-05-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <okada@opaopa.org>
+
+ * 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 <teranisi@gohome.org>
* utils/bbdb-wl.el (bbdb-wl-get-update-record): Use
`with-current-buffer'.
+2001-04-04 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * WL-ELS (ELMO-MODULES): Removed shimbun related modules;
+ Add elmo-shimbun only if shimbun is installed.
+
+2001-04-03 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * WL-ELS (ELMO-MODULES): Added sb-tcup.
+
2001-04-02 Yuuichi Teranishi <teranisi@gohome.org>
* utils/bbdb-wl.el: Applied patch from
(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 <teranisi@gohome.org>
+
+ * WL-ELS (ELMO-MODULES): Added elmo-mark.
+
+2001-01-30 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * etc/icons/nmz.xpm: New file.
+
+ * WL-ELS (ELMO-MODULES): Added elmo-nmz.
+
+2000-12-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * WL-ELS (ELMO-MODULES): Changed order.
+ Added mmimap, elmo, elmo-mime.
+ Removed mmelmo-imap4, mmelmo.
+
2001-02-01 Yuuichi Teranishi <teranisi@gohome.org>
* 2.4.1 - "Stand By Me"
))
(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
))
\f
(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
(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))))
(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))))
-elmo-search \e$B$G\e(B msgdb \e$B$H%U%)%k%@K\BN$r%7!<%`%l%9$K8!:w\e(B
-pick/virtual \e$B$N\e(B completion \e$BE}9g\e(B
msgdb \e$B9=B$$N8+D>$7$H\e(B obarray \e$B2=\e(B
\e$B=EMW%^!<%/$N4IM}\e(B
+IMAP \e$B%U%)%k%@%A%'%C%/$G\e(B RECENT \e$B$NCM$r;H$&$h$&$K$9$k!#\e(B
\e$B%5%^%j%U%)!<%^%C%H<+M32=\e(B
\e$B%W%j%U%'%C%AM=Ls%^!<%/\e(B
\e$BJV;v:Q$_!"%U%)%o!<%I:Q$_%^!<%/\e(B
% 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.
}%
\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.
%
\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) >>}%
\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}
\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.
%
\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
% 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
\def\smalllispx{\begingroup
\def\Esmalllisp{\nonfillfinish\endgroup}%
\def\Esmallexample{\nonfillfinish\endgroup}%
- \smallexamplefonts
+ \smallfonts
\lisp
}
\let\Edisplay = \nonfillfinish
\gobble
}
-%
+
% @smalldisplay (when @smallbook): @display plus smaller fonts.
%
\def\smalldisplayx{\begingroup
\def\Esmalldisplay{\nonfillfinish\endgroup}%
- \smallexamplefonts \rm
+ \smallfonts \rm
\display
}
\let\Eformat = \nonfillfinish
\gobble
}
-%
+
% @smallformat (when @smallbook): @format plus smaller fonts.
%
\def\smallformatx{\begingroup
\def\Esmallformat{\nonfillfinish\endgroup}%
- \smallexamplefonts \rm
+ \smallfonts \rm
\format
}
-@set VERSION 2.5.8
+@set VERSION 2.7.0
@itemize @bullet
@item UW imapd 4.1\e$B!A\e(B4.7, 4.7a, 4.7b, 4.7c, 2000 \e$B0J9_\e(B
-@item Cyrus imapd 1.4, 1.5.19, 1.6.22\e$B!A\e(B1.6.24, 2.0.5 \e$B0J9_\e(B
-@item Courier-IMAP 1.3.2 \e$B0J9_\e(B
+@item Cyrus imapd 1.4, 1.5.19, 1.6.22, 2.0.5 \e$B0J9_\e(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 \e$B$,@\B3$7$FF0:n$9$k$3$H$,3NG'$5$l$F$$$k\e(B LDAP \e$B%5!<%P$O0J2<$NDL\e(B
-\e$B$j$G$9!#\e(B
-
-@itemize @bullet
-@item OpenLDAP 2.0.6 \e$B0J9_\e(B
-@end itemize
+@c Wanderlust \e$B$,@\B3$7$FF0:n$9$k$3$H$,3NG'$5$l$F$$$k\e(B LDAP \e$B%5!<%P$O0J2<$NDL\e(B
+@c \e$B$j$G$9!#\e(B
@node Start Me Up, Folders, Introduction, Top
\e$B?d>)$5$l$k\e(B APEL, FLIM, SEMI \e$B$N%P!<%8%g%s$NAH9g$;$O!"0J2<$NDL$j$G$9!#\e(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
\e$B$=$NB>!"\e(BFLIM, SEMI \e$B$K$O$$$m$$$m$JJQ7A%P!<%8%g%s$,B8:_$7$^$9$,!"\e(B
# @var{\e$B%a!<%k%"%I%l%9\e(B} "@var{\e$B$"$@L>\e(B}" "@var{\e$BK\L>\e(B}"
#
teranisi@@gohome.org "\e$B$F$i$K$7\e(B" "\e$B;{@>M50l\e(B"
-foo@@example.com "\e$B$U!<$5$s\e(B" "John Foo"
-bar@@example.org "\e$B$P!<$5$s\e(B" "Michael Bar"
+foo@@bar.gohome.org "Foo \e$B$5$s\e(B" "John Foo"
+bar@@foo.gohome.org "Bar \e$B$5$s\e(B" "Michael Bar"
@end group
@end example
@vindex elmo-pop3-use-cache
\e$B=i4|@_Dj$O\e(B @code{t}\e$B!#\e(BNon-nil \e$B$J$i!"\e(BPOP3 \e$B$GFI$s$@%a%C%;!<%8$r%-%c%C%7%e$7\e(B
\e$B$^$9!#\e(B
+
+@item wl-folder-process-duplicates-alist
+@vindex wl-folder-process-duplicates-alist
+\e$B=i4|@_Dj$O\e(B @code{nil}\e$B!#=EJ#$7$?%a%C%;!<%8$,F1$8%U%)%k%@$K$"$k>l9g$NF0:n\e(B
+\e$B$r;XDj$7$^$9!#3F9`L\$O!"%U%)%k%@L>$N@55,I=8=$HF0:n$+$i$J$j$^$9!#\e(B
+\e$BF0:n$H$7$F$O0J2<$N$b$N$,;XDj$G$-$^$9!#\e(B
+
+@example
+@code{nil} : \e$B=EJ#%a%C%;!<%8$KBP$7!$2?$b$7$J$$!%\e(B
+@code{hide} : \e$B=EJ#%a%C%;!<%8$r%5%^%j$KI=<($7$J$$!%\e(B
+@code{read} : \e$B=EJ#%a%C%;!<%8$r4{FI$K$9$k!%\e(B
+@end example
+
+@noindent
+\e$BNc$($P0J2<$N$h$&$K@_Dj$7$^$9\e(B (\e$B%^%k%A%U%)%k%@$G=EJ#%a%C%;!<%8$r1#$9>l9g\e(B)
+
+@lisp
+@group
+(setq wl-folder-process-duplicates-alist
+ '(("^\\+draft$" . nil) ("^\\+trash$" . nil)
+ ("^\\*.*" . hide) (".*" . read)))
+@end group
+@end lisp
@end table
\e$B=i4|@_Dj$O\e(B @code{nil}\e$B!#\e(B
Non-nil \e$B$J$i%I%i%U%HMQ$K?7$7$$%U%l!<%`$r3+$-$^$9!#\e(B
-@item wl-folder-use-frame
-@vindex wl-folder-use-frame
-\e$B=i4|@_Dj$O\e(B @code{nil}\e$B!#\e(B
-Non-nil \e$B$J$i%U%)%k%@0lMwMQ$K?7$7$$%U%l!<%`$r3+$-$^$9!#\e(B
-
-@item wl-summary-use-frame
-@vindex wl-summary-use-frame
-\e$B=i4|@_Dj$O\e(B @code{nil}\e$B!#\e(B
-Non-nil \e$B$J$i%5%^%jI=<(MQ$K?7$7$$%U%l!<%`$r3+$-$^$9!#\e(B
-
@item wl-from
@vindex wl-from
\e$B=i4|@_Dj$OJQ?t\e(B @code{user-mail-address} \e$B$NCM!#\e(B
@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
# @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
@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
@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
2001-06-15 Yuuichi Teranishi <teranisi@gohome.org>
+ * 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.
(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 <teranisi@gohome.org>
(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 <teranisi@gohome.org>
+ * 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 <teranisi@gohome.org>
+
+ * 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):
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 <teranisi@gohome.org>
* 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 <teranisi@gohome.org>
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <okada@opaopa.org>
+
+ * elmo-nntp.el (elmo-nntp-get-newsgroup-by-msgid): Fix for luna.
+
+2001-05-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-pipe.el (elmo-folder-open-internal): Check plugged before
+ call `elmo-pipe-drain'.
+
+2001-05-19 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+
+ * elmo-mark.el (elmo-message-fetch-with-cache-process): Fixed
+ typo. (elmo-cache-folder -> elmo-mark-folder)
+
+2001-05-11 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-net.el (elmo-message-fetch-unplugged): Don't call
+ `elmo-message-fetch'.
+
+2001-05-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-localdir.el (elmo-folder-pack-numbers): Fixed.
+
+2001-05-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo.el (elmo-folder-move-messages): Fixed problem when
+ `dst-folder' is 'null.
+
+2001-05-09 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo.el (elmo-message-fetch-confirm): Fixed docstring.
+ (Patch is provided by <kita@coe.nttdata.co.jp>).
+
+2001-05-08 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo.el (elmo-folder-synchronize): Don't check important mark in
+ mark folder.
+
+2001-05-08 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-pipe.el (elmo-folder-unmark-important): Fixed typo.
+ (elmo-folder-mark-as-important): Ditto.
+
+2001-04-26 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <minakaji@osaka.email.ne.jp>')
+
+2001-04-16 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo.el (elmo-folder-synchronize): Fixed problem when there's no
+ new message.
+
+2001-04-12 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <muse@ba2.so-net.ne.jp>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yasushi@indigo.co.jp>)
+
+2001-04-02 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <okada@opaopa.org>
* elmo-imap4.el (elmo-imap4-list-folders): Fixed problem when
hierarchy is t.
-2001-03-07 TAKAHASHI Kaoru <kaoru@kaisei.org>
+2001-03-12 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo-msgdb.el (elmo-msgdb-delete-msgs): Changed argument from
+ `folder' to `msgdb'.
+
+2001-03-01 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
- * elmo-imap4.el (elmo-imap4-list-folders): Fixed problem when
- elmo-default-imap4-authenticate-type is nil
- (Reported by Bun Mizuhara <mizuhara@acm.org>).
+ * 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 <mizuhara@acm.org>)
+ (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 <kaoru@kaisei.org>
+
+ * elmo.el (toplevel): Require 'elmo-version first;
+ for little `recursive-load-depth' settings.
+ Fix "ends here" comment.
+
+2001-02-23 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <mokkun@iname.com>)
+ * 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 <teranisi@gohome.org>
* 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 <okazaki@be.to>
+2001-02-21 Yuuichi Teranishi <teranisi@gohome.org>
- * 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 <teranisi@gohome.org>
+
+ * 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 <okada@opaopa.org>
* elmo-imap4.el (elmo-network-authenticate-session): Fix.
* elmo-pop3.el (elmo-network-authenticate-session): Add comments.
+2001-02-20 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <okazaki@be.to>
+
+ * elmo-util.el (elmo-display-progress): Prefer
+ `progress-feedback-with-label' to `lprogress-display'.
+
2000-02-20 Kenichi OKADA <okada@opaopa.org>
* elmo-imap4.el (elmo-imap4-list-folder): Added 'uid'
* 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo-mime.el (elmo-mime-message-display): Added argument `unread'.
+ (elmo-mime-message-display-as-is): Ditto.
+
+2001-02-07 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-pipe.el (elmo-pipe-drain): Eliminated needless bindings;
+ Use `elmo-folder-close-internal' instead of `elmo-folder-close'.
+
+2001-02-06 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-mark.el: New file.
+
+ * elmo-internal.el: Rewrite (Almost empty).
+
+2001-02-05 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * mmimap.el (mmimap-make-mime-entity): Consider message/rfc822.
+ (mime-imap-entity-header-string): Ditto.
+ (mmimap-entity-section): Rewrite.
+
+2001-01-30 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-nmz.el: New file.
+
+ * elmo-pipe.el: Rewrite with luna.
+
+2001-01-29 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo-archive.el (elmo-archive-version): Abolish.
+ (toplevel) Removed `boso' comment.
+
+2001-01-23 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo-filter.el: Rewrite with luna.
+
+2001-01-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-pop3.el: Rewrite with luna.
+
+2001-01-17 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * elmo.el: Changed meaning of `elmo-folder-commit'.
+ * elmo-mime.el (elmo-mime-display-as-is-internal): New function.
+
+2001-01-07 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo.el (elmo-folder-append-buffer): New function.
+ (Renamed from `elmo-append-msg')
+
+2000-12-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-mime.el: New file.
+
+2000-12-14 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-cache.el: Rewrite.
+
2000-02-17 Kenichi OKADA <okada@opaopa.org>
* elmo-pop3.el (elmo-network-authenticate-session): Bind `sasl-mechanisms'
-2001-02-16 Yuuichi Teranishi <teranisi@gohome.org>
+2000-12-08 Yuuichi Teranishi <teranisi@gohome.org>
- * 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 <teranisi@gohome.org>
+ * 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 <okazaki@be.to>
+ * 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 <teranisi@gohome.org>
+ * 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 <teranisi@gohome.org>
+2000-12-06 Yuuichi Teranishi <teranisi@gohome.org>
- * 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 <teranisi@gohome.org>
+ * 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 <teranisi@gohome.org>
+ * elmo.el: New file.
+
+ * elmo2.el: Renamed to elmo.el.
+
+\f
2001-02-01 OKAZAKI Tetsurou <okazaki@be.to>
* elmo-cache.el (elmo-cache-expire-by-size): Count
;;; Commentary:
;;
;; TODO:
-;; [¥Ü¥½] append-msgs() ¤¬Íߤ·¤¤¡Ê¤±¤É multi-refile ÉԲġˡ£
;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£
;;; Code:
(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))
(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.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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
(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))))
(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)
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)
((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)))
(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)
(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))))
(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*")))
(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...")
(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
(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)
'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
(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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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
(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))
(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.
-
-\f
;;; method(alist)
(if (null elmo-archive-method-alist)
(let ((mlist elmo-archive-method-list) ; from mew-highlight.el
(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)
;;
(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 <okada@opaopa.org>
;;
+(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))
(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])
;;; 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)
(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))
;;; 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))
(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
;;
(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)
elmo-imap4-status-callback-data
elmo-imap4-current-msgdb))
-(defvar elmo-imap4-display-literal-progress nil)
;;;;
(defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
(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*")
(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)
(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)
(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.
;; 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
"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.
(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))
(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)))
(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)
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)
(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))
(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
(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
(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)
(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.
(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."
(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 ()
(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))
;;; 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))
;;; 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))
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)
(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)
(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)
(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)
(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..
(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
(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))
;;; 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))
;;
(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
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
(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."
(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)
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.
;; 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))
--- /dev/null
+;;; elmo-map.el -- A ELMO folder class with message number mapping.
+
+;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
--- /dev/null
+;;; elmo-mark.el -- Global mark folder for ELMO.
+
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
--- /dev/null
+;;; elmo-mime.el -- MIME module for ELMO.
+
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
(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
(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
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)
(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)
(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")
((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)
(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)
(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))
(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)
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
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."
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"))
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
(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)
(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
(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
(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
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))
;;; 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
(+ 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))
(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
(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))
(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))
;;; 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")
;;
(eval-and-compile
(luna-define-class elmo-network-session () (name
- host
+ server
port
user
auth
(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)
(` (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
(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).
(let ((session
(luna-make-entity class
:name name
- :host host
+ :server server
:port port
:user user
:auth auth
(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)
"")))
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)
(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)
(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))
--- /dev/null
+;;; elmo-nmz.el -- Namazu interface for ELMO.
+
+;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
;;; 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))
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)
(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)))
(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
(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
(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)
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))
(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))
(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)))
(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))
(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
(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
("xref" . 8)))
(defun elmo-nntp-create-msgdb-from-overview-string (str
- folder
new-mark
already-mark
seen-mark
(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)
(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
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
(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)
"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)
(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
(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)
(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
(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)
(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
(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)
(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 ()
(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)
'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))
;;; 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))
(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)
(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)
(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)
(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)
(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)
(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)))
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))
;; 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
(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))
(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
(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
(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)
(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
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
(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)
(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)
(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
(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
(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))
--- /dev/null
+;;; elmo-shimbun.el -- Shimbun interface for ELMO.
+
+;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
;;; 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."
(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)
(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."
;;;(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
(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 <fuji0924@mbox.kyoto-inet.or.jp>
-(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 "[^/ \")|&]*")
(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)
(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))
(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)
(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
(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)
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)
(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)))
(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)
(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
(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."
;; 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
(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)))
(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."
(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
":" "__")
"|" "_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
(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))
(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))
;;
(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"
"*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
"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.")
(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.")
"*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))
(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)
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).")
(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.")
(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")
("/" . " 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)
(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))
;; 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)
--- /dev/null
+;;; elmo.el -- Elisp Library for Message Orchestration
+
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
+++ /dev/null
-;;; elmo2.el -- ELMO main file (I don't remember why this is 2).
-
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; 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
+++ /dev/null
-;;; mmelmo-imap4.el -- MM backend of IMAP4 for ELMO.
-
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; 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
+++ /dev/null
-;;; mmelmo.el -- mm-backend by ELMO.
-
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; 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
--- /dev/null
+;;; mmimap.el --- MIME entity module for IMAP4rev1 (RFC2060).
+;; **** This is EXPERIMENTAL *****
+
+;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
#
-# ~/.addresses sample file.
+# "~/.addresses" sample file.
+# by Yuuichi Teranishi <teranisi@gohome.org>
+# 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"
#
-# ~/.folders sample file.
-#
-# For further information, see section "Folders" in the Info.
+# "~/.folders" sample file.
+# by Yuuichi Teranishi <teranisi@gohome.org>
+# 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
+}
-;;; 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
(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 <e-mail@example.com>")
+;; 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)
;; 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)
; ))
+;; 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)
(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)))
;(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"
("^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\e$B0J8e\e(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)
)))
;; 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
+;;;
#
-# ~/.addresses \e$B%"%I%l%9D"%U%!%$%k%5%s%W%k\e(B
+# \e$B%"%I%l%9%U%!%$%k%5%s%W%k\e(B
+# by Yuuichi Teranishi <teranisi@gohome.org>
+# Time-stamp: <98/06/15 00:32:30 teranisi>
#
# '#' \e$B$G;O$^$k9T$O%3%a%s%H!#\e(B
# \e$B6u9T$OL5;k!#\e(B
#
-# \e$B=q<0\e(B:
# \e$B%a!<%k%"%I%l%9\e(B "\e$B$"$@L>\e(B" "\e$BK\L>\e(B"
#
-# \e$B$"$@L>$O%5%^%j$NI=<($K!"K\L>$O\e(B To: \e$B%U%#!<%k%I$K;H$o$l$^$9!#\e(B
-#
teranisi@gohome.org "\e$B$F$i$K$7\e(B" "\e$B;{@>M50l\e(B"
-foo@example.com "\e$B$U!<$5$s\e(B" "John Foo"
-bar@example.org "\e$B$P!<$5$s\e(B" "Michael Bar"
+foo@bar.com "\e$B$U!<$5$s\e(B" "Mr. Foo"
+bar@foo.com "\e$B$P!<$5$s\e(B" "Mr. Bar"
#
-# ~/.folders \e$B%U%)%k%@Dj5A%U%!%$%k%5%s%W%k\e(B
-#
-# \e$B8D!9$N%U%)%k%@$N=q<0$K$D$$$F$O\e(B Info \e$B$N\e(B Folders \e$B%;%/%7%g%s$r;2>H$N$3$H!#\e(B
+# \e$B%U%)%k%@Dj5A%U%!%$%k%5%s%W%k\e(B
+# by Yuuichi Teranishi <teranisi@gohome.org>
+# Time-stamp: <98/10/02 18:31:06 teranisi>
#
# '#' \e$B$G;O$^$k9T$O%3%a%s%H!#\e(B
-# \e$B6u9T$OL5;k$5$l$k!#\e(B
+# \e$B6u9T$OL5;k!#\e(B
#
+# \e$B8D!9$N%U%)%k%@$N=q<0$K$D$$$F$O\e(B info \e$B$r;2>H$N$3$H!#\e(B
+#
-## IMAP \e$B%f!<%6$N%a!<%k%\%C%/%9\e(B
-# %inbox
-
-## POP \e$B%f!<%6$N%a!<%k%\%C%/%9\e(B
-# &USERNAME@POPSERVER.EXAMPLE.COM
-
-## [ POP \e$B%f!<%6$K$O%Q%$%W%U%)%k%@$,Lr$KN)$A$^$9\e(B ]
-## [ \e$B%Q%$%W%U%)%k%@$r;H$($P!"%a!<%k$r<h$j9~$`$3$H$,2DG=$G$9\e(B ]
-# |&USERNAME@POPSERVER.EXAMPLE.COM|+inbox
-
-## \e$B%4%_H"!&Ap9F!&Aw?.H"\e(B
+%inbox
+trash
+draft
-+queue
-
-## \e$B=EMW%^!<%/\e(B `$' \e$B$N$D$$$?%a%C%;!<%8$r$^$H$a$k\e(B
-'mark
-
-## MH \e$B%U%)%k%@\e(B
-+inbox
-
-## IMAP \e$B%5!<%P1[$7$K\e(B MH folder \e$B$K%"%/%;%9\e(B
-# %#mh/inbox
-
-## NNTP \e$B%U%)%k%@\e(B
-# -fj.os.bsd.freebsd
-# -fj.mail.reader.mew
-# -fj.news.reader.gnus
-
-## [ \e$BB>$N\e(B NNTP \e$B%5!<%P>e$N%K%e!<%:%0%k!<%W\e(B ]
-# -jlug.ml.users@NEWS.EXAMPLE.NET
-# -emacs.auc-tex@NEWS.EXAMPLE.ORG
-# -ring.openlab.skk@NEWS.EXAMPLE.COM
-
-
-## \e$B%0%k!<%W$NDj5A\e(B
-## [ \e$B%U%)%k%@$rGH3g8L$G$/$/$C$F%0%k!<%W$K$9$k\e(B ]
-# Emacsen{
-# +to/wl
-# +to/mew-dist
-# +to/apel-ja
-## [ \e$B%0%k!<%W$NF~$l;R$b2DG=\e(B ]
-# XEmacs{
-# +to/xemacs-beta
-# +to/xemacs-beta-ja
-# +to/xemacs-mule
-# }
-# }
-
-## \e$B%"%/%;%9%0%k!<%W\e(B
-## [ \e$B9TKv$K\e(B '/' \e$B$,$D$/$H!"$=$N%U%)%k%@$K4^$^$l$k%5%V%U%)%k%@A4$F$,\e(B ]
-## [ \e$B$R$H$D$N%0%k!<%W$H$J$k!#\e(B]
-## [ `C-u RET' \e$B$G%"%/%;%9%0%k!<%W$r3+$/$H99?7$G$-$k!#\e(B ]
+%#mh/Backup@my.imap.server.com
+%#mh/spool/mm
+# \e$B%0%k!<%W$NDj5A\e(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
+# \e$B%^%k%A%U%)%k%@\e(B(\e$BJ#?t$N%U%)%k%@$r2>A[E*$K0l$D$K8+$($k$h$&$K$9$k%U%)%k%@\e(B)
+# \e$B<!$N9T$O\e(B -fj.editor.xemacs,-fj.editor.mule,-fj.editor.emacs \e$B$r0l$D$K$9$kNc\e(B
+ *-fj.editor.xemacs,-fj.editor.mule,-fj.editor.emacs
+ -gnu.emacs.sources
+}
+UNIX \e$B4XO"\e(B{
+# \e$B%0%k!<%W$NF~$l;R$b2D\e(B
+ 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
+}
+\e$B7]G=2;3Z\e(B{
+%#mh/spool/tvdrama
+-fj.rec.tv
+-japan.tv
+-fj.rec.tv.cm
+-japan.tv.cm
+-fj.rec.idol
+-fj.rec.music
+}
+\e$B%^%$%U%)%k%@!<\e(B {
+INBOXes {
+%inbox@localhost
+#
+# \e$B%"%/%;%9%0%k!<%W\e(B
+# \e$B9TKv$K\e(B '/' \e$B$,$D$/$H!"$=$N%U%)%k%@$K4^$^$l$k%5%V%U%)%k%@A4$F$,\e(B
+# \e$B$R$H$D$N%0%k!<%W$H$J$k!#\e(B
+#
+%#mh/expire@localhost /
+}
+# MH \e$B$N%U%)%k%@A4$F$r$R$H$D$N%0%k!<%W$K$9$kNc!#\e(B
+ /
-
-## IMAP \e$B%U%)%k%@$N%"%/%;%9%0%k!<%W$NNc\e(B
-# % /
+%#mh@my.imap.server.com
+}
-;;; dot.wl -- sample setting file for Wanderlust -*- emacs-lisp -*-
+;;; -*- emacs-lisp -*-
+;;; ~/.wl (setting file for Wanderlust)
+;;;
-;; [[ \e$BF0:n$KI,MW$J@_Dj\e(B ]]
-
-;; \e$B$^$:!"<!$N@_Dj$r\e(B ~/.emacs \e$B$J$I$K=q$$$F$/$@$5$$!#\e(B
+;; \e$B$^$:!$<!$N@_Dj$r\e(B ~/.emacs \e$B$J$I$K=q$$$F$/$@$5$$!#\e(B
;; \e$B$3$3$+$i\e(B
(require 'mime-setup)
(autoload 'wl "wl" "Wanderlust" t)
(autoload 'wl-draft "wl-draft" "Write draft with Wanderlust." t)
;; \e$B$3$3$^$G\e(B
-;; \e$B%"%$%3%s$rCV$/%G%#%l%/%H%j\e(B (XEmacs, Emacs21 \e$B$N$_\e(B)
-;; XEmacs \e$B$N\e(B package \e$B$H$7$F%$%s%9%H!<%k$5$l$F$$$k>l9g$OI,MW$"$j$^$;$s!#\e(B
-;(setq wl-icon-dir "/usr/local/lib/emacs/etc")
-
-
;;; [[ \e$B8D?M>pJs$N@_Dj\e(B ]]
-;; From: \e$B$N@_Dj\e(B
+;; From \e$B$N@_Dj\e(B
;(setq wl-from "Your Name <e-mail@example.com>")
+;; Organization \e$B$N@_Dj\e(B
+;(setq wl-organization "")
;; \e$B<+J,$N%a!<%k%"%I%l%9$N%j%9%H\e(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" ...
))
-;; \e$B<+J,$N;22C$7$F$$$k%a!<%j%s%0%j%9%H$N%j%9%H\e(B
-(setq wl-subscribed-mailing-list
- '("wl@lists.airs.net"
- "apel-ja@m17n.org"
- "emacs-mime-ja@m17n.org"
- ;; "ml@example.com" ...
- ))
-
-
-;;; [[ \e$B%5!<%P$N@_Dj\e(B ]]
+;;; [[ \e$B4pK\E*$J@_Dj\e(B ]]
-;; IMAP \e$B%5!<%P$N@_Dj\e(B
+;; MH (localdir) \e$B$N%[!<%`\e(B
+(setq elmo-localdir-folder-path "~/Mail")
+;; IMAP4\e$B%5!<%P$N@_Dj\e(B
(setq elmo-default-imap4-server "localhost")
-;; POP \e$B%5!<%P$N@_Dj\e(B
+;; POP\e$B%5!<%P$N@_Dj\e(B
(setq elmo-default-pop3-server "localhost")
-;; SMTP \e$B%5!<%P$N@_Dj\e(B
-(setq wl-smtp-posting-server "localhost")
;; \e$B%K%e!<%9%5!<%P$N@_Dj\e(B
(setq elmo-default-nntp-server "localhost")
-;; \e$BEj9F@h$N%K%e!<%9%5!<%P\e(B
+;; \e$BEj9F@h$N\e(B \e$B%K%e!<%9%5!<%P\e(B
(setq wl-nntp-posting-server elmo-default-nntp-server)
+;; \e$B%a!<%k$rAw?.$9$k@h$N\e(B (SMTP)\e$B%5!<%P\e(B
+(setq wl-smtp-posting-server "localhost")
-;; (system-name) \e$B$,\e(B FQDN \e$B$rJV$5$J$$>l9g!"\e(B
-;; `wl-local-domain' \e$B$K%[%9%HL>$r=|$$$?%I%a%$%sL>$r@_Dj$7$F$/$@$5$$!#\e(B
-;; (system-name) "." wl-local-domain \e$B$,\e(B Message-ID \e$B$K;HMQ$5$l$^$9!#\e(B
-;(setq wl-local-domain "example.com")
+;; \e$B%"%$%3%s$rCV$/%G%#%l%/%H%j\e(B (XEmacs \e$B$N$_\e(B)
+;; (XEmacs \e$B$N\e(B package \e$B$H$7$F%$%s%9%H!<%k$5$l$F$$$k>l9g!"I,MW$"$j$^$;$s\e(B)
+;(setq wl-icon-dir "~/work/wl/etc")
+;; (system-name) \e$B$,\e(BFQDN\e$B$rJV$5$J$$>l9g!"\e(B
+;; \e$B0J2<$r%[%9%HL>$r=|$$$?%I%a%$%sL>$r@_Dj$7$F$/$@$5$$!#\e(B
+;; ((system-name) "." wl-local-domain \e$B$,\e(B Message-ID \e$B$N:n@.!"\e(B
+;; SMTP \e$B$N\e(B HELO \e$B$K;HMQ\e(B \e$B$5$l$^$9!#\e(B)
+;(setq wl-local-domain "localdomain")
;; Message-ID \e$B$N%I%a%$%s%Q!<%H$r6/@)E*$K;XDj\e(B
-;(setq wl-message-id-domain "hostname.example.com")
-
-;; IMAP \e$B%5!<%P$NG'>ZJ}<0$N@_Dj\e(B
-(setq elmo-default-imap4-authenticate-type 'clear) ; \e$B@8%Q%9%o!<%I\e(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)
-
-
-;;; [[ \e$B4pK\E*$J@_Dj\e(B ]]
-
-;; `wl-summary-goto-folder' \e$B$N;~$KA*Br$9$k%G%U%)%k%H$N%U%)%k%@\e(B
-;(setq wl-default-folder "+inbox")
-
-;; \e$B%U%)%k%@L>Jd40;~$K;HMQ$9$k%G%U%)%k%H$N%9%Z%C%/\e(B
-;(setq wl-default-spec "+")
-
-;; Folder Carbon Copy
-;(setq wl-fcc "+outbox")
-
-;; \e$B=*N;;~$K3NG'$9$k\e(B
-(setq wl-interactive-exit t)
-
-;; \e$B%a!<%kAw?.;~$K$O3NG'$9$k\e(B
-(setq wl-interactive-send t)
-
-;; \e$B%9%l%C%I$O>o$K3+$/\e(B
-;(setq wl-thread-insert-opened t)
-
-;; \e$B%5%^%j%P%C%U%!$N:8$K%U%)%k%@%P%C%U%!$rI=<($9$k\e(B (3\e$B%Z%$%sI=<(\e(B)
-;(setq wl-stay-folder-window t)
-
-;; \e$B%I%i%U%H$r?7$7$$%U%l!<%`$G=q$/\e(B
-;(setq wl-draft-use-frame t)
-
-;; HTML \e$B%Q!<%H$rI=<($7$J$$\e(B
-;(setq mime-setup-enable-inline-html nil)
-
-;; \e$BBg$-$$%a%C%;!<%8$rAw?.;~$KJ,3d$7$J$$\e(B
-;(setq mime-edit-split-message nil)
-
-;; \e$B%5%V%8%'%/%H$,JQ$o$C$?$i%9%l%C%I$r@Z$C$FI=<(\e(B
-;(setq wl-summary-divide-thread-when-subject-changed t)
-
-;; \e$B%9%l%C%I$N8+$?L\$rJQ$($k\e(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")
-;; \e$B%5%^%j0\F08e$K@hF,%a%C%;!<%8$rI=<($9$k\e(B
-;(setq wl-auto-select-first t)
+;(setq wl-default-folder "+inbox") ;; wl-summary-goto-folder \e$B$N;~$KA*Br$9$k\e(B
+ ;; \e$B%G%U%)%k%H$N%U%)%k%@\e(B
+;(setq wl-default-spec "+") ;; \e$B%U%)%k%@L>Jd40;~$K;HMQ$9$k\e(B
+ ;; \e$B%G%U%)%k%H$N%9%Z%C%/\e(B
-;; \e$B%5%^%jFb$N0\F0$GL$FI%a%C%;!<%8$,$J$$$H<!$N%U%)%k%@$K0\F0$9$k\e(B
-;(setq wl-auto-select-next t)
+;(setq wl-fcc "+outbox") ;; Folder Carbon Copy
-;; \e$BL$FI$,$J$$%U%)%k%@$OHt$P$9\e(B(SPC\e$B%-!<$@$1$GFI$_?J$a$k>l9g$OJXMx\e(B)
-;(setq wl-summary-next-no-unread 'skip-no-unread)
+(setq wl-interactive-exit t) ;; \e$B=*N;;~$K3NG'$9$k\e(B
+(setq wl-interactive-send t) ;; \e$B%a!<%kAw?.;~$K$O3NG'$9$k\e(B
-;; \e$BL$FI%a%C%;!<%8$rM%@hE*$KFI$`\e(B
-;(setq wl-summary-move-order 'unread)
+(setq wl-auto-select-first t) ;; \e$B%5%^%j0\F08e$K@hF,%a%C%;!<%8$rI=<($9$k\e(B
+(setq wl-auto-select-next t) ;; \e$B%5%^%jFb$N0\F0$GL$FI%a%C%;!<%8$,$J$$$H\e(B
+ ;; \e$B<!$N%U%)%k%@$K0\F0$9$k\e(B
+;(setq wl-auto-select-next 'skip-no-unread)
+ ;; \e$BL$FI$,$J$$%U%)%k%@$OHt$P$9\e(B
+ ;; SPC\e$B%-!<$@$1$GFI$_?J$a$k>l9g$OJXMx\e(B
+(setq wl-summary-move-order 'unread) ;; \e$BL$FI%a%C%;!<%8$rM%@hE*$KFI$`\e(B
+(setq wl-thread-insert-opened t) ;; thread\e$B:n@.;~$O>o$K\e(Bopen\e$B$K$9$k\e(B
-
-;;; [[ \e$B%M%C%H%o!<%/\e(B ]]
+;(setq wl-stay-folder-window t) ;; \e$B%5%^%j$K0\F0$7$?$H$-$K%U%)%k%@%P%C%U%!\e(B
+ ;; \e$B$N1&$K%5%^%j$N%P%C%U%!$rI=<($9$k\e(B
;; \e$B%U%)%k%@<oJL$4$H$N%-%c%C%7%e$N@_Dj\e(B
-;; (localdir, localnews, maildir \e$B$O%-%c%C%7%e$G$-$J$$\e(B)
+;; (localdir, localnews, maildir \e$B$O%-%c%C%7%e$7$J$$\e(B)
;(setq elmo-archive-use-cache nil)
;(setq elmo-nntp-use-cache t)
;(setq elmo-imap4-use-cache t)
;; unplugged \e$B>uBV$GAw?.$9$k$H!$%-%e!<\e(B(`wl-queue-folder')\e$B$K3JG<$9$k\e(B
(setq wl-draft-enable-queuing t)
-;; unplugged \e$B$+$i\e(B plugged \e$B$KJQ$($?$H$-$K!$%-%e!<$K$"$k%a%C%;!<%8$rAw?.$9$k\e(B
+;; unplugged \e$B$+$i\e(B plugged \e$B$KJQ$($k$H!$%-%e!<$K$"$k%a%C%;!<%8$rAw?.$9$k\e(B
(setq wl-auto-flush-queue t)
;; \e$B5/F0;~$O%*%U%i%$%s>uBV$K$9$k\e(B
; ))
+;; highlight\e$B$N@_Dj\e(B (\e$BL@$k$$GX7J?'$N>l9g$G$9\e(B)
+
+;; \e$B%0%k!<%W$rL$FI?t$K$h$j?'J,$1$7$J$$!#3+JD>uBV$K$h$j?'J,$1$9$k!#\e(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)
+ ))
+;; \e$B0zMQ%l%Y%k$G?'J,$1$7$J$$\e(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))))
+
+;; \e$B%a%C%;!<%8%X%C%@\e(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"))))
+;; \e$B0zMQ\e(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"))))
+;; \e$B%5%^%j\e(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))))
+;; (\e$B%9%l%C%I\e(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"))))
+;; \e$B%U%)%k%@\e(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"))))
+;; \e$B%0%k!<%W\e(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"))))
+;; \e$B%9%?!<%H%"%C%W%G%b\e(B
+(my-wl-set-face 'wl-highlight-demo-face
+ '((t (:foreground "blue2"))))
+
+
;;; [[ \e$BFC<l$J@_Dj\e(B ]]
+;; \e$B<+J,$N;22C$7$F$$$k%a!<%j%s%0%j%9%H$N%j%9%H\e(B
+(setq wl-subscribed-mailing-list
+ '("wl@lists.airs.net"
+ "apel-ja@m17n.org"
+ ;;"ml@example.com" ...
+ ))
+
+;; jka-compr \e$B$rMxMQ$7$F\e(B ~/elmo/SPEC/ \e$B0J2<$N%G!<%?%Y!<%9$r05=L$9$k\e(B
+;(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")
+
+
;; \e$B%0%k!<%W$r\e(Bcheck\e$B$7$?8e$KL$FI$,$"$k%U%)%k%@$N%0%k!<%W$r<+F0E*$K3+$/\e(B
-;(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)
+ ))
;; \e$B%5%^%jI=<(4X?t$rJQ99$9$k\e(B
;; \e$BF~$l$k@_Dj\e(B(\e$B$?$@$7!$\e(Blocal\e$B%U%)%k%@$N$_\e(B)
;; \e$B<+F0%j%U%!%$%k$KI,MW$J%U%#!<%k%I$b@_Dj\e(B
(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 \e$B$N%a%C%;!<%8$G$"$l$P!$%5%^%j$N\e(B Subject \e$BI=<($K\e(B
-;; ML\e$BL>\e(B \e$B$d\e(B ML\e$B$K$*$1$k%a%C%;!<%8HV9f$bI=<($9$k\e(B
+;;; ML \e$B$N%a%C%;!<%8$G$"$l$P!$%5%^%j$N\e(B Subject \e$BI=<($K\e(B
+;;; ML\e$BL>\e(B \e$B$d\e(B ML\e$B$K$*$1$k%a%C%;!<%8HV9f$bI=<($9$k\e(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)
(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)))
;(autoload 'wl-draft-send-with-imput-async "im-wl")
;(setq wl-draft-send-func 'wl-draft-send-with-imput-async)
-
-;; \e$BC;$$\e(B User-Agent: \e$B%U%#!<%k%I$r;H$&\e(B
-;(setq wl-generate-mailer-string-func
-; (function
-; (lambda ()
-; (wl-generate-user-agent-string-1 nil))))
-
-
-;;; [[ \e$B%F%s%W%l!<%H\e(B ]]
-
;; \e$B%F%s%W%l!<%H$N@_Dj\e(B
(setq wl-template-alist
'(("default"
("^Newsgroups: test.*"
("Organization" . "\e$B%K%e!<%9Ej9F;~$NAH?%L>\e(B"))
))
-
;; \e$B%I%i%U%H:n@.;~\e(B(\e$BJV?.;~\e(B)\e$B$K!$<+F0E*$K%X%C%@$rJQ99$9$k\e(B
-;(add-hook 'wl-mail-setup-hook
-; '(lambda ()
-; (unless wl-draft-reedit ; \e$B:FJT=8;~$OE,MQ$7$J$$\e(B
-; (wl-draft-config-exec wl-draft-config-alist))))
-
-
-;;; [[ \e$BJV?.;~$N@_Dj\e(B ]]
-
-;; \e$BJV?.;~$N%&%#%s%I%&$r9-$/$9$k\e(B
-;(setq wl-draft-reply-buffer-style 'full)
-
-;; \e$BJV?.;~$N%X%C%@$KAj<j$NL>A0$rF~$l$J$$!#\e(B
-;(setq wl-draft-reply-use-address-with-full-name nil)
+; (add-hook 'wl-mail-setup-hook
+; '(lambda ()
+; (unless wl-draft-reedit ;; \e$B:FJT=8;~$OE,MQ$7$J$$\e(B
+; (wl-draft-config-exec wl-draft-config-alist))))
;; \e$B%a!<%k$NJV?.;~$K08@h$rIU$1$kJ}?K$N@_Dj\e(B
+
;; \e$B2<5-JQ?t$N\e(B alist \e$B$NMWAG\e(B
-;; ("\e$BJV?.85$KB8:_$9$k%U%#!<%k%I\e(B" .
+;; ('\e$BJV?.85$KB8:_$9$k%U%#!<%k%I\e(B' .
;; ('To\e$B%U%#!<%k%I\e(B' 'Cc\e$B%U%#!<%k%I\e(B' 'Newsgroups\e$B%U%#!<%k%I\e(B'))
-;; "a" (without-argument)\e$B$G$O\e(B Reply-To: \e$B$d\e(B From: \e$B$J$I$G;XDj$5$l$?M#0l?M\e(B
-;; \e$B$^$?$OM#0l$D$NEj9F@h$KJV?.$9$k!#$^$?!$\e(BX-ML-Name: \e$B$H\e(B Reply-To: \e$B$,$D$$\e(B
-;; \e$B$F$$$k$J$i\e(B Reply-To: \e$B08$K$9$k!#\e(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)\e$B$G$O\e(B Reply-To \e$B$d\e(B From \e$B$J$I$G;XDj$5$l$?M#0l?M\e(B
+;; \e$B$^$?$OM#0l$D$NEj9F@h$KJV?.$9$k!#$^$?!$\e(BX-ML-Name \e$B$H\e(B Reply-To \e$B$,$D$$\e(B
+;; \e$B$F$$$k$J$i\e(B Reply-To \e$B08$K$9$k!#\e(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)\e$B$G$"$l$P4X78$9$kA4$F$N?M!&Ej9F@h$KJV?.$9$k!#\e(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 \e$B$rI=<($9$k\e(B (\e$BMW\e(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\e$B0J8e\e(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)
)))
;(setq wl-summary-auto-refile-skip-marks nil)
;; \e$B%9%3%"5!G=$N@_Dj\e(B
-;; `wl-score-folder-alist' \e$B$N@_Dj$K4X$o$i$:I,$:\e(B "all.SCORE" \e$B$O;HMQ$5$l$k!#\e(B
-;(setq wl-score-folder-alist
-; '(("^-comp\\."
-; "news.comp.SCORE"
-; "news.SCORE")
-; ("^-"
-; "news.SCORE")))
-
-;; \e$B%9%3%"%U%!%$%k$rJ]B8$9$k%G%#%l%/%H%j\e(B
+;; wl-score-folder-alist \e$B$N@_Dj$K4X$o$i$:I,$:\e(B "all.SCORE" \e$B$O;HMQ$5$l$k!#\e(B
+; (setq wl-score-folder-alist
+; '(("^-comp\\."
+; "news.comp.SCORE"
+; "news.SCORE")
+; ("^-"
+; "news.SCORE")))
+;; \e$B%9%3%"%U%!%$%k$rCV$/%G%#%l%/%H%j\e(B
; (setq wl-score-files-directory "~/.elmo/")
-;;; dot.wl ends here
+;;;
+;;; end of file
+;;;
(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)
(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)
(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))
(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
(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
2001-06-15 Yuuichi Teranishi <teranisi@gohome.org>
+ * 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 <yasushi@stbbs.net>)
+ * wl-vars.el (wl-folder-process-duplicates-alist): Changed default
+ value to nil (According to the patch from
+ Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>).
+
+ * wl-util.el (wl-biff-check-folder): Call elmo-folder-check instead
+ of elmo-folder-close.
+
2001-06-06 Peter Møller Neergaard <turtle@bu.edu>
* wl-summary.el (wl-summary-resend-bounced-mail): Modified regexp
2001-06-13 Yuuichi Teranishi <teranisi@gohome.org>
+ * 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'.
* 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.
* 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 <kaoru@kaisei.org>
+2001-06-06 Yuuichi Teranishi <teranisi@gohome.org>
- * 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 <muse@ba2.so-net.ne.jp>
+
+ * 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 <okada@opaopa.org>
(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 <okada@opaopa.org>
+
+ * wl.el (wl): Omit `wl-check-environment' if wl-init is nil.
+
+2001-05-10 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-exec-subr): Fixed problem when
+ destination folder is 'null.
+
+2001-05-09 Kenichi OKADA <okada@opaopa.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <kita@coe.nttdata.co.jp>).
+
+2001-05-09 Kenichi OKADA <okada@opaopa.org>
+
+ * wl-folder.el (wl-folder-guess-mailing-list-by-refile-rule): Fix.
+
+2001-05-08 Kenichi OKADA <okada@opaopa.org>
+
+ * wl.el (wl): Fix for wl-demo.
+
+2001-05-08 Kenichi OKADA <okada@opaopa.org>
+
+ * wl-summary.el (wl-summary-supersedes-message): Use 'message-buf'
+
+2001-05-08 Kenichi OKADA <okada@opaopa.org>
+
+ * 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 <okada@opaopa.org>
+
+ * wl-xmas.el (wl-plugged-set-folder-icon): Use `elmo-folder-type'
+ instead of `elmo-folder-get-type'.
+
2001-05-01 TAKAHASHI Kaoru <kaoru@kaisei.org>
* wl-summary.el (wl-summary-write-current-folder): Set cursor
position on Subject: field.
(Advised by Mito <mit@nines.nec.co.jp>)
+2001-04-27 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-folder.el (wl-folder-prefetch-entity): Use
+ `wl-folder-get-elmo-folder'.
+
+2001-04-26 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <kaoru@kaisei.org>
+
+ * wl-version.el (wl-version-status): Set to "alpha".
+
+2001-04-23 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-summary.el (wl-summary-set-message-buffer-or-redisplay):
+ Check wl-message-buffer lives before set-buffer.
+
+2001-04-22 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+
+ * 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 <kaoru@kaisei.org>
+
+ * wl-version.el (wl-version-status): New variable.
+ (wl-version-status-alist): Removed.
+ (wl-version-status): Rule included.
+
+2001-04-19 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <kita@coe.nttdata.co.jp>).
+
+2001-04-17 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-vars.el (toplevel): Require 'elmo-util.
+
+2001-04-16 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-folder.el (wl-folder-check-one-entity): Fixed last change.
+
+2001-04-13 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
* 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 <teranisi@gohome.org>
+
+ * 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 <muse@ba2.so-net.ne.jp>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * wl-expire.el (wl-expire-refile): Fixed.
+
2001-04-02 Yuuichi Teranishi <teranisi@gohome.org>
* wl-vars.el (wl-biff-unnotify-hook): New variable.
* wl-util.el (wl-biff-notify): Run `wl-biff-unnotify-hook' when
biff notification is removed.
-2001-03-20 TAKAHASHI Kaoru <kaoru@kaisei.org>
+ * 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 <teranisi@gohome.org>
+ * 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 <okazaki@be.to>
+ * 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 <teranisi@gohome.org>
-2001-03-12 OKAZAKI Tetsurou <okazaki@be.to>
+ * 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 <teranisi@gohome.org>
+ * 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 <okada@opaopa.org>
+ * 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 <kaoru@kaisei.org>
+ * 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 <kaoru@kaisei.org>
-2001-03-07 TAKAHASHI Kaoru <kaoru@kaisei.org>
+ * 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 <okada@opaopa.org>
- * 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 <kaoru@kaisei.org>
+
+ * wl-folder.el (wl-folder-guess-mailing-list-by-folder-name):
+ Fixed `match-beginning' argument mismatch.
2001-03-05 Katsumi Yamaoka <yamaoka@jpl.org>
* wl-demo.el (wl-demo): Reset `tab-width' and `tab-stop-list' to
the default value.
-2001-03-03 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+2001-03-01 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <kaoru@kaisei.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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" <sagata@nttvdt.hil.ntt.co.jp>
+
+ * 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 <okada@opaopa.org>
+
+ * 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 <teranisi@gohome.org>
simple quotation to quote the anonymous function.
* tm-wl.el (wl-draft-preview-message): Ditto.
-2001-02-26 "A. SAGATA" <sagata@nttvdt.hil.ntt.co.jp>
-
- * 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 <okada@opaopa.org>
-
- * 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 <muse@ba2.so-net.ne.jp>
-
- * 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 <okazaki@be.to>
* wl-highlight.el (wl-highlight-summary-displaying): Optimize;
* 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.
(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.
* 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 <mokkun@iname.com>)
+ * wl-folder.el (wl-folder): Call `sit-for' before `wl-folder-init'.
+
+2001-02-20 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-vars.el (wl-biff-notify-hook): Set default value as '(beep).
2001-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
(wl-demo-image-type-alist): Use `image-type-available-p' for
checking whether the image type `xbm' is available.
+2000-02-20 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-summary.el (wl-summary-sync): Rename 'all-shown' to `all-visible'.
+ (wl-summary-input-range): Ditto.
+
+2001-02-20 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <mokkun@iname.com>)
+
2000-02-20 Kenichi OKADA <okada@opaopa.org>
* wl-summary.el (wl-summary-sync): Change `all-visible'
* wl-demo.el: Work also with BITMAP-MULE under Emacs 21.
(wl-demo-image-type-alist): New macro.
+2001-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * wl-draft.el (wl-draft-parse-msg-id-list-string): Fix.
+
+2001-02-06 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-summary.el (wl-summary-save-view): Renamed from
+ `wl-summary-save-status'.
+
2000-02-20 Kenichi OKADA <okada@opaopa.org>
* wl-summary.el (wl-summary-sync): Added `all-shown'
* wl-summary.el (wl-summary-sync-update3): Bind 'nohide as t if sync-all.
-2001-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * 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 <okazaki@be.to>
* wl-highlight.el (wl-highlight-summary-line-string): Use
2001-02-14 Yuuichi Teranishi <teranisi@gohome.org>
- * 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 <teranisi@gohome.org>
+2001-01-19 Yuuichi Teranishi <teranisi@gohome.org>
- * 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 <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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.
+
+\f
2001-02-06 Yuuichi Teranishi <teranisi@gohome.org>
* wl-mime.el (wl-draft-preview-message):
(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'.
(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)
(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)
(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."
(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))
(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."
(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")
(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
(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
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))))
(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
(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
(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))
(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))
(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)
(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 ()
(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...")
(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))
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)))))
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
(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))
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"))
(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")))))
(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))
(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)
(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)
(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
(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))
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))
(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)
(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
(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)
;;; Code:
;;
+(require 'elmo)
(eval-when-compile
(require 'wl-folder)
(require 'wl-summary)
((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)))
(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))
(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)
(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)
(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)
(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))
(require 'wl-summary)
(require 'wl-thread)
(require 'wl-folder)
+(require 'elmo)
;;; Code:
(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
(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)))
(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
&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)
(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))))))
(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
(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
(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
(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))
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."
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
((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)))
(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)
(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)
(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
(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))))))))))
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.
(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")))))))
(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
(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)
(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)
(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))
(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 ()
(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))
(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
(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)
(require 'elmo-vars)
(require 'elmo-util)
-(require 'elmo2)
+(require 'elmo)
(require 'wl-vars)
(condition-case ()
(require 'easymenu) ; needed here.
(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.
(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)
["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]
(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)
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
(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))
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
(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)
(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))
(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
(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))
;(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
(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)
(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)
(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))
(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)
(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)))))))))
(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))))))
(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)
(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))
(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)
(save-excursion
(wl-folder-insert-entity " " wl-folder-entity)))
(set-buffer-modified-p nil)
- ;(sit-for 0)
(setq initialize t))
initialize))
(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)
(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)))
(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)
(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)))
(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))
(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)))
;; (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)
((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))
(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
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."
(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
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)
(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)
(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))))
'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)
;; 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)
(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))
(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)
(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)
(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))
(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.
(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))))
(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.
(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)
(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)
(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)
(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))
(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))
(require 'mime-view)
(require 'mime-edit)
(require 'mime-play)
-(require 'mmelmo)
+(require 'elmo)
(eval-when-compile
(defalias-maybe 'Meadow-version 'ignore))
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
(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)
(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.")
(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
;; 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)
(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)
'((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))
'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
(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))
(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
(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)))
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)
(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)
(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)
(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
(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)
(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
(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)))
(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))))
(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))
(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)
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))
(/ (* 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)
(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))
(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))
(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 ()
(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 ()
;;; Code:
;;
-(require 'elmo2)
+(require 'elmo)
(require 'elmo-multi)
(require 'wl-message)
(require 'wl-vars)
(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)
(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)
(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)
(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)
(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)
(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)
(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)
(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))
(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)
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)))
(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))
(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)
(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)
(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))
(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)))))))))
(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))
(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)
(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)
;;;(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))
"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))
(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)
(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)
"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)
(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
(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.
(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."
(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))
(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)
(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)
(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))))
(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.
(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.
"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)
(< 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)
(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 " "))
(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))))))))
(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))
(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)))
(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)
(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)
(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)
(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 " ")
(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)
(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
(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)
(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)
(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 -> !
(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)))
(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))
(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)
(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))
(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))
(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
(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
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)
;;
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)
(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 " "
(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))
(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."
(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
(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)
(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
(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)
(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
(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))
((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)
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))
;; 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.
(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
(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)
(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))
(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))
(+ 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)
(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
(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
;; 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)))))
;; 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
(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))
(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)
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)
(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)
(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/"
(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))
(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)
(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))
(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))
(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))))
;; 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)
(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 "*")
(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
"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)
(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 ()
(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))
(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)
(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
(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 ()
(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 ()
(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 ()
(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)
(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)
(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
(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)
(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
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)
(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))
"..../..") 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 " "))
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))
(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)))
(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)))))
(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)
(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))))
(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)
(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
(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)
((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))
(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
(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!!
;; 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))))
))))
(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
(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))
)))))
(defun wl-summary-next-line-content ()
+ "Show next line of the message."
(interactive)
(let ((cur-buf (current-buffer)))
(wl-summary-toggle-disp-msg 'on)
(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")
(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)
(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)
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\" <y/n/s(elect)>?"
- 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))
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
(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? "
(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))
"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."
(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
(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)
(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)))))
(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))
(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
(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))
(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
(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
(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)))
(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)
(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
(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
(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
(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 ()
(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
(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
"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)
(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 "")))))
(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)
(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
(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 ""))))
(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)))
(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
(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
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)
(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))))
(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)))
(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
(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)))
(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)
(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
(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)))))
(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))
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
(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)))
(/ (* 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
(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
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
(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
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))
(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.
(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 ()
(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)
(` (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
">"))
;;; 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))
;;;
(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
(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)
(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)))
(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))
;;
(require 'elmo-vars)
+(require 'elmo-util)
(if (module-installed-p 'custom)
(require 'custom))
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)
(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"))
(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)
"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
"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."
: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
: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)
(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)
: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."
(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"))
'(("^-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
: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
: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)
: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
(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)
"*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"
(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))
"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.")
+
+\f
;; set version-string
(product-version-as-string 'wl-version)
(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)
(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
((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
(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))
(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)
(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))
;;; Code:
;;
-(require 'elmo2)
+(require 'elmo)
(require 'wl-version) ; reduce recursive-load-depth
;; from x-face.el
(require 'wl-highlight)
(eval-when-compile
+ (require 'cl)
(require 'smtp)
(require 'wl-score)
(unless wl-on-nemacs
(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
(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))
;;; 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
(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
(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))
(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)))
(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 ()
(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))
(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
(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)
(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 ()
(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)
(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
projects / elisp / wanderlust.git / commitdiff