+2003-02-05 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * WL-MK (make-wl-news): Replace "^(" by "\\\\(" to avoid font-lock
+ confusion.
+
2003-01-17 TAKAHASHI Kaoru <kaoru@kaisei.org>
* WL-MK (test-wl): Added `make-wl-news'.
(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)))
% 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.
% 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
% 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
\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
\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
}%
}%
% 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
\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
}
\pdfmakeoutlines
\endgroup
\lastnegativepageno = \pageno
- \pageno = \savepageno
+ \global\pageno = \savepageno
}
% And just the chapters.
\contentsalignmacro % in case @setchapternewpage odd is in effect
\endgroup
\lastnegativepageno = \pageno
- \pageno = \savepageno
+ \global\pageno = \savepageno
}
\let\shortcontents = \summarycontents
% 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
% 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.
#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{%
% 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.
\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...
\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
\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}%
% 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
\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}}}
\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
-\def\versionnumber{2.11.1}
+\def\versionnumber{2.11.3}
-@set VERSION 2.11.1
+@set VERSION 2.11.3
@chapter \e$B%a%C%;!<%8$N?6$jJ,$1\e(B
@cindex Split messages
-@code{elmo-split} \e$B$r;H$&$H!"%U%)%k%@\e(B @code{elmo-split-folder} \e$BFb$N\e(B
-\e$B%a%C%;!<%8$rFCDj$N5,B'$K=>$C$F\e(B @command{procmail} \e$BIw$K?6$jJ,$1$k$3$H$,\e(B
-\e$B$G$-$^$9!#\e(B \e$B$3$N5!G=$r;H$&$K$O!"$^$:\e(B @file{~/.emacs} \e$B$K0J2<$N$h$&$K@_Dj\e(B
-\e$B$7$F2<$5$$!#\e(B
+@code{elmo-split} \e$B$r;H$&$H!"JQ?t\e(B @code{elmo-split-folder} \e$B$G;XDj$7$?%U\e(B
+\e$B%)%k%@Fb$N%a%C%;!<%8$rFCDj$N5,B'$K=>$C$F\e(B @command{procmail} \e$BIw$K?6$jJ,\e(B
+\e$B$1$k$3$H$,$G$-$^$9!#\e(B
+\e$B$3$N5!G=$r;H$&$K$O!"$^$:\e(B @file{~/.emacs} \e$B$K0J2<$N$h$&$K@_Dj$7$F2<$5$$!#\e(B
@lisp
(autoload 'elmo-split "elmo-split" "Split messages on the folder." t)
@end lisp
-@kbd{M-x elmo-split} \e$B$9$k$H\e(B @code{elmo-split-rule} \e$B$K=>$C$F?6$jJ,$1$r\e(B
-\e$B<B9T$7$^$9!#\e(B @kbd{C-u M-x elmo-split} \e$B$H$9$k$H<B:]$K$O?6$jJ,$1$r9T$o$:$K\e(B
-\e$B%j%O!<%5%k$r9T$J$$$^$9!#\e(B
+\e$B?6$jJ,$185$N%U%)%k%@$r0J2<$N$h$&$K@_Dj$7$^$9!#\e(B
+
+@lisp
+(setq elmo-split-folder "%inbox")
+@end lisp
+
+\e$B?6$jJ,$1$N%k!<%k$OJQ?t\e(B @code{elmo-split-rule} \e$B$K5-=R$7$^$9\e(B(\e$B=q$-J}$O8e$G\e(B
+\e$B@bL@$7$^$9\e(B)\e$B!#\e(B
+\e$B0J>e$N@_Dj$r$7$?>e$G\e(B @kbd{M-x elmo-split} \e$B$9$k$H\e(B @code{elmo-split-rule}
+\e$B$K=>$C$F?6$jJ,$1$r<B9T$7$^$9!#\e(B @kbd{C-u M-x elmo-split} \e$B$H$9$k$H<B:]$K$O\e(B
+\e$B?6$jJ,$1$O$;$:$K%j%O!<%5%k$r9T$J$$!"$=$N7k2L$rI=<($7$^$9!#\e(B
+
\e$B0J2<$G$O%k!<%k$N5-=R$N;EJ}$r@bL@$7$^$9!#$^$:$O<!$NNc$r8+$F2<$5$$!#\e(B
@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.
* elmo-imap4.el (elmo-folder-msgdb-create-plugged): Bind print-level,
print-depth.
+2003-02-16 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * elmo-version.el (elmo-version): Up to 2.11.3.
+
+2003-02-10 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <kamo@ITmanage.co.jp>
+
+ * elmo-nntp.el (elmo-nntp-get-folders-info): Don't use
+ replace-regexp.
+
+2003-02-08 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * elmo-version.el (elmo-version): Up to 2.11.2.
+
+2003-02-05 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * elmo-imap4.el (elmo-folder-expand-msgdb-path): Don't expand
+ mailbox (e.g. for %~/something).
+
+2003-01-31 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * elmo-localdir.el (elmo-folder-rename-internal): Referctoring;
+ Replace nested conditional with guard clauses.
+
+2003-01-30 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * elmo-archive.el (elmo-folder-rename-internal): Referctoring;
+ Replace nested conditional with guard clauses.
+
2003-01-29 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
* elmo-util.el (elmo-object-save): Bind print-level, print-length.
(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
(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))
(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)
(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
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))
(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 ()
(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))
(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
(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)
(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)
(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)
;; 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)
(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)
+2003-02-10 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * check-modules.el (test-semi-mime-edit): Check
+ `mime-make-text-tag'.
+
2003-01-28 TAKAHASHI Kaoru <kaoru@kaisei.org>
* check-modules.el (test-apel-version): Renamed from
(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)
* wl-highlight.el: Remove useless dummy functions.
+2003-03-19 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ * 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 <yoichi@geiin.org>
+
+ * 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 <okada@opaopa.org>
+
+ * wl-draft.el (wl-draft-create-buffer): Add
+ `wl-summary-reply-with-citation'
+
+2003-03-02 Jeremy Shaw <jeremy.shaw@lindows.com>
+
+ * wl-draft.el (wl-draft-reply): Fixed.
+
+2003-02-28 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * wl-fldmgr.el (wl-fldmgr-folders-header): Add more comment.
+ (wl-fldmgr-save-folders): Fix comment.
+
+2003-02-18 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * wl-thread.el (wl-thread-set-parent): Reconstruct number-list.
+
+2003-02-14 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * wl-vars.el (wl-folder-hierarchy-access-folders): Change default
+ value.
+
+2003-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * Version number is increased to 2.11.3.
+
+2003-02-13 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <kaoru@kaisei.org>
+
+ * wl-draft.el (wl-draft-remove-text-plain-tag): Use
+ `mime-make-text-tag' instead of `mime-create-tag'.
+
+2003-02-10 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * wl-fldmgr.el (wl-fldmgr-rename): Do nothing on the last line.
+ (wl-fldmgr-add-completion-subr): Rewrite conditional.
+
+2003-02-08 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * 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 <yoichi@eken.phys.nagoya-u.ac.jp>
+
+ * Version number is increased to 2.11.2.
+
2003-01-29 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
* wl-news.el.in (wl-news-previous-version-save): Bind
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))
(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? <y/n> ")
+ (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"
;; (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
(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
(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)))
(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)))))
(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
'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
(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))))
(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))))
# 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)))
;;; (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)
(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))
(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)))
(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)))
(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)
(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)
(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))
(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)
(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)))
(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))
(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)
(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
(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))
"")
"\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
(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
(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)
""))))
(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)))
(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))
(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 "+")
; (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
(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))
(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
(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))
(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)
(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)))
(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)))
;;; 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
(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)
(+ (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)))))
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
(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))
(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
(+ (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)
(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))
"^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-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))
(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."
(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))
(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.
(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)))
(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.")
(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\\)"
(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)
(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)))
(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)))))
(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")
(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."
(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)
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."
(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)
(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)
(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
(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)>?"
+ (message "Search message in nntp server \"%s\" <y/n/s(elect)>? "
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)
(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)
(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)
: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
: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).
: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
(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))
projects / elisp / wanderlust.git / commitdiff