From b4797aab71fd65cc8857bcecd240879e893fdd04 Mon Sep 17 00:00:00 2001 From: teranisi Date: Mon, 24 Mar 2003 01:10:36 +0000 Subject: [PATCH] Synch up with main trunk. --- ChangeLog | 5 + WL-MK | 9 +- doc/texinfo.tex | 123 ++++++++++++++---------- doc/version.tex | 2 +- doc/version.texi | 2 +- doc/wl-ja.texi | 23 +++-- doc/wl.texi | 17 +++- elmo/ChangeLog | 51 ++++++++++ elmo/elmo-archive.el | 16 ++-- elmo/elmo-imap4.el | 6 +- elmo/elmo-localdir.el | 19 ++-- elmo/elmo-maildir.el | 14 +++ elmo/elmo-nntp.el | 10 +- elmo/elmo-pipe.el | 22 +++++ elmo/elmo-shimbun.el | 116 +++++++++++++--------- elmo/elmo-version.el | 2 +- elmo/elmo.el | 5 + tests/ChangeLog | 5 + tests/check-modules.el | 3 +- wl/ChangeLog | 157 ++++++++++++++++++++++++++++++ wl/wl-draft.el | 61 +++++++++--- wl/wl-e21.el | 6 +- wl/wl-expire.el | 4 +- wl/wl-fldmgr.el | 55 ++++++----- wl/wl-folder.el | 189 +++++++++++++++++++++++++----------- wl/wl-mime.el | 12 ++- wl/wl-mule.el | 6 +- wl/wl-score.el | 9 +- wl/wl-summary.el | 250 ++++++++++++++++++++++-------------------------- wl/wl-thread.el | 1 + wl/wl-vars.el | 17 +++- wl/wl-xmas.el | 6 +- 32 files changed, 840 insertions(+), 383 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4135398..0dd38cd 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2003-02-05 Yoichi NAKAYAMA + + * WL-MK (make-wl-news): Replace "^(" by "\\\\(" to avoid font-lock + confusion. + 2003-01-17 TAKAHASHI Kaoru * WL-MK (test-wl): Added `make-wl-news'. diff --git a/WL-MK b/WL-MK index a3cd3a0..9823afd 100644 --- a/WL-MK +++ b/WL-MK @@ -486,7 +486,14 @@ (if wl-news-lang (progn (insert "(defconst wl-news-news-alist\n '") - (prin1 (wl-news-parse-news wl-news-lang) (current-buffer)) + (let ((p (point))) + (prin1 (wl-news-parse-news wl-news-lang) (current-buffer)) + (save-excursion + (narrow-to-region p (point)) + (goto-char (1+ p)) + (while (re-search-forward "^(" nil t) + (replace-match "\\\\(")) ; avoid font-lock confusion + (widen))) (insert ")\n")) (insert "(defconst wl-news-news-alist nil)\n\n")) (let ((buffer-file-coding-system (mime-charset-to-coding-system 'x-ctext))) diff --git a/doc/texinfo.tex b/doc/texinfo.tex index 7c912ca..5f84db7 100644 --- a/doc/texinfo.tex +++ b/doc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2003-01-27.08} +\def\texinfoversion{2003-01-31.17} % % Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. @@ -558,6 +558,16 @@ % therefore, no glue is inserted, and the space between the headline and % the text is small, which looks bad. % +% Another complication is that the group might be very large. This can +% cause the glue on the previous page to be unduly stretched, because it +% does not have much material. In this case, it's better to add an +% explicit \vfill so that the extra space is at the bottom. The +% threshold for doing this is if the group is more than \vfilllimit +% percent of a page (\vfilllimit can be changed inside of @tex). +% +\newbox\groupbox +\def\vfilllimit{0.7} +% \def\group{\begingroup \ifnum\catcode13=\active \else \errhelp = \groupinvalidhelp @@ -571,10 +581,22 @@ % above. But it's pretty close. \def\Egroup{% \egroup % End the \vtop. + % \dimen0 is the vertical size of the group's box. + \dimen0 = \ht\groupbox \advance\dimen0 by \dp\groupbox + % \dimen2 is how much space is left on the page (more or less). + \dimen2 = \pageheight \advance\dimen2 by -\pagetotal + % if the group doesn't fit on the current page, and it's a big big + % group, force a page break. + \ifdim \dimen0 > \dimen2 + \ifdim \pagetotal < \vfilllimit\pageheight + \page + \fi + \fi + \copy\groupbox \endgroup % End the \group. }% % - \vtop\bgroup + \setbox\groupbox = \vtop\bgroup % We have to put a strut on the last line in case the @group is in % the midst of an example, rather than completely enclosing it. % Otherwise, the interline space between the last line of the group @@ -3202,28 +3224,24 @@ width0pt\relax} \fi \def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now % so it will be output as is; and it will print as backslash. % - \def\thirdarg{#3}% - % - % If third arg is present, precede it with space in sort key. - \ifx\thirdarg\emptymacro - \let\subentry = \empty - \else - \def\subentry{ #3}% - \fi - % - % First process the index entry with all font commands turned - % off to get the string to sort by. - {\indexnofonts \xdef\indexsorttmp{#2\subentry}}% - % - % Now the real index entry with the fonts. + % The main index entry text. \toks0 = {#2}% % - % If the third (subentry) arg is present, add it to the index - % line to write. + % If third arg is present, precede it with space in sort key. + \def\thirdarg{#3}% \ifx\thirdarg\emptymacro \else - \toks0 = \expandafter{\the\toks0{#3}}% + % If the third (subentry) arg is present, add it to the index + % line to write. + \toks0 = \expandafter{\the\toks0 \space #3}% \fi % + % Process the index entry with all font commands turned off, to + % get the string to sort by. + {\indexnofonts + \edef\temp{\the\toks0}% need full expansion + \xdef\indexsorttmp{\temp}% + }% + % % Set up the complete index entry, with both the sort key and % the original text, including any font commands. We write % three arguments to \entry to the .?? file (four in the @@ -3254,12 +3272,11 @@ width0pt\relax} \fi \iflinks \ifvmode \skip0 = \lastskip - \ifdim\lastskip = 0pt \else \nobreak\vskip-\lastskip \fi + \ifdim\lastskip = 0pt \else \nobreak\vskip-\skip0 \fi \fi % \temp % do the write % - % \ifvmode \ifdim\skip0 = 0pt \else \nobreak\vskip\skip0 \fi \fi \fi }% @@ -4094,7 +4111,7 @@ width0pt\relax} \fi }% % Add extra space after the heading -- either a line space or a % paragraph space, whichever is more. (Some people like to set - % \parskip to large values for some reason.) + % \parskip to large values for some reason.) Don't allow stretch, though. \nobreak \ifdim\parskip>\normalbaselineskip \kern\parskip @@ -4167,7 +4184,7 @@ width0pt\relax} \fi \advance\hsize by -\contentsrightmargin % Don't use the full line length. % % Roman numerals for page numbers. - \ifnum \pageno>0 \pageno = \lastnegativepageno \fi + \ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi } @@ -4184,7 +4201,7 @@ width0pt\relax} \fi \pdfmakeoutlines \endgroup \lastnegativepageno = \pageno - \pageno = \savepageno + \global\pageno = \savepageno } % And just the chapters. @@ -4216,7 +4233,7 @@ width0pt\relax} \fi \contentsalignmacro % in case @setchapternewpage odd is in effect \endgroup \lastnegativepageno = \pageno - \pageno = \savepageno + \global\pageno = \savepageno } \let\shortcontents = \summarycontents @@ -5003,8 +5020,11 @@ width0pt\relax} \fi % If there are two @def commands in a row, we'll have a \nobreak, % which is there to keep the function description together with its % header. But if there's nothing but headers, we want to allow a - % break after all. - \ifnum\lastpenalty=10000 \penalty0 \fi + % break after all. Check for penalty 10002 (inserted by + % \defargscommonending) instead of 10000, since the sectioning + % commands insert a \penalty10000, and we don't want to allow a break + % between a section heading and a defun. + \ifnum\lastpenalty=10002 \penalty0 \fi \medbreak % % Define the \E... end token that this defining construct specifies @@ -5162,9 +5182,18 @@ width0pt\relax} \fi % Define @defun. -% First, define the processing that is wanted for arguments of \defun -% Use this to expand the args and terminate the paragraph they make up +% This is called to end the arguments processing for all the @def... commands. +% +\def\defargscommonending{% + \interlinepenalty = 10000 + \advance\rightskip by 0pt plus 1fil + \endgraf + \nobreak\vskip -\parskip + \penalty 10002 % signal to \parsebodycommon. +} +% This expands the args and terminates the paragraph they comprise. +% \def\defunargs#1{\functionparens \sl % Expand, preventing hyphenation at `-' chars. % Note that groups don't affect changes in \hyphenchar. @@ -5173,9 +5202,7 @@ width0pt\relax} \fi #1% {\tensl\hyphenchar\font=45}% \ifnum\parencount=0 \else \errmessage{Unbalanced parentheses in @def}\fi% -\interlinepenalty=10000 -\advance\rightskip by 0pt plus 1fil -\endgraf\nobreak\vskip -\parskip\nobreak + \defargscommonending } \def\deftypefunargs #1{% @@ -5184,9 +5211,7 @@ width0pt\relax} \fi % Use \boldbraxnoamp, not \functionparens, so that & is not special. \boldbraxnoamp \tclose{#1}% avoid \code because of side effects on active chars -\interlinepenalty=10000 -\advance\rightskip by 0pt plus 1fil -\endgraf\nobreak\vskip -\parskip\nobreak + \defargscommonending } % Do complete processing of one @defun or @defunx line already parsed. @@ -5271,9 +5296,11 @@ width0pt\relax} \fi \defopparsebody\Edefop\defopx\defopheader\defoptype} % \def\defopheader#1#2#3{% -\dosubind {fn}{\code{#2}}{\putwordon\ #1}% Make entry in function index -\begingroup\defname {#2}{\defoptype\ \putwordon\ #1}% -\defunargs {#3}\endgroup % + \dosubind{fn}{\code{#2}}{\putwordon\ \code{#1}}% function index entry + \begingroup + \defname{#2}{\defoptype\ \putwordon\ #1}% + \defunargs{#3}% + \endgroup } % @deftypeop CATEGORY CLASS TYPE OPERATION ARG... @@ -5340,9 +5367,11 @@ width0pt\relax} \fi \defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype} \def\defcvarheader #1#2#3{% -\dosubind {vr}{\code{#2}}{\putwordof\ #1}% Make entry in var index -\begingroup\defname {#2}{\defcvtype\ \putwordof\ #1}% -\defvarargs {#3}\endgroup % + \dosubind{vr}{\code{#2}}{\putwordof\ \code{#1}}% variable index entry + \begingroup + \defname{#2}{\defcvtype\ \putwordof\ #1}% + \defvarargs{#3}% + \endgroup } % @defivar CLASS VARNAME == @defcv {Instance Variable} CLASS VARNAME @@ -5350,7 +5379,7 @@ width0pt\relax} \fi \def\defivar{\defvrparsebody\Edefivar\defivarx\defivarheader} % \def\defivarheader#1#2#3{% - \dosubind {vr}{\code{#2}}{\putwordof\ #1}% entry in var index + \dosubind{vr}{\code{#2}}{\putwordof\ \code{#1}}% entry in var index \begingroup \defname{#2}{\putwordInstanceVariableof\ #1}% \defvarargs{#3}% @@ -5362,8 +5391,8 @@ width0pt\relax} \fi % This is actually simple: just print them in roman. % This must expand the args and terminate the paragraph they make up \def\defvarargs #1{\normalparens #1% -\interlinepenalty=10000 -\endgraf\nobreak\vskip -\parskip\nobreak} + \defargscommonending +} % @defvr Counter foo-count @@ -5399,8 +5428,7 @@ width0pt\relax} \fi \def\deftypevarheader #1#2{% \dovarind#2 \relax% Make entry in variables index \begingroup\defname {\defheaderxcond#1\relax$.$#2}{\putwordDeftypevar}% -\interlinepenalty=10000 -\endgraf\nobreak\vskip -\parskip\nobreak + \defargscommonending \endgroup} \def\dovarind#1 #2\relax{\doind{vr}{\code{#1}}} @@ -5410,8 +5438,7 @@ width0pt\relax} \fi \def\deftypevrheader #1#2#3{\dovarind#3 \relax% \begingroup\defname {\defheaderxcond#2\relax$.$#3}{#1} -\interlinepenalty=10000 -\endgraf\nobreak\vskip -\parskip\nobreak + \defargscommonending \endgroup} % Now define @deftp diff --git a/doc/version.tex b/doc/version.tex index e4f17d3..8b37edd 100644 --- a/doc/version.tex +++ b/doc/version.tex @@ -1 +1 @@ -\def\versionnumber{2.11.1} +\def\versionnumber{2.11.3} diff --git a/doc/version.texi b/doc/version.texi index 092d744..2d6094d 100644 --- a/doc/version.texi +++ b/doc/version.texi @@ -1 +1 @@ -@set VERSION 2.11.1 +@set VERSION 2.11.3 diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index a6f0e7a..22bf166 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -6303,18 +6303,27 @@ pop3 × △ △ △ @chapter メッセージの振り分け @cindex Split messages -@code{elmo-split} を使うと、フォルダ @code{elmo-split-folder} 内の -メッセージを特定の規則に従って @command{procmail} 風に振り分けることが -できます。 この機能を使うには、まず @file{~/.emacs} に以下のように設定 -して下さい。 +@code{elmo-split} を使うと、変数 @code{elmo-split-folder} で指定したフ +ォルダ内のメッセージを特定の規則に従って @command{procmail} 風に振り分 +けることができます。 +この機能を使うには、まず @file{~/.emacs} に以下のように設定して下さい。 @lisp (autoload 'elmo-split "elmo-split" "Split messages on the folder." t) @end lisp -@kbd{M-x elmo-split} すると @code{elmo-split-rule} に従って振り分けを -実行します。 @kbd{C-u M-x elmo-split} とすると実際には振り分けを行わずに -リハーサルを行ないます。 +振り分け元のフォルダを以下のように設定します。 + +@lisp +(setq elmo-split-folder "%inbox") +@end lisp + +振り分けのルールは変数 @code{elmo-split-rule} に記述します(書き方は後で +説明します)。 +以上の設定をした上で @kbd{M-x elmo-split} すると @code{elmo-split-rule} +に従って振り分けを実行します。 @kbd{C-u M-x elmo-split} とすると実際には +振り分けはせずにリハーサルを行ない、その結果を表示します。 + 以下ではルールの記述の仕方を説明します。まずは次の例を見て下さい。 diff --git a/doc/wl.texi b/doc/wl.texi index 5747659..59f53cf 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -6382,18 +6382,27 @@ pop3 N E E E @chapter Message splitting @cindex Split messages -You can use @code{elmo-split} to split message in folder -@code{elmo-split-folder} a la @command{procmail} according to some -specified rules. To use this feature, set as follows in your +You can use @code{elmo-split} to split message in folder specified by +the variable @code{elmo-split-folder} a la @command{procmail} according +to some specified rules. To use this feature, set as follows in your @file{~/.emacs} at first. @lisp (autoload 'elmo-split "elmo-split" "Split messages on the folder." t) @end lisp +Set source folder like following. + +@lisp +(setq elmo-split-folder "%inbox") +@end lisp + +And specify the rule in the variable @code{elmo-split-rule} (its format +will be is described below). Then you can invoke @kbd{M-x elmo-split} to split messages according to @code{elmo-split-rule}. On the other hand, invoke @kbd{C-u M-x elmo-split} -to do a rehearsal (do not split actually). +to do a rehearsal and show result (do not split actually). + We will describe how to specify the rule. First of all, see following example, please. diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 76c861b..45eceb6 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -6,6 +6,57 @@ * elmo-imap4.el (elmo-folder-msgdb-create-plugged): Bind print-level, print-depth. +2003-02-16 Yoichi NAKAYAMA + + * elmo.el (elmo-folder-rename-internal): New method to cause error. + + * elmo-localdir.el (elmo-folder-pack-numbers): onum, a member of + flist, is not always a member of onum-alist. + +2003-02-14 Yoichi NAKAYAMA + + * elmo-version.el (elmo-version): Up to 2.11.3. + +2003-02-10 Yoichi NAKAYAMA + + * elmo-maildir.el (elmo-folder-rename-internal): New method, + copied from localdir's one. + + * elmo-pipe.el (elmo-folder-rename): New method, rename + destination folder with leaving source folder as it is. + +2003-02-08 KAMO Tomoyuki + + * elmo-nntp.el (elmo-nntp-get-folders-info): Don't use + replace-regexp. + +2003-02-08 Yoichi NAKAYAMA + + * elmo-version.el (elmo-version): Up to 2.11.2. + +2003-02-05 Yoichi NAKAYAMA + + * elmo-shimbun.el (elmo-folder-initialize): Do not call + shimbun-open in case of "@". + (elmo-folder-open-internal): Cope with shimbun = nil case. + (elmo-folder-plugged-p): Ditto. + (elmo-folder-list-subfolders): Make list for "@/" group. + +2003-01-31 Yoichi NAKAYAMA + + * elmo-imap4.el (elmo-folder-expand-msgdb-path): Don't expand + mailbox (e.g. for %~/something). + +2003-01-31 TAKAHASHI Kaoru + + * elmo-localdir.el (elmo-folder-rename-internal): Referctoring; + Replace nested conditional with guard clauses. + +2003-01-30 TAKAHASHI Kaoru + + * elmo-archive.el (elmo-folder-rename-internal): Referctoring; + Replace nested conditional with guard clauses. + 2003-01-29 Yoichi NAKAYAMA * elmo-util.el (elmo-object-save): Bind print-level, print-length. diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 6aa1969..f0ec870 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -469,14 +469,14 @@ TYPE specifies the archiver's symbol." (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) - (if (file-exists-p new-arc) - (error "Already exists: %s" new-arc) - (if (not (file-directory-p new-dir)) - (elmo-make-directory new-dir)) - (rename-file old-arc new-arc) - t)))) + (unless (file-exists-p old-arc) + (error "No such file: %s" old-arc)) + (when (file-exists-p new-arc) + (error "Already exists: %s" new-arc)) + (unless (file-directory-p new-dir) + (elmo-make-directory new-dir)) + (rename-file old-arc new-arc) + t)) (defun elmo-archive-folder-list-subfolders (folder one-level) (if elmo-archive-treat-file diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 31fe36f..e2d3dec 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -1807,15 +1807,15 @@ Return nil if no complete line has arrived." (setq mailbox "inbox")) (if (eq (string-to-char mailbox) ?/) (setq mailbox (substring mailbox 1 (length mailbox)))) - (expand-file-name - mailbox + (concat ; don't use expand-file-name (e.g. %~/something) (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-directory))))))) + elmo-msgdb-directory))) + "/" mailbox)))) (luna-define-method elmo-folder-status-plugged ((folder elmo-imap4-folder)) diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index 787ce67..7308144 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -307,14 +307,14 @@ (let* ((old (elmo-localdir-folder-directory-internal folder)) (new (elmo-localdir-folder-directory-internal new-folder)) (new-dir (directory-file-name (file-name-directory new)))) - (if (not (file-directory-p old)) - (error "No such directory: %s" old) - (if (file-exists-p new) - (error "Already exists directory: %s" new) - (if (not (file-directory-p new-dir)) - (elmo-make-directory new-dir)) - (rename-file old new) - t)))) + (unless (file-directory-p old) + (error "No such directory: %s" old)) + (when (file-exists-p new) + (error "Already exists directory: %s" new)) + (unless (file-directory-p new-dir) + (elmo-make-directory new-dir)) + (rename-file old new) + t)) (defsubst elmo-localdir-field-condition-match (folder condition number number-list) @@ -351,7 +351,8 @@ (elmo-msgdb-overview-get-entity onum msgdb) new-number) ;; update number-alist - (setcar (assq onum onum-alist) new-number)) + (and (assq onum onum-alist) + (setcar (assq onum onum-alist) new-number))) ;; update mark-alist (when (setq mark (cadr (assq onum omark-alist))) (setq new-mark-alist diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el index 583b39a..1558a9a 100644 --- a/elmo/elmo-maildir.el +++ b/elmo/elmo-maildir.el @@ -491,6 +491,20 @@ file name for maildir directories." t) (error nil)))) +(luna-define-method elmo-folder-rename-internal ((folder elmo-maildir-folder) + new-folder) + (let* ((old (elmo-maildir-folder-directory-internal folder)) + (new (elmo-maildir-folder-directory-internal new-folder)) + (new-dir (directory-file-name (file-name-directory new)))) + (unless (file-directory-p old) + (error "No such directory: %s" old)) + (when (file-exists-p new) + (error "Already exists directory: %s" new)) + (unless (file-directory-p new-dir) + (elmo-make-directory new-dir)) + (rename-file old new) + t)) + (require 'product) (product-provide (provide 'elmo-maildir) (require 'elmo-version)) diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 69f5a8f..f34d0ea 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -1251,11 +1251,11 @@ Returns a list of cons cells like (NUMBER . VALUE)" (postfix (elmo-nntp-folder-postfix user server port type))) (if (not (string= postfix "")) (save-excursion - (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$" - (concat "\\1" - (elmo-replace-in-string - postfix - "\\\\" "\\\\\\\\\\\\\\\\")))))) + (while (re-search-forward "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\)\\(.*\\)$" nil t) + (replace-match (concat (match-string 1) + (elmo-replace-in-string + postfix + "\\\\" "\\\\\\\\\\\\\\\\"))))))) (let (len min max group) (while (not (eobp)) (condition-case () diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el index c3bdc30..2797298 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -300,6 +300,28 @@ (luna-define-method elmo-folder-pack-numbers ((folder elmo-pipe-folder)) (elmo-folder-pack-numbers (elmo-pipe-folder-dst-internal folder))) +(luna-define-method elmo-folder-rename ((folder elmo-pipe-folder) new-name) + (let* ((new-folder (elmo-make-folder new-name))) + (unless (string= (elmo-folder-name-internal + (elmo-pipe-folder-src-internal folder)) + (elmo-folder-name-internal + (elmo-pipe-folder-src-internal new-folder))) + (error "Source folder differ")) + (unless (eq (elmo-folder-type-internal + (elmo-pipe-folder-dst-internal folder)) + (elmo-folder-type-internal + (elmo-pipe-folder-dst-internal new-folder))) + (error "Not same folder type")) + (if (or (file-exists-p (elmo-folder-msgdb-path + (elmo-pipe-folder-dst-internal new-folder))) + (elmo-folder-exists-p + (elmo-pipe-folder-dst-internal new-folder))) + (error "Already exists folder: %s" new-name)) + (elmo-folder-send (elmo-pipe-folder-dst-internal folder) + 'elmo-folder-rename-internal + (elmo-pipe-folder-dst-internal new-folder)) + (elmo-msgdb-rename-path folder new-folder))) + (require 'product) (product-provide (provide 'elmo-pipe) (require 'elmo-version)) diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 25bf6d0..924e535 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -33,6 +33,9 @@ (require 'elmo-dop) (require 'shimbun) +(eval-when-compile + (defun-maybe shimbun-servers-list ())) + (defcustom elmo-shimbun-check-interval 60 "*Check interval for shimbun." :type 'integer @@ -215,41 +218,44 @@ update overview when message is fetched." (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 + (if (string= name "") + folder + (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 - (nth 1 server-group))) - (elmo-shimbun-folder-set-range-internal - folder - (or (cdr (elmo-string-matched-assoc (elmo-folder-name-internal folder) - elmo-shimbun-index-range-alist)) - elmo-shimbun-default-index-range)) - folder)) + (or (cdr (elmo-string-matched-assoc (elmo-folder-name-internal folder) + elmo-shimbun-index-range-alist)) + elmo-shimbun-default-index-range)) + folder))) (luna-define-method elmo-folder-open-internal ((folder elmo-shimbun-folder)) - (shimbun-open-group - (elmo-shimbun-folder-shimbun-internal folder) - (elmo-shimbun-folder-group-internal folder)) - (let ((inhibit-quit t)) - (unless (elmo-map-folder-location-alist-internal folder) - (elmo-map-folder-location-setup - folder - (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))) - (when (and (elmo-folder-plugged-p folder) - (elmo-shimbun-headers-check-p folder)) - (elmo-shimbun-get-headers folder) - (elmo-map-folder-update-locations - folder - (elmo-map-folder-list-message-locations folder))))) + (when (elmo-shimbun-folder-shimbun-internal folder) + (shimbun-open-group + (elmo-shimbun-folder-shimbun-internal folder) + (elmo-shimbun-folder-group-internal folder)) + (let ((inhibit-quit t)) + (unless (elmo-map-folder-location-alist-internal folder) + (elmo-map-folder-location-setup + folder + (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))) + (when (and (elmo-folder-plugged-p folder) + (elmo-shimbun-headers-check-p folder)) + (elmo-shimbun-get-headers folder) + (elmo-map-folder-update-locations + folder + (elmo-map-folder-list-message-locations folder)))))) (luna-define-method elmo-folder-reserve-status-p ((folder elmo-shimbun-folder)) t) @@ -277,9 +283,11 @@ update overview when message is fetched." (luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder)) (elmo-plugged-p "shimbun" - (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder)) + (and (elmo-shimbun-folder-shimbun-internal folder) + (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))) nil nil - (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder)))) + (and (elmo-shimbun-folder-shimbun-internal folder) + (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))))) (luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder) plugged &optional add) @@ -487,15 +495,37 @@ update overview when message is fetched." (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))))) + (let ((prefix (elmo-folder-prefix-internal folder))) + (cond ((elmo-shimbun-folder-shimbun-internal folder) + (unless (elmo-shimbun-folder-group-internal folder) + (mapcar + (lambda (fld) + (concat prefix + (shimbun-server-internal + (elmo-shimbun-folder-shimbun-internal folder)) + "." fld)) + (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder))))) + ;; the rest are for "@/" group + (one-level + (mapcar + (lambda (server) (list (concat prefix server))) + (shimbun-servers-list))) + (t + (let (folders) + (dolist (server (shimbun-servers-list)) + (setq folders + (append folders + (mapcar + (lambda (fld) (concat prefix server "." fld)) + (shimbun-groups + (shimbun-open server + (let ((fld + (elmo-make-folder + (concat prefix server)))) + (luna-make-entity + 'shimbun-elmo-mua + :folder fld)))))))) + folders))))) (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder)) (if (elmo-shimbun-folder-group-internal folder) diff --git a/elmo/elmo-version.el b/elmo/elmo-version.el index 03728f6..391984c 100644 --- a/elmo/elmo-version.el +++ b/elmo/elmo-version.el @@ -40,7 +40,7 @@ ;; product-define in the first place (product-provide 'elmo-version ;; Don't forget to check `wl-version.el' and Info. - (product-define "ELMO" nil '(2 11 1))) + (product-define "ELMO" nil '(2 11 3))) ;; set version-string (product-version-as-string 'elmo-version) diff --git a/elmo/elmo.el b/elmo/elmo.el index ad62248..2dac126 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -732,6 +732,11 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (elmo-folder-send folder 'elmo-folder-rename-internal new-folder) (elmo-msgdb-rename-path folder new-folder))) +(luna-define-method elmo-folder-rename-internal ((folder elmo-folder) + new-folder) + (error "Cannot rename %s folder" + (symbol-name (elmo-folder-type-internal folder)))) + (defsubst elmo-folder-search-fast (folder condition numbers) (when (and numbers (vectorp condition) diff --git a/tests/ChangeLog b/tests/ChangeLog index 87ee7da..6a81000 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,8 @@ +2003-02-10 TAKAHASHI Kaoru + + * check-modules.el (test-semi-mime-edit): Check + `mime-make-text-tag'. + 2003-01-28 TAKAHASHI Kaoru * check-modules.el (test-apel-version): Renamed from diff --git a/tests/check-modules.el b/tests/check-modules.el index e2328b0..17898c0 100644 --- a/tests/check-modules.el +++ b/tests/check-modules.el @@ -126,7 +126,8 @@ (lunit-assert (fboundp 'mime-edit-content-beginning)) (lunit-assert (fboundp 'mime-edit-content-end)) (lunit-assert (fboundp 'mime-edit-preview-message)) - (lunit-assert (fboundp 'mime-create-tag))) + (lunit-assert (fboundp 'mime-create-tag)) + (lunit-assert (fboundp 'mime-make-text-tag))) (luna-define-method test-semi-mime-view ((case check-modules)) (require 'mime-view) diff --git a/wl/ChangeLog b/wl/ChangeLog index 5a4d194..becd91d 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -6,6 +6,163 @@ * wl-highlight.el: Remove useless dummy functions. +2003-03-19 Yoichi NAKAYAMA + + * wl-fldmgr.el (wl-fldmgr-sort, wl-fldmgr-access-display-all): + Fixed the last change, search group entity by its real name. + (Thanks to: KOBAYASHI Shinji) + +2003-03-12 Yoichi NAKAYAMA + + * wl-fldmgr.el (wl-fldmgr-rename,wl-fldmgr-sort) + (wl-fldmgr-access-display-all): Don't refer visible name. + * wl-expire.el (wl-folder-archive-current-entity) + (wl-folder-expire-current-entity): Ditto. + * wl-folder.el (wl-folder-jump-to-current-entity) + (wl-folder-update-recursive-current-entity,wl-folder-next-unsync) + (wl-folder-open-folder-sub,wl-folder-open-all) + (wl-folder-write-current-folder): Ditto. + (wl-folder-insert-entity): Don't use petname for normal group. + * wl-fldmgr.el (wl-fldmgr-insert-folders-buffer): car of the name + is the real name. + * wl-folder.el (wl-folder-folder-name, wl-folder-entity-name): + Abolished. + +2003-03-06 Kenichi OKADA + + * wl-draft.el (wl-draft-create-buffer): Add + `wl-summary-reply-with-citation' + +2003-03-02 Jeremy Shaw + + * wl-draft.el (wl-draft-reply): Fixed. + +2003-02-28 Yoichi NAKAYAMA + + * wl-draft.el (wl-draft-send-confirm): Rewritten. Invoke preview + when `wl-draft-send-confirm-with-preview' is non-nil. + You can scroll up/down by j/k. + (wl-draft-send-confirm-with-preview): New variable (default=t). + +2003-02-26 Yoichi NAKAYAMA + + * wl-fldmgr.el (wl-fldmgr-folders-header): Add more comment. + (wl-fldmgr-save-folders): Fix comment. + +2003-02-18 Yoichi NAKAYAMA + + * wl-folder.el (wl-folder-update-recursive-current-entity): Fix + along the last change in `wl-folder-buffer-group-p'. + +2003-02-17 Yoichi NAKAYAMA + + * wl-folder.el (wl-folder-buffer-search-group): Ignore non-group + folder. + + * wl-vars.el (wl-delete-folder-alist): Add shimbun folder to + the default value. + + * wl-mime.el (wl-summary-burst): Update summary only when target + folder equals current folder. + +2003-02-16 Yoichi NAKAYAMA + + * wl-thread.el (wl-thread-set-parent): Reconstruct number-list. + +2003-02-14 Yoichi NAKAYAMA + + * wl-vars.el (wl-folder-hierarchy-access-folders): Change default + value. + +2003-02-14 Katsumi Yamaoka + + * wl-xmas.el (wl-xmas-highlight-folder-group-line): Use + `map-extents' instead of `extent-at' repeatedly. + (wl-highlight-folder-current-line): Ditto. + + * wl-highlight.el: Remove useless dummy functions. + +2003-02-14 Yoichi NAKAYAMA + + * wl-folder.el (wl-folder-buffer-group-p): Rewritten. + (wl-folder-put-folder-property): New function to put text property. + (wl-folder-jump-to-current-entity, wl-folder-entity-assign-id) + (wl-folder-insert-entity, wl-folder-update-diff-line) + (wl-folder-update-diff-line, wl-folder-pick): Change accordingly. + * wl-e21.el, wl-xmas.el, wl-mule.el + (wl-highlight-folder-current-line): Ditto. + * wl-fldmgr.el (wl-fldmgr-get-path-from-buffer, wl-fldmgr-cut) + (wl-fldmgr-copy-region, wl-fldmgr-copy, wl-fldmgr-delete) + (wl-fldmgr-rename, wl-fldmgr-sort, wl-fldmgr-unsubscribe) + (wl-fldmgr-access-display-all, wl-fldmgr-set-petname): Ditto. + +2003-02-14 Yoichi NAKAYAMA + + * Version number is increased to 2.11.3. + +2003-02-13 Yoichi NAKAYAMA + + * wl-summary.el (wl-summary-mark-as-read): Run hook within dolist. + Resume current-buffer since it is assumed by remaining tasks. + +2003-02-12 Yoichi NAKAYAMA + + * wl-folder.el (wl-folder-complete-folder-candidate): New variable. + (wl-folder-completion-function): Abolished. + (wl-folder-complete-folder): New function. + (wl-folder-complete-filter-condition): Ditto. + * wl-summary.el (wl-summary-read-folder): Change accordingly. + * wl-fldmgr.el (wl-fldmgr-add): Ditto. + +2003-02-11 Yoichi NAKAYAMA + + * wl-draft.el (wl-draft-send-confirm): New function. + (wl-draft-send): Use it. + + * wl-summary.el (wl-summary-jump-to-msg-by-message-id): Bind + cursor-in-echo-area while confirming. + + * wl-summary.el (wl-summary-virtual): Call wl-summary-virtual-hook. + + * wl-summary.el (wl-summary-jump-to-msg-by-message-id): Force + searching via nntp if wl-summary-search-via-nntp is 'force. + Otherwise, invoke searching in nntp folder only. + * wl-vars.el (wl-summary-search-via-nntp): Change accordingly. + + * wl-draft.el (wl-draft-remove-text-plain-tag): Specify subtype + explicitly for mime-make-text-tag. + +2003-02-10 TAKAHASHI Kaoru + + * wl-draft.el (wl-draft-remove-text-plain-tag): Use + `mime-make-text-tag' instead of `mime-create-tag'. + +2003-02-10 Yoichi NAKAYAMA + + * wl-fldmgr.el (wl-fldmgr-rename): Do nothing on the last line. + (wl-fldmgr-add-completion-subr): Rewrite conditional. + +2003-02-08 Yoichi NAKAYAMA + + * wl-score.el (wl-score-save): Bind print-length and print-level. + (wl-score-pretty-print): Ditto. + (wl-score-edit-insert-header-entry): Ditto. + + * wl-draft.el (wl-draft-send): Remove duplicate "Bcc" and add + "From" entry to be treated with wl-draft-eword-encode-address-list. + * wl-mime.el (wl-draft-preview-message): Ditto. + + * wl-summary.el (wl-summary-mark-as-read): Take list of numbers. + (wl-summary-mark-as-unread): Ditto. + (wl-summary-mark-as-read-region): Change accordingly. + (wl-summary-mark-as-unread-region): Ditto. + (wl-summary-target-mark-mark-as-read): Ditto. + (wl-summary-target-mark-mark-as-unread): Ditto. + +2003-02-08 Yoichi NAKAYAMA + + * Version number is increased to 2.11.2. + 2003-01-29 Yoichi NAKAYAMA * wl-news.el.in (wl-news-previous-version-save): Bind diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 7e20690..e3ba25f 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -336,7 +336,7 @@ Reply to author if WITH-ARG is non-nil." r-to-list)) ","))) (if (and r-cc-list (symbolp r-cc-list)) - (setq cc (wl-concat-list (funcall r-to-list) ",")) + (setq cc (wl-concat-list (funcall r-cc-list) ",")) (setq cc (wl-concat-list (cons cc (elmo-multiple-fields-body-list r-cc-list)) @@ -1255,6 +1255,48 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'." (setq locals (cdr locals))) result)) +(defcustom wl-draft-send-confirm-with-preview t + "Non-nil to invoke preview through confirmation of sending. +This variable is valid when `wl-interactive-send' has non-nil value." + :type 'boolean + :group 'wl-draft) + +(defun wl-draft-send-confirm () + (let (answer) + (unwind-protect + (condition-case quit + (progn + (when wl-draft-send-confirm-with-preview + (wl-draft-preview-message)) + (save-excursion + (goto-char (point-min)) ; to show recipients in header + (catch 'done + (while t + (message "Send current draft? ") + (setq answer (let ((cursor-in-echo-area t)) (read-char))) + (cond + ((or (eq answer ?y) + (eq answer ?Y) + (eq answer ? )) + (throw 'done t)) + ((or (eq answer ?v) + (eq answer ?j) + (eq answer ?J)) + (condition-case err + (scroll-up) + (error nil))) + ((or (eq answer ?^) + (eq answer ?k) + (eq answer ?K)) + (condition-case err + (scroll-down) + (error nil))) + (t + (throw 'done nil))))))) + (quit nil)) + (when wl-draft-send-confirm-with-preview + (mime-preview-quit))))) + (defun wl-draft-send (&optional kill-when-done mes-string) "Send current draft message. If KILL-WHEN-DONE is non-nil, current draft buffer is killed" @@ -1264,17 +1306,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" ;; (wl-draft-config-exec) (run-hooks 'wl-draft-send-hook) (when (or (not wl-interactive-send) - (let (result) - (wl-draft-preview-message) - (goto-char (point-min)) - (condition-case nil - (setq result - (y-or-n-p "Do you really want to send current draft? ")) - (quit - (mime-preview-quit) - (signal 'quit nil))) - (mime-preview-quit) - result)) + (wl-draft-send-confirm)) (let ((send-mail-function 'wl-draft-raw-send) (editing-buffer (current-buffer)) (sending-buffer (wl-draft-generate-clone-buffer @@ -1292,7 +1324,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (let ((mime-header-encode-method-alist (append '((wl-draft-eword-encode-address-list - . (To Cc Bcc Resent-To Resent-Cc Bcc Resent-Bcc))) + . (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From))) (if (boundp 'mime-header-encode-method-alist) (symbol-value 'mime-header-encode-method-alist))))) (run-hooks 'mail-send-hook) ; translate buffer @@ -1611,6 +1643,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (summary-buf (wl-summary-get-buffer parent-folder)) (reply-or-forward (or (eq this-command 'wl-summary-reply) + (eq this-command 'wl-summary-reply-with-citation) (eq this-command 'wl-summary-forward) (eq this-command 'wl-summary-target-mark-forward) (eq this-command 'wl-summary-target-mark-reply-with-citation))) @@ -1888,7 +1921,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (defun wl-draft-remove-text-plain-tag () "Remove text/plain tag of mime-edit." - (when (string= (mime-create-tag "text" "plain") + (when (string= (mime-make-text-tag "plain") (buffer-substring-no-properties (point-at-bol)(point-at-eol))) (delete-region (point-at-bol)(1+ (point-at-eol))))) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 84259de..591cce3 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -311,7 +311,8 @@ (let (fld-name start end) (cond (;; opened folder group - (looking-at wl-highlight-folder-opened-regexp) + (and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-opened-regexp)) (setq start (match-beginning 1) end (match-end 1)) (wl-e21-highlight-folder-group-line start end @@ -321,7 +322,8 @@ 'wl-highlight-folder-opened-face numbers)) (;; closed folder group - (looking-at wl-highlight-folder-closed-regexp) + (and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-closed-regexp)) (setq start (match-beginning 1) end (match-end 1)) (wl-e21-highlight-folder-group-line start end diff --git a/wl/wl-expire.el b/wl/wl-expire.el index d3f2b94..eb3444b 100644 --- a/wl/wl-expire.el +++ b/wl/wl-expire.el @@ -754,7 +754,7 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." (let ((entity-name (or (wl-folder-get-folder-name-by-id (get-text-property (point) 'wl-folder-entity-id)) - (wl-folder-get-realname (wl-folder-folder-name))))) + (wl-folder-get-entity-from-buffer)))) (when (and entity-name (or (not (interactive-p)) (y-or-n-p (format "Expire %s? " entity-name)))) @@ -772,7 +772,7 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." (let ((entity-name (or (wl-folder-get-folder-name-by-id (get-text-property (point) 'wl-folder-entity-id)) - (wl-folder-get-realname (wl-folder-folder-name))))) + (wl-folder-get-entity-from-buffer)))) (when (and entity-name (or (not (interactive-p)) (y-or-n-p (format "Archive %s? " entity-name)))) diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index 993fb78..7da121f 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -51,6 +51,9 @@ # Folder definition file # This file is generated automatically by %s. # +# If you edit this file by hand, be sure that comment lines +# will be washed out by wl-fldmgr. +# " (product-string-1 'wl-version t))) @@ -458,6 +461,7 @@ return value is diffs '(-new -unread -all)." ;;; (wl-fldmgr-get-entity-id (cdr previous-entity)))))) (wl-folder-prev-entity-skip-invalid)) (if (and prev + (wl-folder-buffer-group-p) (looking-at wl-folder-group-regexp) (string= (wl-match-buffer 2) "-")) (setq group-target nil) @@ -593,7 +597,8 @@ return value is diffs '(-new -unread -all)." (wl-delete-entity path nil wl-folder-entity clear))) (setq wl-fldmgr-modified t) ;; - (if (looking-at wl-folder-group-regexp) + (if (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) ;; group (let (beg end indent opened) (setq indent (wl-match-buffer 1)) @@ -647,7 +652,7 @@ return value is diffs '(-new -unread -all)." (while (< (point) to) (and (looking-at "^\\([ ]*\\)") (setq indent (wl-match-buffer 1))) - (if (looking-at wl-folder-group-regexp) + (if (wl-folder-buffer-group-p) (progn (setq errmes "can't copy group folder") (throw 'err t))) @@ -685,7 +690,7 @@ return value is diffs '(-new -unread -all)." (beginning-of-line) (let ((ret-val nil)) (if (and (not ename) - (looking-at wl-folder-group-regexp)) + (wl-folder-buffer-group-p)) (message "Can't copy group folder") (let* ((name (or ename (wl-folder-get-entity-from-buffer))) (entity (elmo-string name))) @@ -796,12 +801,13 @@ return value is diffs '(-new -unread -all)." (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)))))) + (cond + ((null flag) + (try-completion string table predicate)) + ((eq flag 'lambda) + (eq t (try-completion string table predicate))) + (t + (all-completions string table predicate))))) (defun wl-fldmgr-add (&optional name) (interactive) @@ -809,7 +815,7 @@ return value is diffs '(-new -unread -all)." (beginning-of-line) (let ((ret-val nil) (inhibit-read-only t) - (wl-folder-completion-function + (wl-folder-complete-folder-candidate (if wl-fldmgr-add-complete-with-current-folder-list (function wl-fldmgr-add-completion-subr))) tmp indent path diffs) @@ -839,7 +845,7 @@ return value is diffs '(-new -unread -all)." (interactive) (save-excursion (beginning-of-line) - (if (looking-at wl-folder-group-regexp) + (if (wl-folder-buffer-group-p) (error "Can't delete group folder")) (let* ((inhibit-read-only t) (tmp (wl-fldmgr-get-path-from-buffer)) @@ -862,9 +868,10 @@ return value is diffs '(-new -unread -all)." (if (bobp) (message "Can't rename desktop group") (cond - ((looking-at wl-folder-group-regexp) ;; group + ((and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) ;; group (let* ((indent (wl-match-buffer 1)) - (old-group (wl-folder-get-realname (wl-match-buffer 3))) + (old-group (wl-folder-get-entity-from-buffer)) (group-entity (wl-folder-search-group-entity-by-name old-group wl-folder-entity)) group) @@ -900,6 +907,7 @@ return value is diffs '(-new -unread -all)." (let* ((tmp (wl-fldmgr-get-path-from-buffer)) (old-folder (nth 4 tmp)) new-folder) + (unless old-folder (error "No folder")) (setq new-folder (wl-fldmgr-read-string (wl-summary-read-folder old-folder "to rename" t t old-folder))) @@ -1041,11 +1049,12 @@ return value is diffs '(-new -unread -all)." (beginning-of-line) (let ((inhibit-read-only t) entity flist indent opened) - (when (looking-at wl-folder-group-regexp) + (when (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) (setq indent (wl-match-buffer 1)) (setq opened (wl-match-buffer 2)) (setq entity (wl-folder-search-group-entity-by-name - (wl-folder-get-realname (wl-match-buffer 3)) + (wl-folder-get-entity-from-buffer) wl-folder-entity)) (message "Sorting...") (setq flist (sort (nth 2 entity) wl-fldmgr-sort-function)) @@ -1144,7 +1153,7 @@ return value is diffs '(-new -unread -all)." (t (if (and type (< type 0)) nil - (setq is-group (looking-at wl-folder-group-regexp)) + (setq is-group (wl-folder-buffer-group-p)) (setq tmp (wl-fldmgr-get-path-from-buffer)) (setq indent (wl-fldmgr-make-indent (nth 1 tmp))) (if (eq (cdr (nth 2 tmp)) 'access) @@ -1180,13 +1189,15 @@ return value is diffs '(-new -unread -all)." (let ((inhibit-read-only t) entity indent opened unsubscribes beg) - (when (not (looking-at wl-folder-group-regexp)) + (when (not + (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp))) (wl-folder-goto-top-of-current-folder) (looking-at wl-folder-group-regexp)) (setq indent (wl-match-buffer 1)) (setq opened (wl-match-buffer 2)) (setq entity (wl-folder-search-group-entity-by-name - (wl-folder-get-realname (wl-match-buffer 3)) + (wl-folder-get-entity-from-buffer) wl-folder-entity)) (when (eq (nth 1 entity) 'access) (save-excursion @@ -1225,7 +1236,7 @@ return value is diffs '(-new -unread -all)." (interactive) (save-excursion (beginning-of-line) - (let* ((is-group (looking-at wl-folder-group-regexp)) + (let* ((is-group (wl-folder-buffer-group-p)) (name (wl-folder-get-entity-from-buffer)) (searchname (wl-folder-get-petname name)) (pentry (wl-string-assoc name wl-folder-petname-alist)) @@ -1299,10 +1310,8 @@ return value is diffs '(-new -unread -all)." "") "\n")) ((consp name) - (let ((group (wl-folder-get-realname (car name))) + (let ((group (car name)) (type (nth 1 name))) - (if (not (string= group (car name))) ; petname. - (wl-append pet-entities (list (car name)))) (cond ((eq type 'group) (insert indent group "{\n") (setq pet-entities @@ -1344,7 +1353,7 @@ return value is diffs '(-new -unread -all)." (wl-fldmgr-delete-disused-petname) (setq save-petname-entities (wl-fldmgr-insert-folders-buffer "" (nth 2 wl-folder-entity))) - (insert "\n# petname definition (group, folder in access group)\n") + (insert "\n# petname definition (access group, folder in access group)\n") (wl-fldmgr-insert-petname-buffer save-petname-entities) (insert "\n# end of file.\n") (if (and wl-fldmgr-make-backup diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 66fd01b..7e759f9 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -61,7 +61,6 @@ (defvar wl-folder-newsgroups-hashtb nil) (defvar wl-folder-info-alist-modified nil) -(defvar wl-folder-completion-function nil) (defvar wl-folder-mode-map nil) @@ -228,27 +227,20 @@ "")))) (defmacro wl-folder-buffer-group-p () - (` (save-excursion (beginning-of-line) - (looking-at wl-folder-group-regexp)))) - -(defmacro wl-folder-folder-name () - (` (save-excursion - (beginning-of-line) - (if (or (looking-at "^[ ]*\\[[\\+-]\\]\\(.+\\):[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+\n") - (looking-at "^[ ]*\\([^\\[].+\\):.*\n")) - (wl-match-buffer 1))))) - -(defmacro wl-folder-entity-name () - (` (save-excursion - (beginning-of-line) - (if (looking-at "^[ ]*\\([^\\[].+\\):.*\n") - (wl-match-buffer 1))))) + (` (get-text-property (point) 'wl-folder-is-group))) (defun wl-folder-buffer-search-group (group) - (re-search-forward - (concat - "^\\([ \t]*\\)\\[[\\+-]\\]" - (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+") nil t)) + (let ((prev-point (point)) + (group-regexp (concat + "^\\([ \t]*\\)\\[[\\+-]\\]" + (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+"))) + (or (catch 'found + (while (re-search-forward group-regexp nil t) + (if (wl-folder-buffer-group-p) + (throw 'found (point))))) + (progn ; not found + (goto-char prev-point) + nil)))) (defun wl-folder-buffer-search-entity (folder &optional searchname) (let ((search (or searchname (wl-folder-get-petname folder))) @@ -341,6 +333,10 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (wl-folder-elmo-folder-cache-put name folder) folder))))) +(defsubst wl-folder-put-folder-property (beg end id is-group &optional object) + (put-text-property beg end 'wl-folder-entity-id id object) + (put-text-property beg end 'wl-folder-is-group is-group object)) + (defun wl-folder-prev-entity () (interactive) (forward-line -1)) @@ -607,9 +603,10 @@ Optional argument ARG is repeart count." (beginning-of-line) (let (entity beg end indent opened fname err fld-name) (cond - ((looking-at wl-folder-group-regexp) + ((and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) (save-excursion - (setq fname (wl-folder-get-realname (wl-match-buffer 3))) + (setq fname (wl-folder-get-entity-from-buffer)) (setq indent (wl-match-buffer 1)) (setq opened (wl-match-buffer 2)) (if (string= opened "+") @@ -666,7 +663,7 @@ Optional argument ARG is repeart count." ; (wl-delete-all-overlays) ; (wl-highlight-folder-current-line) ))) - ((setq fld-name (wl-folder-entity-name)) + ((setq fld-name (wl-folder-get-entity-from-buffer)) (wl-folder-set-current-entity-id (get-text-property (point) 'wl-folder-entity-id)) (setq fld-name (wl-folder-get-folder-name-by-id @@ -700,14 +697,16 @@ Optional argument ARG is repeart count." (defun wl-folder-update-recursive-current-entity (&optional entity) (interactive) - (when (wl-folder-buffer-group-p) + (beginning-of-line) + (when (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) (cond ((string= (wl-match-buffer 2) "+") (save-excursion (if entity () (setq entity (wl-folder-search-group-entity-by-name - (wl-folder-get-realname (wl-match-buffer 3)) + (wl-folder-get-entity-from-buffer) wl-folder-entity))) (let ((inhibit-read-only t) (entities (list entity)) @@ -1300,10 +1299,11 @@ If current line is group folder, all subfolders are marked." (get-text-property 0 'wl-folder-entity-id (car entity)))) - (put-text-property 0 (length (car entity)) - 'wl-folder-entity-id - wl-folder-entity-id - (car entity)) + (wl-folder-put-folder-property + 0 (length (car entity)) + wl-folder-entity-id + 'is-group + (car entity)) (wl-folder-set-id-name wl-folder-entity-id (car entity) hashtb)) (and entities @@ -1314,10 +1314,11 @@ If current line is group folder, all subfolders are marked." (get-text-property 0 'wl-folder-entity-id entity))) - (put-text-property 0 (length entity) - 'wl-folder-entity-id - wl-folder-entity-id - entity) + (wl-folder-put-folder-property + 0 (length entity) + wl-folder-entity-id + nil + entity) (wl-folder-set-id-name wl-folder-entity-id entity hashtb)))) (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)) @@ -1408,8 +1409,7 @@ If current line is group folder, all subfolders are marked." (if (or (wl-folder-buffer-group-p) (not plugged) (setq entity - (wl-folder-get-realname - (wl-folder-folder-name))) + (wl-folder-get-entity-from-buffer)) (elmo-folder-plugged-p entity)) (throw 'found t)))) (beginning-of-line) @@ -1425,7 +1425,7 @@ If current line is group folder, all subfolders are marked." (if (re-search-backward (wl-folder-unread-regex group) nil t) (progn (beginning-of-line) - (wl-folder-folder-name)) + (wl-folder-get-entity-from-buffer)) (goto-char start-point) (message "No more unread folder") nil))) @@ -1439,7 +1439,7 @@ If current line is group folder, all subfolders are marked." (if (re-search-forward (wl-folder-unread-regex group) nil t) (progn (beginning-of-line) - (wl-folder-folder-name)) + (wl-folder-get-entity-from-buffer)) (goto-char start-point) (message "No more unread folder") nil))) @@ -1702,12 +1702,15 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." ;;; wl-folder-newsgroups-hashtb)))) ;;; (message "fetching folder entries...done")) (insert indent "[" (if as-opened "-" "+") "]" - (wl-folder-get-petname (car entity))) + (if (eq (cadr entity) 'access) + (wl-folder-get-petname (car entity)) + (car entity))) (setq group-name-end (point)) (insert ":0/0/0\n") - (put-text-property beg (point) 'wl-folder-entity-id - (get-text-property 0 'wl-folder-entity-id - (car entity))) + (wl-folder-put-folder-property + beg (point) + (get-text-property 0 'wl-folder-entity-id (car entity)) + 'is-group) (when removed (setq beg (point)) (while removed @@ -1748,15 +1751,18 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (wl-highlight-folder-current-line ret-val))) (setq ret-val (wl-folder-calc-finfo entity)) (insert indent "[" (if as-opened "-" "+") "]" - (wl-folder-get-petname (car entity)) + (if (eq (cadr entity) 'access) + (wl-folder-get-petname (car entity)) + (car entity)) (format ":%d/%d/%d" (or (nth 0 ret-val) 0) (or (nth 1 ret-val) 0) (or (nth 2 ret-val) 0)) "\n") - (put-text-property beg (point) 'wl-folder-entity-id - (get-text-property 0 'wl-folder-entity-id - (car entity))) + (wl-folder-put-folder-property + beg (point) + (get-text-property 0 'wl-folder-entity-id (car entity)) + 'is-group) (save-excursion (forward-line -1) (wl-highlight-folder-current-line ret-val))))) ((stringp entity) @@ -1772,8 +1778,10 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (+ (nth 0 nums)(nth 1 nums)))) "*") (or (setq all (nth 2 nums)) "*"))) - (put-text-property beg (point) 'wl-folder-entity-id - (get-text-property 0 'wl-folder-entity-id entity)) + (wl-folder-put-folder-property + beg (point) + (get-text-property 0 'wl-folder-entity-id entity) + nil) (save-excursion (forward-line -1) (wl-highlight-folder-current-line nums)) (setq ret-val (list new unread all))))) @@ -2153,10 +2161,11 @@ Use `wl-subscribed-mailing-list'." cur-new new-new cur-unread new-unread cur-all new-all - id) + id is-group) (save-excursion (beginning-of-line) (setq id (get-text-property (point) 'wl-folder-entity-id)) + (setq is-group (get-text-property (point) 'wl-folder-is-group)) (when (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*\\)/\\([0-9\\*-]*\\)/\\([0-9\\*]*\\)") ;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)") (setq cur-new (string-to-int @@ -2172,8 +2181,7 @@ Use `wl-subscribed-mailing-list'." (setq new-new (+ cur-new (nth 0 diffs))) (setq new-unread (+ cur-unread (nth 1 diffs))) (setq new-all (+ cur-all (nth 2 diffs))))) - (put-text-property (match-beginning 2) (point) - 'wl-folder-entity-id id) + (wl-folder-put-folder-property (match-beginning 2) (point) id is-group) (if wl-use-highlight-mouse-line (put-text-property (match-beginning 2) (point) 'mouse-face 'highlight)) @@ -2184,10 +2192,11 @@ Use `wl-subscribed-mailing-list'." (defun wl-folder-update-line (nums &optional is-group) (let ((inhibit-read-only t) (buffer-read-only nil) - id) + id is-group) (save-excursion (beginning-of-line) (setq id (get-text-property (point) 'wl-folder-entity-id)) + (setq is-group (get-text-property (point) 'wl-folder-is-group)) (if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)") ;;; (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)") (progn @@ -2200,8 +2209,7 @@ Use `wl-subscribed-mailing-list'." (+ (nth 0 nums)(nth 1 nums))) "*") (or (nth 2 nums) "*"))) - (put-text-property (match-beginning 2) (point) - 'wl-folder-entity-id id) + (wl-folder-put-folder-property (match-beginning 2) (point) id is-group) (if is-group ;; update only colors (wl-highlight-folder-group-line nums) @@ -2436,11 +2444,12 @@ Use `wl-subscribed-mailing-list'." (car path)))))) (beginning-of-line) (setq path (cdr path)) - (if (and (looking-at wl-folder-group-regexp) + (if (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp) (string= "+" (wl-match-buffer 2)));; closed group (save-excursion (setq indent (wl-match-buffer 1)) - (setq name (wl-folder-get-realname (wl-match-buffer 3))) + (setq name (wl-folder-get-entity-from-buffer)) (setq entity (wl-folder-search-group-entity-by-name name wl-folder-entity)) @@ -2499,7 +2508,7 @@ Use `wl-subscribed-mailing-list'." "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n" nil t) (setq indent (wl-match-buffer 1)) - (setq name (wl-folder-get-realname (wl-match-buffer 3))) + (setq name (wl-folder-get-entity-from-buffer)) (setq entity (wl-folder-search-group-entity-by-name name wl-folder-entity)) @@ -2812,7 +2821,7 @@ Call `wl-summary-write-current-folder' with current folder name." (interactive) (unless (wl-folder-buffer-group-p) (wl-summary-write-current-folder - (wl-folder-get-realname (wl-folder-entity-name))))) + (wl-folder-get-entity-from-buffer)))) (defun wl-folder-mimic-kill-buffer () "Kill the current (Folder) buffer with query." @@ -2918,6 +2927,72 @@ Call `wl-summary-write-current-folder' with current folder name." (switch-to-buffer-other-window (car (wl-collect-summary)))) (wl-summary-previous-buffer))) +;;; +;; Completion +(defvar wl-folder-complete-folder-candidate nil) + +(defun wl-folder-complete-folder (string predicate flag) + (cond ((or (string-match "^\\(/[^/]*/\\)\\(.*\\)$" string) ; filter + (string-match "^\\(\*\\|\*.*,\\)\\([^,]*\\)$" string) ; multi + (string-match "^\\(|[^|]*|:?\\)\\(.*\\)$" string) ;pipe-src + (string-match "^\\(|\\)\\([^|]*\\)$" string)) ;pipe-dst + (let* ((str1 (match-string 1 string)) + (str2 (match-string 2 string)) + (str2-comp (wl-folder-complete-folder str2 predicate flag))) + (cond + ((listp str2-comp) ; flag=t + (mapcar (lambda (x) (concat str1 x)) str2-comp)) + ((stringp str2-comp) + (concat str1 str2-comp)) + (t + str2-comp)))) + ((string-match "^\\(/\\)\\([^/]*\\)$" string) ; filter-condition + (let* ((str1 (match-string 1 string)) + (str2 (match-string 2 string)) + (str2-comp + (wl-folder-complete-filter-condition str2 predicate flag))) + (cond + ((listp str2-comp) ; flag=t + (mapcar (lambda (x) (concat str1 x)) str2-comp)) + ((stringp str2-comp) + (concat str1 str2-comp)) + (t + str2-comp)))) + (t + (let ((candidate + (or wl-folder-complete-folder-candidate + (if (memq 'read-folder wl-use-folder-petname) + (wl-folder-get-entity-with-petname) + wl-folder-entity-hashtb)))) + (if (not flag) + (try-completion string candidate) + (all-completions string candidate)))))) + +(defun wl-folder-complete-filter-condition (string predicate flag) + (cond + ((string-match "^\\(.*|\\|.*&\\|.*!\\|.*(\\)\\([^:]*\\)$" string) + (let* ((str1 (match-string 1 string)) + (str2 (match-string 2 string)) + (str2-comp + (wl-folder-complete-filter-condition str2 predicate flag))) + (cond + ((listp str2-comp) ; flag=t + (mapcar (lambda (x) (concat str1 x)) str2-comp)) + ((stringp str2-comp) + (concat str1 str2-comp)) + (t + str2-comp)))) + (t + (let ((candidate + (mapcar (lambda (x) (list (concat (downcase x) ":"))) + (append '("last" "first" + "from" "subject" "to" "cc" "body" + "since" "before" "tocc") + elmo-msgdb-extra-fields)))) + (if (not flag) + (try-completion string candidate) + (all-completions string candidate)))))) + (require 'product) (product-provide (provide 'wl-folder) (require 'wl-version)) diff --git a/wl/wl-mime.el b/wl/wl-mime.el index ce47041..d05930c 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -152,7 +152,7 @@ It calls following-method selected from variable (mime-header-encode-method-alist (append '((wl-draft-eword-encode-address-list - . (To Cc Bcc Resent-To Resent-Cc Bcc Resent-Bcc))) + . (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From))) (if (boundp 'mime-header-encode-method-alist) (symbol-value 'mime-header-encode-method-alist)))) mime-view-ignored-field-list ; all header. @@ -428,12 +428,12 @@ With ARG, ask destination folder." (interactive "P") (let ((raw-buf (wl-summary-get-original-buffer)) (view-buf wl-message-buffer) - children message-entity content-type target) + children message-entity content-type target-name target) (save-excursion (setq target wl-summary-buffer-elmo-folder) (when (or arg (not (elmo-folder-writable-p target))) - (let ((fld (wl-summary-read-folder wl-default-folder "to extract to"))) - (setq target (wl-folder-get-elmo-folder fld)))) + (setq target-name (wl-summary-read-folder wl-default-folder "to extract to")) + (setq target (wl-folder-get-elmo-folder target-name))) (wl-summary-set-message-buffer-or-redisplay) (with-current-buffer view-buf (setq message-entity (get-text-property (point-min) 'mime-view-entity))) @@ -444,7 +444,9 @@ With ARG, ask destination folder." (message "Bursting...done")) (if (elmo-folder-plugged-p target) (elmo-folder-check target))) - (wl-summary-sync-update))) + (when (or (not target-name) + (string= wl-summary-buffer-folder-name target-name)) + (save-excursion (wl-summary-sync-update))))) ;; internal variable. (defvar wl-mime-save-directory nil "Last saved directory.") diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 75038c0..8f3e799 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -57,9 +57,11 @@ Special commands: (start (progn (beginning-of-line) (point))) (inhibit-read-only t) (text-face - (cond ((looking-at wl-highlight-folder-opened-regexp) + (cond ((and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-opened-regexp)) 'wl-highlight-folder-opened-face) - ((looking-at wl-highlight-folder-closed-regexp) + ((and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-closed-regexp)) 'wl-highlight-folder-closed-face) (t (if (looking-at (format "^[ \t]*\\(%s\\|%s\\)" diff --git a/wl/wl-score.el b/wl/wl-score.el index bddb74a..a3eb67b 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -283,7 +283,8 @@ Set `wl-score-cache' nil." (setq score (setcdr entry (wl-delete-alist 'touched score))) (erase-buffer) (let (emacs-lisp-mode-hook - (lisp-mode-syntax-table wl-score-mode-syntax-table)) + (lisp-mode-syntax-table wl-score-mode-syntax-table) + print-length print-level) (pp score (current-buffer))) (setq dir (file-name-directory file)) (if (file-directory-p dir) @@ -1371,7 +1372,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (goto-char (point-min)) (let ((form (read (current-buffer)))) (erase-buffer) - (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table)) + (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table) + print-length print-level) (pp form (current-buffer)))) (goto-char (point-min))) @@ -1468,7 +1470,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (wl-score-update-score-entry (car entry) (nth 1 entry) form) (setq form (list entry))) (erase-buffer) - (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table)) + (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table) + print-length print-level) (pp form (current-buffer))) (goto-char (point-min))))) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 1c046a8..836b2ad 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -1557,59 +1557,48 @@ If ARG is non-nil, checking is omitted." (narrow-to-region beg end) (goto-char (point-min)) (if (eq wl-summary-buffer-view 'thread) - (progn + (let (number-list) (while (not (eobp)) (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) + (entity (wl-thread-get-entity number))) (if (wl-thread-entity-get-opened entity) - ;; opened...mark line. - (wl-summary-mark-as-read number) - ;; closed - (wl-summary-mark-as-read number) ; mark itself. - (setq children (wl-thread-get-children-msgs number)) - (while children - (wl-summary-mark-as-read (car children)) - (setq children (cdr children)))) - (forward-line 1)))) - (while (not (eobp)) - (wl-summary-mark-as-read (wl-summary-message-number)) - (forward-line 1))))) - (wl-summary-count-unread) - (wl-summary-update-modeline)) + (setq number-list (append number-list (list number))) + (setq number-list + (append number-list + (wl-thread-get-children-msgs number)))) + (forward-line 1))) + (wl-summary-mark-as-read number-list)) + (let (number-list) + (while (not (eobp)) + (setq number-list + (append number-list (list (wl-summary-message-number)))) + (forward-line 1)) + (wl-summary-mark-as-read number-list)))))) (defun wl-summary-mark-as-unread-region (beg end) (interactive "r") (save-excursion (save-restriction (narrow-to-region beg end) -;;; use narrowing. -;;; (save-excursion (goto-char end) -;;; (end-of-line) (point))) (goto-char (point-min)) (if (eq wl-summary-buffer-view 'thread) - (progn + (let (number-list) (while (not (eobp)) (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) + (entity (wl-thread-get-entity number))) (if (wl-thread-entity-get-opened entity) - ;; opened...mark line. - ;; Crossposts are not processed - (wl-summary-mark-as-unread) - ;; closed - (wl-summary-mark-as-unread) ; mark itself. - (setq children - (delq number (wl-thread-get-children-msgs number))) - (while children - (wl-summary-mark-as-unread (car children)) - (setq children (cdr children)))) - (forward-line 1)))) - (while (not (eobp)) - (wl-summary-mark-as-unread) - (forward-line 1))))) - (wl-summary-count-unread) - (wl-summary-update-modeline)) + (setq number-list (append number-list (list number))) + (setq number-list + (append number-list + (wl-thread-get-children-msgs number)))) + (forward-line 1))) + (wl-summary-mark-as-unread number-list)) + (let (number-list) + (while (not (eobp)) + (setq number-list + (append number-list (list (wl-summary-message-number)))) + (forward-line 1)) + (wl-summary-mark-as-unread number-list)))))) (defun wl-summary-mark-as-important-region (beg end) (interactive "r") @@ -2804,40 +2793,6 @@ If ARG, without confirm." (wl-thread-make-indent-string thr-entity) (wl-thread-entity-get-linked thr-entity))))))) -(defun wl-summary-mark-as-unread (&optional number - no-folder-mark - no-modeline-update) - (interactive) - (save-excursion - (let ((buffer-read-only nil) - (folder wl-summary-buffer-elmo-folder) - mark new-mark visible) - (setq visible (if number - (wl-summary-jump-to-msg number) - t) - number (or number (wl-summary-message-number)) - mark (elmo-message-mark folder number)) - (unless (member mark (elmo-msgdb-unread-marks)) - (elmo-folder-unmark-read folder (list number) no-folder-mark)) - (setq new-mark (elmo-message-mark folder number)) - (unless no-modeline-update - ;; Update unread numbers. - ;; should elmo-folder-mark-as-read return unread numbers? - (wl-summary-count-unread) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count))) - (when visible - (unless (string= (wl-summary-persistent-mark) new-mark) - (delete-backward-char 1) - (insert (or new-mark " ")) - (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line)) - (set-buffer-modified-p nil))) - number))) - (defun wl-summary-delete (&optional number) "Mark a delete mark 'D'. If optional argument NUMBER is specified, mark message specified by NUMBER." @@ -3111,10 +3066,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (let ((fld (completing-read (format "Folder name %s(%s): " (or purpose "") default) - (or wl-folder-completion-function - (if (memq 'read-folder wl-use-folder-petname) - (wl-folder-get-entity-with-petname) - wl-folder-entity-hashtb)) + 'wl-folder-complete-folder nil nil (or init wl-default-spec) 'wl-read-folder-hist))) (if (or (string= fld wl-default-spec) @@ -3622,7 +3574,8 @@ If ARG, exit virtual folder." wl-summary-pick-field-default) "/" (wl-summary-buffer-folder-name)) - 'update nil nil t))) + 'update nil nil t) + (run-hooks 'wl-summary-virtual-hook))) (defun wl-summary-delete-all-temp-marks (&optional no-msg) "Erase all temp marks from buffer." @@ -3828,21 +3781,21 @@ If ARG, exit virtual folder." (delete-backward-char 1) (insert " ") (setq number (wl-summary-message-number)) - (wl-summary-mark-as-read number) + (setq mlist (append mlist (list number))) (if wl-summary-highlight (wl-highlight-summary-current-line)) (if number (setq wl-summary-buffer-target-mark-list (delq number wl-summary-buffer-target-mark-list)))) (forward-line 1)) - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-summary-mark-as-read (car mlist)) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))) - (wl-summary-count-unread) - (wl-summary-update-modeline)))) + (wl-summary-mark-as-read mlist) + ;; closed + (when (setq mlist wl-summary-buffer-target-mark-list) + (wl-summary-mark-as-read mlist) + (while mlist + (setq wl-summary-buffer-target-mark-list + (delq (car mlist) wl-summary-buffer-target-mark-list)) + (setq mlist (cdr mlist))))))) (defun wl-summary-target-mark-mark-as-unread () (interactive) @@ -3856,22 +3809,22 @@ If ARG, exit virtual folder." (when (string= (wl-summary-temp-mark) "*") (delete-backward-char 1) (insert " ") - (setq number (wl-summary-mark-as-unread)) + (setq number (wl-summary-message-number)) + (setq mlist (append mlist (list number))) (if wl-summary-highlight (wl-highlight-summary-current-line)) (if number (setq wl-summary-buffer-target-mark-list (delq number wl-summary-buffer-target-mark-list)))) (forward-line 1)) - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-summary-mark-as-unread (car mlist)) -;;; (wl-thread-msg-mark-as-unread (car mlist)) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))) - (wl-summary-count-unread) - (wl-summary-update-modeline)))) + (wl-summary-mark-as-unread mlist) + ;; closed + (when (setq mlist wl-summary-buffer-target-mark-list) + (wl-summary-mark-as-unread mlist) + (while mlist + (setq wl-summary-buffer-target-mark-list + (delq (car mlist) wl-summary-buffer-target-mark-list)) + (setq mlist (cdr mlist))))))) (defun wl-summary-target-mark-mark-as-important () (interactive) @@ -3933,47 +3886,68 @@ If ARG, exit virtual folder." (wl-highlight-summary-current-line nil nil t)) (set-buffer-modified-p nil))) -(defun wl-summary-mark-as-read (&optional number - no-folder-mark - no-modeline-update) +(defsubst wl-summary-mark-as-read-internal (inverse + number-or-numbers + no-folder-mark + no-modeline-update) (interactive) (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) + (buffer-read-only nil) (folder wl-summary-buffer-elmo-folder) (msgdb (wl-summary-buffer-msgdb)) (case-fold-search nil) - mark visible new-mark) - (setq visible (if number - (wl-summary-jump-to-msg number) - ;; interactive - t) - number (or number (wl-summary-message-number)) - mark (elmo-message-mark folder number)) - (when (member mark (elmo-msgdb-unread-marks)) - ;; folder mark. - (elmo-folder-mark-as-read folder (list number) no-folder-mark)) - (setq new-mark (elmo-message-mark folder number)) - (unless no-modeline-update - ;; Update unread numbers. - ;; should elmo-folder-mark-as-read return unread numbers? - (wl-summary-count-unread) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count))) - ;; set mark on buffer - (when visible - (unless (string= (wl-summary-persistent-mark) new-mark) - (delete-backward-char 1) - (insert (or new-mark " "))) - (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line nil nil t)) - (set-buffer-modified-p nil)) - (if (member mark (elmo-msgdb-unread-marks)) - (run-hooks 'wl-summary-unread-message-hook)) - number ;return value - ))) + number-list mark visible new-mark) + (setq number-list (or (and (numberp number-or-numbers) + (list number-or-numbers)) + number-or-numbers ; list of numbers + (and (wl-summary-message-number) ; interactive + (list (wl-summary-message-number))))) + (if (null number-list) + (message "No message.") + (if inverse + (elmo-folder-unmark-read folder number-list no-folder-mark) + (elmo-folder-mark-as-read folder number-list no-folder-mark)) + (dolist (number number-list) + (setq visible (wl-summary-jump-to-msg number) + mark (elmo-message-mark folder number)) + (setq new-mark (elmo-message-mark folder number)) + ;; set mark on buffer + (when visible + (unless (string= (wl-summary-persistent-mark) new-mark) + (delete-backward-char 1) + (insert (or new-mark " "))) + (if (and visible wl-summary-highlight) + (wl-highlight-summary-current-line nil nil t)) + (set-buffer-modified-p nil)) + (unless inverse + (if (member mark (elmo-msgdb-unread-marks)) + (run-hooks 'wl-summary-unread-message-hook)))) + (unless no-modeline-update + ;; Update unread numbers. + ;; should elmo-folder-mark-as-read return unread numbers? + (wl-summary-count-unread) + (wl-summary-update-modeline) + (wl-folder-update-unread + (wl-summary-buffer-folder-name) + (+ wl-summary-buffer-unread-count + wl-summary-buffer-new-count))))))) + +(defun wl-summary-mark-as-read (&optional number-or-numbers + no-folder-mark + no-modeline-update) + (wl-summary-mark-as-read-internal nil + number-or-numbers + no-folder-mark + no-modeline-update)) + +(defun wl-summary-mark-as-unread (&optional number-or-numbers + no-folder-mark + no-modeline-update) + (wl-summary-mark-as-read-internal 'inverse + number-or-numbers + no-folder-mark + no-modeline-update)) (defun wl-summary-mark-as-important (&optional number mark @@ -4653,9 +4627,9 @@ Return t if message exists." (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\" ?" + (message "Search message in nntp server \"%s\" ? " elmo-nntp-default-server) - (setq schar (read-char)) + (setq schar (let ((cursor-in-echo-area t)) (read-char))) (cond ((eq schar ?y) (wl-summary-jump-to-msg-by-message-id-via-nntp msgid)) ((eq schar ?s) @@ -4665,7 +4639,11 @@ Return t if message exists." (t (message errmsg) nil))) - (wl-summary-search-via-nntp + ((or (eq wl-summary-search-via-nntp 'force) + (and + (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) + 'nntp) + wl-summary-search-via-nntp)) (wl-summary-jump-to-msg-by-message-id-via-nntp msgid)) (t (message errmsg) diff --git a/wl/wl-thread.el b/wl/wl-thread.el index 08882e7..3375ba0 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -1178,6 +1178,7 @@ Message is inserted to the summary buffer." (setq update-msgs (elmo-uniq-list update-msgs)) (wl-thread-entity-set-parent entity dst-parent) ;; update thread on buffer + (wl-thread-make-number-list) (wl-thread-update-line-msgs update-msgs t)))) (require 'product) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 1d6027a..c9455e3 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -2088,8 +2088,13 @@ or 'skip-no-unread." :group 'wl-summary) (defcustom wl-summary-search-via-nntp 'confirm - "*Non-nil, search message via nntp after `wl-summary-jump-to-msg-by-message-id'. If the value is 'confirm, confirm before search." - :type 'boolean + "*Non-nil, search message via nntp after `wl-summary-jump-to-msg-by-message-id'. +If the value is 'confirm, confirm before search, 'force to search via nntp +regardless of current folder type." + :type '(choice (const :tag "confirm" confirm) + (const :tag "always" force) + (const :tag "in nntp folder" t) + (const :tag "never" nil)) :group 'wl-summary) (defcustom wl-summary-keep-cursor-command @@ -2116,7 +2121,8 @@ Sender information in summary mode." :type 'string :group 'wl-folder) -(defcustom wl-delete-folder-alist '(("^-" . remove)) +(defcustom wl-delete-folder-alist '(("^-" . remove) + ("^@" . remove)) "*Alist of folder and delete policy. Each element is (folder-regexp . policy). @@ -2149,9 +2155,10 @@ POLICY is copy or move." :group 'wl-summary :group 'wl-pref) -(defcustom wl-folder-hierarchy-access-folders '("^-$" "^-alt$") +(defcustom wl-folder-hierarchy-access-folders '("^-[^\\.]*\\(:\\|@\\|$\\)" + "^@$") "*Access group REGEXPs to make hierarchy structure." - :type '(repeat (string :tag "Folder")) + :type '(repeat (string :tag "Regexp")) :group 'wl-folder) (defcustom wl-folder-init-load-access-folders nil diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index fe699ae..652184f 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -253,12 +253,14 @@ (let (fld-name) (cond (;; opened folder group - (looking-at wl-highlight-folder-opened-regexp) + (and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-opened-regexp)) (wl-xmas-highlight-folder-group-line 'wl-folder-opened-glyph 'wl-highlight-folder-opened-face numbers)) (;; closed folder group - (looking-at wl-highlight-folder-closed-regexp) + (and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-closed-regexp)) (wl-xmas-highlight-folder-group-line 'wl-folder-closed-glyph 'wl-highlight-folder-closed-face numbers)) -- 1.7.10.4