From: teranisi Date: Thu, 18 Jan 2001 11:02:23 +0000 (+0000) Subject: Synch up with wl-2.4.1pre. X-Git-Tag: wl-2_6-root~147 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=00990dd383e2e34706cd032fa256b90459091d8f;p=elisp%2Fwanderlust.git Synch up with wl-2.4.1pre. * Version number is increased to 2.5.5. * elmo-version.el (elmo-version): Up to 2.5.5. --- diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index cb0e629..2cced6b 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -5,7 +5,7 @@ @c %**end of header @documentlanguage ja @documentencoding iso-2022-jp -@set VERSION 2.5.4 +@set VERSION 2.5.5 @synindex pg cp @finalout diff --git a/doc/wl.texi b/doc/wl.texi index 8e54c54..eefa605 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -5,7 +5,7 @@ @c %**end of header @documentlanguage en @documentencoding us-ascii -@set VERSION 2.5.4 +@set VERSION 2.5.5 @synindex pg cp @finalout diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 8524ff1..d4b11ac 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,7 @@ +2001-01-18 Yuuichi Teranishi + + * elmo-version.el (elmo-version): Up to 2.5.5. + 2000-12-22 Yuuichi Teranishi * elmo-imap4.el (elmo-network-authenticate-session): @@ -147,7 +151,184 @@ * elmo-version.el (elmo-version): Up to 2.5.2. -2000-11-15 Yuuichi Teranishi +2001-01-16 Yuuichi Teranishi + + * elmo-pop3.el (elmo-pop3-sort-overview-by-original-number): + New function. + (elmo-pop3-sort-msgdb-by-original-number): Ditto. + (elmo-pop3-msgdb-create-as-numlist): Use it. + + * elmo-imap4.el (elmo-imap4-arrival-filter): Check process-buffer. + (Based on the report by AMAKAWA Shuhei ) + + * elmo-pop3.el (elmo-pop3-msgdb-create-as-numlist): Sort msgdb by date. + (Pointed out by Mikiya Tani ) + +2001-01-13 Takaaki MORIYAMA + + * elmo2.el (elmo-make-folder-numbers-list): Fixed problem + when elmo-mark-as-read is called with second argument nil. + +2001-01-12 Yuuichi Teranishi + + * elmo-pipe.el (elmo-pipe-spec-src, elmo-pipe-spec-dst): + Moved to elmo-util.el. + + * elmo-util.el (elmo-pipe-spec-src, elmo-pipe-spec-dst): + Moved from elmo-pipe.el + + * elmo-archive.el (elmo-archive-call-process): Enclose with + static-if. + + * elmo-imap4.el (elmo-imap4-read-msg): Use "BODY[]" instead of + "RFC822" (because RFC822.PEEK is obsolete). + (Adviced by IMAI Takeshi ) + +2001-01-10 Katsumi Yamaoka + + * elmo-archive.el (elmo-archive-call-process): Don't check for + the exit status when Nemacs is running. + +2001-01-09 Yuuichi Teranishi + + * elmo-net.el (elmo-network-session-password-key): Don't set default to + 'plain. + + * elmo-util.el (elmo-imap4-get-spec): Set default of auth to 'clear. + (elmo-pop3-get-spec): Set default of auth to 'user. + + * elmo-imap4.el (elmo-imap4-session-check): + Clear `elmo-imap4-fetch-callback' and `elmo-imap4-fetch-callback-data'. + (elmo-imap4-clear-login): New function; Renamed from `elmo-imap4-login'. + (elmo-imap4-auth-login): New function; Revival. + (elmo-network-authenticate-session): Use `elmo-imap4-clear-login' and + `elmo-imap4-auth-login'. + +2000-12-29 TAKAHASHI Kaoru + + * elmo2.el (toplevel): Move `product-provide' declare. + * mmelmo.el (toplevel): Ditto. + +2000-12-26 Yuuichi Teranishi + + * elmo-util.el (elmo-folder-get-store-type): Rewrite. + +2000-12-26 OKAZAKI Tetsurou + + * elmo-util.el (elmo-folder-get-store-type): New function. + (elmo-folder-direct-copy-p): Use it. + +2000-12-26 Yuuichi Teranishi + + * elmo-imap4.el (elmo-imap4-msgdb-create): Set + `elmo-imap4-fetch-callback-data' as a cons cell of `args' + and result of `elmo-imap4-use-flag-p'. + (elmo-imap4-fetch-callback-1): Set mark according to + the result of `elmo-imap4-use-flag-p'. + +2000-12-22 Yuuichi Teranishi + + * elmo-msgdb.el (elmo-generic-folder-diff): Moved from elmo2.el + (elmo-generic-list-folder-unread): Ditto. + (elmo-folder-get-info): Ditto. + (elmo-folder-set-info-max-by-numdb): Ditto. + (elmo-folder-get-info-max): Ditto. + (elmo-folder-get-info-length): Ditto. + (elmo-folder-get-info-unread): Ditto. + (elmo-folder-info-make-hashtb): Ditto. + + * elmo2.el: Removed above functions. + +2000-11-21 Kenichi OKADA + + * elmo-imap4.el (toplevel): Require 'ssl. + Add autoload 'starttls. + * elmo-pop3.el (toplevel): Ditto. + * elmo-nntp.el (toplevel): Ditto. + +2000-11-20 Kenichi OKADA + + * elmo-imap4.el (toplevel): defun at compile time. + sasl-find-mechanism, sasl-make-client, sasl-mechanism-name, + sasl-next-step, sasl-step-data, sasl-step-set-data. + * elmo-pop3.el (toplevel): Ditto. + +2000-11-20 Kenichi OKADA + + * elmo-imap4.el (elmo-network-authenticate-session): Use `elmo-imap4-login' + +2000-11-20 Kenichi OKADA + + * elmo-pop3.el (elmo-pop3-auth-apop): Signal `elmo-pop-auth-apop' + if error. + (elmo-network-authenticate-session): Use `elmo-pop-auth-user' + and `elmo-pop-auth-apop'. + +2000-11-20 Kenichi OKADA + + * elmo-pop3.el (elmo-network-authenticate-session): Fix for `APOP'. + +2000-11-20 Kenichi OKADA + + * elmo-pop3.el (elmo-network-authenticate-session): Split + encoded response value. + +2000-11-20 Kenichi OKADA + + * elmo-pop3.el (elmo-network-authenticate-session): Abolish + `elmo-pop3-force-login'. + Redefine `sasl-mechanisms'. + * elmo-vars.el (elmo-pop3-force-login): Ditto. + +2000-11-20 Kenichi OKADA + + * elmo-imap4.el (toplevel): Delete defun-maybe for sasl-*. + Delete `elmo-imap4-authenticator-alist'. + (elmo-imap4-auth-cram-md5): Delete. + (elmo-imap4-auth-digest-md5): Delete. + +2000-11-20 Kenichi OKADA + + * elmo-pop3.el (elmo-pop3-auth-digest-md5): Delete. + (elmo-pop3-auth-scram-md5): Ditto. + (elmo-pop3-auth-cram-md5): Ditto. + +2000-11-19 Kenichi OKADA + + * elmo-pop3.el (toplevel): Delete defun-maybe for sasl-*. + Delete `elmo-pop3-authenticator-alist'. + +2000-11-19 Kenichi OKADA + + * elmo-pop3.el (elmo-network-authenticate-session): Rewrite for + new SASL API. + * elmo-imap4.el (elmo-network-authenticate-session): Ditto. + + +2000-12-18 Yuuichi Teranishi + + * elmo-nntp.el (elmo-nntp-get-folders-info): Fixed last change. + +2000-12-01 Yuuichi Teranishi + + * elmo-nntp.el (elmo-nntp-get-folders-info): + Fixed problem when '\' character is contained in user-id. + (Reported by Yoichiro Okabe ) + + +2000-11-28 Yuuichi Teranishi + + * elmo-imap4.el (elmo-imap4-delete-folder): + Send "close" before "delete" (Use commented out line). + (elmo-imap4-rename-folder): Ditto. + + * elmo-dop.el (elmo-dop-queue-append): Use `elmo-string' to get + folder string itself. + (elmo-dop-list-deleted): New function. + (elmo-dop-list-folder): Treat result of `elmo-dop-list-deleted' as + killed. + + * elmo-util.el (elmo-string-rassoc-all): New function. * elmo-version.el (elmo-version): Up to 2.5.1. diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 20345f0..478eabb 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -29,8 +29,8 @@ ;;; Commentary: ;; ;; TODO: -;; [$B%\%=(B] append-msgs() $B$,M_$7$$!J$1$I(B multi-refile $BIT2D!K!#(B -;; Info-Zip $B@lMQ%(!<%8%'%s%H$rMQ$$$?F|K\8l8!:w!J(BOS/2 $B@lMQ!K!#(B +;; [¥Ü¥½] append-msgs() ¤¬Íߤ·¤¤¡Ê¤±¤É multi-refile ÉԲġˡ£ +;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£ ;;; Code: ;; @@ -217,8 +217,12 @@ (` (cdr (assq (, type) elmo-archive-file-regexp-alist)))) -(defsubst elmo-archive-call-process (prog args &optional output) - (= (apply 'call-process prog nil output nil args) 0)) +(static-if (boundp 'NEMACS) + (defsubst elmo-archive-call-process (prog args &optional output) + (apply 'call-process prog nil output nil args) + 0) + (defsubst elmo-archive-call-process (prog args &optional output) + (= (apply 'call-process prog nil output nil args) 0))) (defsubst elmo-archive-call-method (method args &optional output) (cond diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index bb603c6..04c98ff 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -47,7 +47,6 @@ (require 'utf7) ;;; Code: -;; silence byte compiler. (eval-when-compile (require 'cl)) (defvar elmo-imap4-use-lock t @@ -363,6 +362,9 @@ If response is not `OK' response, causes error with IMAP response text." ;;; (defun elmo-imap4-session-check (session) + (with-current-buffer (elmo-network-session-buffer session) + (setq elmo-imap4-fetch-callback nil) + (setq elmo-imap4-fetch-callback-data nil)) (elmo-imap4-send-command-wait session "check")) (defun elmo-imap4-atom-p (string) @@ -528,7 +530,7 @@ BUFFER must be a single-byte buffer." elmo-default-imap4-user) (setq append-serv (concat ":" (elmo-imap4-spec-username spec)))) (unless (eq (elmo-imap4-spec-auth spec) - elmo-default-imap4-authenticate-type) + elmo-default-imap4-authenticate-type) (setq append-serv (concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec))))) (unless (string= (elmo-imap4-spec-hostname spec) @@ -659,7 +661,7 @@ BUFFER must be a single-byte buffer." (if elmo-use-server-diff (elmo-imap4-server-diff spec) (elmo-generic-folder-diff spec folder number-list))) - + (defun elmo-imap4-get-session (spec &optional if-exists) (elmo-network-get-session 'elmo-imap4-session @@ -1041,20 +1043,28 @@ If optional argument UNMARK is non-nil, unmark." ;; ;; app-data: +;; cons of list ;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark -;; 4: seen-list 5: as-number +;; 4: seen-list +;; and result of use-flag-p. (defun elmo-imap4-fetch-callback-1 (entity flags app-data) "A msgdb entity callback function." - (let ((seen (member (car entity) (nth 4 app-data))) - mark) + (let* ((use-flag (cdr app-data)) + (app-data (car app-data)) + (seen (member (car entity) (nth 4 app-data))) + mark) (if (member "\\Flagged" flags) (elmo-msgdb-global-mark-set (car entity) (nth 3 app-data))) (setq mark (or (elmo-msgdb-global-mark-get (car entity)) (if (elmo-cache-exists-p (car entity)) ;; XXX - (if (or (member "\\Seen" flags) seen) + (if (or seen + (and use-flag + (member "\\Seen" flags))) nil (nth 1 app-data)) - (if (or (member "\\Seen" flags) seen) + (if (or seen + (and use-flag + (member "\\Seen" flags))) (if elmo-imap4-use-cache (nth 2 app-data)) (nth 0 app-data))))) @@ -1094,7 +1104,9 @@ If optional argument UNMARK is non-nil, unmark." (with-current-buffer (elmo-network-session-buffer session) (setq elmo-imap4-current-msgdb nil elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1 - elmo-imap4-fetch-callback-data args) + elmo-imap4-fetch-callback-data (cons args + (elmo-imap4-use-flag-p + spec))) (while set-list (elmo-imap4-send-command-wait session @@ -1119,7 +1131,7 @@ If optional argument UNMARK is non-nil, unmark." (elmo-read (concat "(" (downcase (elmo-match-string 1 string)) ")")))) -(defun elmo-imap4-login (session) +(defun elmo-imap4-clear-login (session) (let ((elmo-imap4-debug-inhibit-logging t)) (or (elmo-imap4-read-ok @@ -1131,8 +1143,26 @@ If optional argument UNMARK is non-nil, unmark." " " (elmo-imap4-password (elmo-get-passwd (elmo-network-session-password-key session)))))) - (signal 'elmo-authenticate-error '(login))))) - + (signal 'elmo-authenticate-error '(elmo-imap4-clear-login))))) + +(defun elmo-imap4-auth-login (session) + (let ((tag (elmo-imap4-send-command session "authenticate login")) + (elmo-imap4-debug-inhibit-logging t)) + (or (elmo-imap4-read-continue-req session) + (signal 'elmo-authenticate-error '(elmo-imap4-auth-login))) + (elmo-imap4-send-string session + (elmo-base64-encode-string + (elmo-network-session-user-internal session))) + (or (elmo-imap4-read-continue-req session) + (signal 'elmo-authenticate-error '(elmo-imap4-auth-login))) + (elmo-imap4-send-string session + (elmo-base64-encode-string + (elmo-get-passwd + (elmo-network-session-password-key session)))) + (or (elmo-imap4-read-ok session tag) + (signal 'elmo-authenticate-error '(elmo-imap4-auth-login))) + (setq elmo-imap4-status 'auth))) + (luna-define-method elmo-network-initialize-session-buffer :after ((session elmo-imap4-session) buffer) @@ -1177,23 +1207,28 @@ If optional argument UNMARK is non-nil, unmark." (starttls-negotiate process))))) (luna-define-method elmo-network-authenticate-session ((session - elmo-imap4-session)) + elmo-imap4-session)) (with-current-buffer (process-buffer (elmo-network-session-process-internal session)) (let* ((auth (elmo-network-session-auth-internal session)) (auth (if (listp auth) auth (list auth)))) (unless (or (eq elmo-imap4-status 'auth) (null auth)) - (if (eq 'plain (car auth)) - (elmo-imap4-login session) + (cond + ((eq 'clear (car auth)) + (elmo-imap4-clear-login session)) + ((eq 'login (car auth)) + (elmo-imap4-auth-login session)) + (t (let* ((elmo-imap4-debug-inhibit-logging t) (sasl-mechanisms (delq nil - (mapcar '(lambda (cap) - (if (string-match "^auth=\\(.*\\)$" - (symbol-name cap)) - (match-string 1 (upcase (symbol-name cap))))) - (elmo-imap4-session-capability-internal session)))) + (mapcar + '(lambda (cap) + (if (string-match "^auth=\\(.*\\)$" + (symbol-name cap)) + (match-string 1 (upcase (symbol-name cap))))) + (elmo-imap4-session-capability-internal session)))) (mechanism (sasl-find-mechanism (delq nil @@ -1212,7 +1247,8 @@ If optional argument UNMARK is non-nil, unmark." (elmo-network-session-auth-internal session))))) (setq mechanism (sasl-find-mechanism sasl-mechanisms)) - (signal 'elmo-authenticate-error '(elmo-imap4-auth-no-mechanisms)))) + (signal 'elmo-authenticate-error + '(elmo-imap4-auth-no-mechanisms)))) (setq client (sasl-make-client mechanism @@ -1223,8 +1259,9 @@ If optional argument UNMARK is non-nil, unmark." ;;; (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm)) (setq name (sasl-mechanism-name mechanism) step (sasl-next-step client nil)) - (elmo-network-session-set-auth-internal session - (intern (downcase name))) + (elmo-network-session-set-auth-internal + session + (intern (downcase name))) (setq sasl-read-passphrase (function (lambda (prompt) @@ -1271,7 +1308,7 @@ If optional argument UNMARK is non-nil, unmark." (if (sasl-step-data step) (elmo-base64-encode-string (sasl-step-data step) 'no-line-break) - ""))))))))))) + "")))))))))))) (luna-define-method elmo-network-setup-session ((session elmo-imap4-session)) @@ -1334,15 +1371,14 @@ If optional argument UNMARK is non-nil, unmark." (elmo-imap4-send-command-wait session (format (if elmo-imap4-use-uid - "uid fetch %s rfc822%s" - "fetch %s rfc822%s") + "uid fetch %s body%s[]" + "fetch %s body%s[]") msg (if leave-seen-flag-untouched ".peek" "")))) - (and (setq response (elmo-imap4-response-value + (and (setq response (elmo-imap4-response-bodydetail-text (elmo-imap4-response-value-all - response 'fetch ) - 'rfc822)) + response 'fetch ))) (with-current-buffer outbuf (erase-buffer) (insert response) @@ -1546,6 +1582,7 @@ Return nil if no complete line has arrived." (defun elmo-imap4-arrival-filter (proc string) "IMAP process filter." + (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) (elmo-imap4-debug "-> %s" string) (goto-char (point-max)) @@ -1573,7 +1610,7 @@ Return nil if no complete line has arrived." (t (message "Unknown state %s in arrival filter" elmo-imap4-status)))) - (delete-region (point-min) (point-max))))))) + (delete-region (point-min) (point-max)))))))) ;; IMAP parser. diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 5fa1ceb..80833b9 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -828,6 +828,95 @@ Header region is supposed to be narrowed." (elmo-make-directory new-dir)) (rename-file old new))))) +(defun elmo-generic-folder-diff (spec folder &optional number-list) + (let ((cached-in-db-max (elmo-folder-get-info-max folder)) + (in-folder (elmo-call-func folder "max-of-folder")) + (in-db t) + unsync messages + in-db-max) + (if (or number-list (not cached-in-db-max)) + (let ((number-list (or number-list + (mapcar 'car + (elmo-msgdb-number-load + (elmo-msgdb-expand-path folder)))))) + ;; No info-cache. + (setq in-db (sort number-list '<)) + (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db) + 0)) + (if (not number-list) + (elmo-folder-set-info-hashtb folder in-db-max nil))) + (setq in-db-max cached-in-db-max)) + (setq unsync (if (and in-db + (car in-folder)) + (- (car in-folder) in-db-max) + (if (and in-folder + (null in-db)) + (cdr in-folder) + (if (null (car in-folder)) + nil)))) + (setq messages (cdr in-folder)) + (if (and unsync messages (> unsync messages)) + (setq unsync messages)) + (cons (or unsync 0) (or messages 0)))) + +(defun elmo-generic-list-folder-unread (spec number-alist mark-alist + unread-marks) + (delq nil + (mapcar + (function (lambda (x) + (if (member (cadr (assq (car x) mark-alist)) unread-marks) + (car x)))) + mark-alist))) + +(defsubst elmo-folder-get-info (folder &optional hashtb) + (elmo-get-hash-val folder + (or hashtb elmo-folder-info-hashtb))) + +(defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread) + (let ((info (elmo-folder-get-info folder))) + (when info + (or new (setq new (nth 0 info))) + (or unread (setq unread (nth 1 info))) + (or numbers (setq numbers (nth 2 info))) + (or max (setq max (nth 3 info)))) + (elmo-set-hash-val folder + (list new unread numbers max) + elmo-folder-info-hashtb))) + +(defun elmo-folder-set-info-max-by-numdb (folder msgdb-number) + (let ((num-db (sort (mapcar 'car msgdb-number) '<))) + (elmo-folder-set-info-hashtb + folder + (or (nth (max 0 (1- (length num-db))) num-db) 0) + nil ;;(length num-db) + ))) + +(defun elmo-folder-get-info-max (folder) + "Get folder info from cache." + (nth 3 (elmo-folder-get-info folder))) + +(defun elmo-folder-get-info-length (folder) + (nth 2 (elmo-folder-get-info folder))) + +(defun elmo-folder-get-info-unread (folder) + (nth 1 (elmo-folder-get-info folder))) + +(defun elmo-folder-info-make-hashtb (info-alist hashtb) + (let* ((hashtb (or hashtb + (elmo-make-hash (length info-alist))))) + (mapcar + '(lambda (x) + (let ((info (cadr x))) + (and (intern-soft (car x) hashtb) + (elmo-set-hash-val (car x) + (list (nth 2 info) ;; new + (nth 3 info) ;; unread + (nth 1 info) ;; length + (nth 0 info)) ;; max + hashtb)))) + info-alist) + (setq elmo-folder-info-hashtb hashtb))) + (require 'product) (product-provide (provide 'elmo-msgdb) (require 'elmo-version)) diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el index 0380a85..e97c9b2 100644 --- a/elmo/elmo-net.el +++ b/elmo/elmo-net.el @@ -100,8 +100,7 @@ (format "%s:%s/%s@%s:%d" (elmo-network-session-name-internal session) (elmo-network-session-user-internal session) - (symbol-name (or (elmo-network-session-auth-internal session) - 'plain)) + (elmo-network-session-auth-internal session) (elmo-network-session-host-internal session) (elmo-network-session-port-internal session))) diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 813d31a..1fc88a0 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -1136,7 +1136,10 @@ Returns a list of cons cells like (NUMBER . VALUE)" (if (not (string= postfix "")) (save-excursion (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$" - (concat "\\1" postfix))))) + (concat "\\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 372ba2a..f17f9f9 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -31,12 +31,6 @@ (require 'elmo-msgdb) -(defsubst elmo-pipe-spec-src (spec) - (nth 1 spec)) - -(defsubst elmo-pipe-spec-dst (spec) - (nth 2 spec)) - (defalias 'elmo-pipe-msgdb-create 'elmo-pipe-msgdb-create-as-numlist) (defun elmo-pipe-msgdb-create-as-numlist (spec numlist new-mark already-mark diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 648978a..2a8edac 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -179,8 +179,8 @@ t) (signal 'elmo-authenticate-error '(elmo-pop3-auth-apop)))) - (signal 'elmo-open-error '(elmo-pop-auth-apop)))) - + (signal 'elmo-open-error '(elmo-pop3-auth-apop)))) + (luna-define-method elmo-network-initialize-session-buffer :after ((session elmo-pop3-session) buffer) (with-current-buffer buffer @@ -520,6 +520,25 @@ (defalias 'elmo-pop3-msgdb-create 'elmo-pop3-msgdb-create-as-numlist) +(defun elmo-pop3-sort-overview-by-original-number (overview loc-alist) + (sort overview + (lambda (ent1 ent2) + (< (elmo-pop3-uidl-to-number + (cdr (assq (elmo-msgdb-overview-entity-get-number ent1) + loc-alist))) + (elmo-pop3-uidl-to-number + (cdr (assq (elmo-msgdb-overview-entity-get-number ent2) + loc-alist))))))) + +(defun elmo-pop3-sort-msgdb-by-original-number (msgdb) + (message "Sorting...") + (let ((overview (elmo-msgdb-get-overview msgdb))) + (setq overview (elmo-pop3-sort-overview-by-original-number + overview + (elmo-msgdb-get-location msgdb))) + (message "Sorting...done") + (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb)))) + (defun elmo-pop3-msgdb-create-as-numlist (spec numlist new-mark already-mark seen-mark important-mark seen-list @@ -532,10 +551,12 @@ (setq loc-alist (if msgdb (elmo-msgdb-get-location msgdb) (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))) - (elmo-pop3-msgdb-create-by-header process numlist - new-mark already-mark - seen-mark seen-list - loc-alist)))) + (with-current-buffer (process-buffer process) + (elmo-pop3-sort-msgdb-by-original-number + (elmo-pop3-msgdb-create-by-header process numlist + new-mark already-mark + seen-mark seen-list + loc-alist)))))) (defun elmo-pop3-uidl-to-number (uidl) (string-to-number (elmo-get-hash-val uidl diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 970f39f..de5eb0c 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -235,6 +235,7 @@ File content is encoded with MIME-CHARSET." (setq auth (if (match-beginning 4) (intern (elmo-match-substring 4 folder 1)) elmo-default-imap4-authenticate-type)) + (setq auth (or auth 'clear)) (append (list 'imap4 (elmo-imap4-encode-folder-string mailbox) user auth) @@ -418,6 +419,7 @@ File content is encoded with MIME-CHARSET." (setq auth (if (match-beginning 3) (intern (elmo-match-substring 3 folder 1)) elmo-default-pop3-authenticate-type)) + (setq auth (or auth 'user)) (append (list 'pop3 user auth) (cdr spec))))) @@ -472,6 +474,12 @@ File content is encoded with MIME-CHARSET." (elmo-match-string 2 folder) (elmo-match-string 3 folder)))) +(defsubst elmo-pipe-spec-src (spec) + (nth 1 spec)) + +(defsubst elmo-pipe-spec-dst (spec) + (nth 2 spec)) + (defun elmo-folder-get-spec (folder) "Return spec of FOLDER." (let ((type (elmo-folder-get-type folder))) @@ -1230,6 +1238,14 @@ Otherwise treat \\ in NEWTEXT string as special: (t (elmo-folder-direct-copy-p folder1 folder2)))) +(defun elmo-folder-get-store-type (folder) + (let ((spec (elmo-folder-get-spec folder))) + (case (car spec) + (filter (elmo-folder-get-store-type (nth 2 spec))) + (pipe (elmo-folder-get-store-type (elmo-pipe-spec-dst spec))) + (multi (elmo-folder-get-store-type (nth 1 spec))) + (t (car spec))))) + (defconst elmo-folder-direct-copy-alist '((localdir . (localdir localnews archive)) (maildir . (maildir localdir localnews archive)) @@ -1238,8 +1254,8 @@ Otherwise treat \\ in NEWTEXT string as special: (cache . (localdir localnews archive)))) (defun elmo-folder-direct-copy-p (src-folder dst-folder) - (let ((src-type (car (elmo-folder-get-spec src-folder))) - (dst-type (car (elmo-folder-get-spec dst-folder))) + (let ((src-type (elmo-folder-get-store-type src-folder)) + (dst-type (elmo-folder-get-store-type dst-folder)) dst-copy-type) (and (setq dst-copy-type (cdr (assq src-type elmo-folder-direct-copy-alist))) diff --git a/elmo/elmo-version.el b/elmo/elmo-version.el index 6b63e2e..ee9240e 100644 --- a/elmo/elmo-version.el +++ b/elmo/elmo-version.el @@ -27,6 +27,10 @@ ;;; Commentary: ;; +;; Put the following lines to each file of ELMO package. +;; +;; (require 'product) +;; (product-provide (provide FEATURE) (require 'elmo-version)) ;;; Code: ;; @@ -35,7 +39,7 @@ ;; product-define in the first place (product-provide 'elmo-version - (product-define "ELMO" nil '(2 5 4))) + (product-define "ELMO" nil '(2 5 5))) ;; For APEL 10.2 or earlier. (defun-maybe product-version-as-string (product) diff --git a/elmo/elmo2.el b/elmo/elmo2.el index 33ee179..cb21136 100644 --- a/elmo/elmo2.el +++ b/elmo/elmo2.el @@ -29,13 +29,13 @@ ;;; Code: ;; +(require 'elmo-version) ; reduce recursive-load-depth (require 'elmo-vars) (require 'elmo-msgdb) (require 'elmo-cache) (require 'elmo-util) (require 'elmo-dop) -(require 'product) -(product-provide (provide 'elmo2) (require 'elmo-version)) +;;;(provide 'elmo2) ; circular dependency (eval-when-compile (require 'elmo-localdir) @@ -426,7 +426,8 @@ without cacheing." pair fld-list ret-val) (while msg-list - (when (> (car msg-list) 0) + (when (and (numberp (car msg-list)) + (> (car msg-list) 0)) (setq pair (elmo-get-real-folder-number folder (car msg-list))) (if (setq fld-list (assoc (car pair) ret-val)) (setcdr fld-list (cons (cdr pair) (cdr fld-list))) @@ -598,15 +599,6 @@ without cacheing." "Just return number-alist." number-alist) -(defun elmo-generic-list-folder-unread (spec number-alist mark-alist - unread-marks) - (delq nil - (mapcar - (function (lambda (x) - (if (member (cadr (assq (car x) mark-alist)) unread-marks) - (car x)))) - mark-alist))) - (defun elmo-generic-list-folder-important (spec number-alist) nil) @@ -711,86 +703,6 @@ If optional argumnet NUMBER-LIST is set, it is used as a message list in msgdb. Otherwise, number-list is load from msgdb." (elmo-call-func folder "folder-diff" folder number-list)) -(defun elmo-generic-folder-diff (spec folder &optional number-list) - (let ((cached-in-db-max (elmo-folder-get-info-max folder)) - (in-folder (elmo-max-of-folder folder)) - (in-db t) - unsync messages - in-db-max) - (if (or number-list (not cached-in-db-max)) - (let ((number-list (or number-list - (mapcar 'car - (elmo-msgdb-number-load - (elmo-msgdb-expand-path folder)))))) - ;; No info-cache. - (setq in-db (sort number-list '<)) - (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db) - 0)) - (if (not number-list) - (elmo-folder-set-info-hashtb folder in-db-max nil))) - (setq in-db-max cached-in-db-max)) - (setq unsync (if (and in-db - (car in-folder)) - (- (car in-folder) in-db-max) - (if (and in-folder - (null in-db)) - (cdr in-folder) - (if (null (car in-folder)) - nil)))) - (setq messages (cdr in-folder)) - (if (and unsync messages (> unsync messages)) - (setq unsync messages)) - (cons (or unsync 0) (or messages 0)))) - -(defsubst elmo-folder-get-info (folder &optional hashtb) - (elmo-get-hash-val folder - (or hashtb elmo-folder-info-hashtb))) - -(defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread) - (let ((info (elmo-folder-get-info folder))) - (when info - (or new (setq new (nth 0 info))) - (or unread (setq unread (nth 1 info))) - (or numbers (setq numbers (nth 2 info))) - (or max (setq max (nth 3 info)))) - (elmo-set-hash-val folder - (list new unread numbers max) - elmo-folder-info-hashtb))) - -(defun elmo-folder-set-info-max-by-numdb (folder msgdb-number) - (let ((num-db (sort (mapcar 'car msgdb-number) '<))) - (elmo-folder-set-info-hashtb - folder - (or (nth (max 0 (1- (length num-db))) num-db) 0) - nil ;;(length num-db) - ))) - -(defun elmo-folder-get-info-max (folder) - "Get folder info from cache." - (nth 3 (elmo-folder-get-info folder))) - -(defun elmo-folder-get-info-length (folder) - (nth 2 (elmo-folder-get-info folder))) - -(defun elmo-folder-get-info-unread (folder) - (nth 1 (elmo-folder-get-info folder))) - -(defun elmo-folder-info-make-hashtb (info-alist hashtb) - (let* ((hashtb (or hashtb - (elmo-make-hash (length info-alist))))) - (mapcar - '(lambda (x) - (let ((info (cadr x))) - (and (intern-soft (car x) hashtb) - (elmo-set-hash-val (car x) - (list (nth 2 info) ;; new - (nth 3 info) ;; unread - (nth 1 info) ;; length - (nth 0 info)) ;; max - hashtb)))) - info-alist) - (setq elmo-folder-info-hashtb hashtb))) - (defun elmo-crosspost-message-set (message-id folders &optional type) (if (assoc message-id elmo-crosspost-message-alist) (setcdr (assoc message-id elmo-crosspost-message-alist) @@ -1010,4 +922,7 @@ message list in msgdb. Otherwise, number-list is load from msgdb." (autoload 'elmo-localdir-msgdb-create-overview-entity-from-file "elmo-localdir") (autoload 'elmo-archive-copy-msgs-froms "elmo-archive") +(require 'product) +(product-provide (provide 'elmo2) (require 'elmo-version)) + ;;; elmo2.el ends here diff --git a/elmo/mmelmo.el b/elmo/mmelmo.el index 102bda3..0e54dd8 100644 --- a/elmo/mmelmo.el +++ b/elmo/mmelmo.el @@ -33,8 +33,7 @@ (require 'mime-parse) (require 'mmbuffer) -(require 'product) -(product-provide (provide 'mmelmo) (require 'elmo-version)) +(provide 'mmelmo) ; circular dependency (require 'mmelmo-imap4) (eval-and-compile @@ -260,4 +259,7 @@ size: size of the entity." ;; (mime-buffer-entity-body-end-internal entity))) ;; (mime-entity-encoding entity))) +(require 'product) +(product-provide (provide 'mmelmo) (require 'elmo-version)) + ;;; mmelmo.el ends here diff --git a/samples/en/dot.wl b/samples/en/dot.wl index 1dceb11..30f3a6d 100644 --- a/samples/en/dot.wl +++ b/samples/en/dot.wl @@ -1,6 +1,5 @@ ;;; -*- emacs-lisp -*- ;;; ~/.wl (setting file for Wanderlust) -;;; Last-Modified: 1999-11-07 ;;; ;; Following must be included in ~/.emacs @@ -289,7 +288,7 @@ ("To" . "boss@company.jp") ("Subject" . "Report") (top . "Sir, here is my report\n") ;; insert in top. -;; (file-bottom . "~/work/report.txt") ;; insert file in bottom +;; (bottom-file . "~/work/report.txt") ;; insert file in bottom ) )) ;; Change headers in draft sending time. @@ -343,8 +342,8 @@ ;; after x-face-mule 0.20 (setq wl-highlight-x-face-func (function - (lambda (beg end) - (x-face-mule-x-face-decode-message-header beg end)))) + (lambda (&optional beg end) ; for compatibility + (x-face-decode-message-header)))) (setq x-face-mule-highlight-x-face-style 'xmas) (require 'x-face-mule) ))) diff --git a/samples/ja/dot.wl b/samples/ja/dot.wl index e8a8d77..a9d2a49 100644 --- a/samples/ja/dot.wl +++ b/samples/ja/dot.wl @@ -1,6 +1,5 @@ ;;; -*- emacs-lisp -*- ;;; ~/.wl (setting file for Wanderlust) -;;; Last-Modified: 1999-11-07 ;;; ;; $B$^$:!$ + + * Version number is increased to 2.5.5. + + * wl-address.el (wl-address-specials-regexp): New constant. + (wl-address-quote-specials): Use it. + +2001-01-17 Yuuichi Teranishi + + * wl-summary.el (wl-summary-rescan): + Call `wl-summary-buffer-number-column-detect'. + (Advised by Akihiro MOTOKI ) + + * wl-message.el (wl-message-mode-map): Define. + (wl-message-decode): Use it as local-map. + +2001-01-16 Yuuichi Teranishi + + * wl-score.el (wl-score-guess-like-gnus): Abolished. + (wl-score-get-score-files): Don't use `wl-score-guess-like-gnus'. + +2001-01-12 Yuuichi Teranishi + + * wl-xmas.el (wl-read-event-char): Move from wl-util.el. + + * wl-mule.el (wl-read-event-char): Ditto. + + * wl-e21.el (wl-read-event-char): Ditto. + + * wl-nemacs.el (wl-read-event-char): Ditto. + (read-event): Removed. + + * wl-util.el (toplevel): Removed dummy definition of + `read-event'. + (wl-read-event-char, wl-xmas-read-event-char): Removed. + +2001-01-10 Katsumi Yamaoka + + * wl-nemacs.el (elmo-archive-call-process): Moved to + elmo-archive.el. + +2001-01-02 TAKAHASHI Kaoru + + * wl-draft.el (wl-draft-reply-list-symbol): New function. + (wl-draft-reply): Use it. Fixed "No match field" error message. + + * wl-draft.el (wl-draft-insert-from-field): Use (length "From: ") + instead of magic-number 6. Use `not' instead of `null' for symbol + `nil' check (not empty list). + (wl-draft-insert-x-face-field): Fixed paren style. + + * wl-draft.el (wl-draft-insert-x-face-field-here): Use `when' for + one-branch conditional statement, instead of `and' and `if'. + (wl-draft-forward): Likewise. + (wl-draft-add-references): Likewise. + (wl-draft-yank-from-mail-reply-buffer): Likewise. + + * wl-draft.el (wl-draft-delete-myself-from-cc): Refactoring nested + conditional steatment. Use `cond' instead of `if'. + (wl-draft-confirm): Likewise. + +2001-01-01 TAKAHASHI Kaoru + + * wl-version.el (wl-version-show): Use `product-string-1' + instead of `wl-version'. + * wl-fldmgr.el (wl-fldmgr-folders-header): Likewise. + + * wl-demo.el (wl-demo-copyright-notice): Add 2001. + +2000-12-31 TAKAHASHI Kaoru + + * wl-highlight.el (wl-highlight-headers): Revert + `wl-highlight-x-face-func' argument (`beg' and `end'). + +2000-12-29 TAKAHASHI Kaoru + + * wl.el (toplevel): Move `product-provide' declare. + * wl-demo.el (toplevel): Ditto. + * wl-dnd.el (toplevel): Ditto. + * wl-highlight.el (toplevel): Ditto. + * wl-message.el (toplevel): Ditto. + * wl-refile.el (toplevel): Ditto. + * wl-util.el (toplevel): Ditto. + +2000-12-26 Yuuichi Teranishi + + * wl-thread.el (wl-thread-open-all): Rewrite to open all threads and + keep cursor position. (Advised by OKAZAKI Tetsurou ) + (wl-thread-close-all): keep cursor position. + +2000-12-24 TAKAHASHI Kaoru + + * wl-version.el (wl-version-status-alist): Use `zerop' instead of + (eq x 0). + (wl-generate-user-agent-string-1): Fix conditional statement. + +2000-11-27 Kenichi OKADA + + * wl.el (wl-check-environment): Additional check for + 'wl-local-domain' and `wl-message-id-domain'. + +2000-11-19 Kenichi OKADA + + * wl-draft.el (toplevel): Delete defvar for sasl-*. + +2000-11-19 Kenichi OKADA + + * wl-draft.el (wl-smtp-extension-bind): Use `smtp-sasl-properties' + instead of `smtp-sasl-user-realm'. + +2000-11-19 Kenichi OKADA + + * wl-draft.el (wl-smtp-extension-bind): Rewrite for new SASL API. + +2000-12-19 Katsumi Yamaoka + + * wl-draft.el (wl-draft-reply): Bind `mime-header-lexical-analyzer' + to the default value as well as `eword-lexical-analyzer'. + +2000-12-19 TAKAHASHI Kaoru + + * wl-version.el (wl-extended-emacs-version, + wl-extended-emacs-version2, wl-extended-emacs-version3): Use + `elmo-match-string' instead of `wl-match-string'. + +2000-12-15 TAKAHASHI Kaoru + + * wl-summary.el (wl-summary-mode): Use \\{wl-summary-mode-map} in + docstring. + +2000-12-10 Hironori Fukuchi + + * wl-summary.el (wl-summary-toggle-thread): Docstring typo fix. + +2000-12-15 TAKAHASHI Kaoru + + * wl-highlight.el (wl-highlight-headers): Remove + `wl-highlight-x-face-func' argument (`beg' and `end'). + +2000-12-15 Yuuichi Teranishi + + * wl-summary.el (wl-summary-mark-as-important): + Remove cache if folder is local. + +2000-12-06 Taro Kawagishi + + * wl-summary.el (wl-summary-edit-addresses-subr): Call `try-completion' + to get existing e-mail address string. + +2000-12-13 TAKAHASHI Kaoru + + * wl-version.el (wl-generate-user-agent-string): Commentary. + (wl-generate-user-agent-string-1): Use `when' for + one-branch conditional statement, instead of `and' and `if'. + (wl-extended-emacs-version, wl-extended-emacs-version2, + wl-extended-emacs-version3): Ditto. + +2000-12-12 Yuuichi Teranishi + + * wl-summary.el (wl-summary-sync-all-init): New inline function. + (wl-summary-sync): Enclose `wl-summary-sync-update3' with + condition-case; Remove initialization. + (wl-summary-confirm-appends): Don't enclose with `condition-case'. + (wl-summary-sync-update3): Added argument `sync-all'; + Eliminated local variable `msgdb'; + Call `wl-summary-sync-all-init' when `sync-all' is non-nil. + Call `wl-summary-confirm-appends' before `wl-summary-sync-all-init'. + (Pointed out by "HIROSE, Masaaki" ) + 2000-12-12 KOGURO Naoki * wl-draft.el (wl-draft-send-mail-with-pop-before-smtp): Close POP diff --git a/wl/wl-address.el b/wl/wl-address.el index 8b30e56..5581fc8 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -280,9 +280,11 @@ Matched address lists are append to CL." (completing-read "To: " cl) (read-string "To: ")))) +(defconst wl-address-specials-regexp "[]\"(),.:;<>@[\\]") + (defun wl-address-quote-specials (word) "Make quoted string of WORD if needed." - (if (assq 'specials (std11-lexical-analyze word)) + (if (string-match wl-address-specials-regexp word) (prin1-to-string word) word)) diff --git a/wl/wl-demo.el b/wl/wl-demo.el index 753dc0b..990cab2 100644 --- a/wl/wl-demo.el +++ b/wl/wl-demo.el @@ -32,13 +32,11 @@ ;; (defconst wl-demo-copyright-notice - "Copyright (C) 1998-2000 Yuuichi Teranishi ") + "Copyright (C) 1998-2001 Yuuichi Teranishi ") (require 'wl-vars) (require 'wl-version) (require 'wl-highlight) -(require 'product) -(product-provide (provide 'wl-demo) (require 'wl-version)) (defconst wl-demo-icon-name (concat "wl-" (wl-version-status) "-logo")) @@ -340,4 +338,7 @@ Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." (sit-for (if (featurep 'lisp-float-type) (/ (float 5) (float 10)) 1)) demo-buf))) +(require 'product) +(product-provide (provide 'wl-demo) (require 'wl-version)) + ;;; wl-demo.el ends here diff --git a/wl/wl-dnd.el b/wl/wl-dnd.el index 6874503..1812df4 100644 --- a/wl/wl-dnd.el +++ b/wl/wl-dnd.el @@ -29,9 +29,6 @@ ;;; Code: ;; -(require 'product) -(product-provide (provide 'wl-dnd) (require 'wl-version)) - (static-cond ((featurep 'offix) (defun start-drag (event what &optional typ) @@ -99,5 +96,8 @@ (setq kmap (make-keymap)) (define-key kmap [button1] 'wl-dnd-start-drag) (set-extent-property ext 'keymap kmap))) + +(require 'product) +(product-provide (provide 'wl-dnd) (require 'wl-version)) ;;; wl-dnd.el ends here diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 2630225..1181f87 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -132,7 +132,7 @@ (fullname (user-full-name))) (cond ((eq mail-from-style 'angles) (insert "From: " fullname) - (let ((fullname-start (+ (point-min) 6)) + (let ((fullname-start (+ (point-min) (length "From: "))) (fullname-end (point-marker))) (goto-char fullname-start) ;; Look for a character that cannot appear unquoted @@ -168,11 +168,11 @@ (replace-match "\\1(\\3)" t) (goto-char fullname-start)))) (insert ")\n")) - ((null mail-from-style) + ((not mail-from-style) (insert "From: " login "\n"))))) (defun wl-draft-insert-x-face-field () - "Insert x-face header." + "Insert X-Face header." (interactive) (if (not (file-exists-p wl-x-face-file)) (error "File %s does not exist" wl-x-face-file) @@ -180,21 +180,21 @@ (search-forward mail-header-separator nil t) (beginning-of-line) (wl-draft-insert-x-face-field-here) - (run-hooks 'wl-draft-insert-x-face-field-hook) ; highlight it if you want. - )) + (run-hooks 'wl-draft-insert-x-face-field-hook))) ; highlight it if you want. (defun wl-draft-insert-x-face-field-here () - "Insert x-face field at point." + "Insert X-Face field at point." (let ((x-face-string (elmo-get-file-string wl-x-face-file))) - (if (string-match "^[ \t]*" x-face-string) - (setq x-face-string (substring x-face-string (match-end 0)))) + (when (string-match "^[ \t]*" x-face-string) + (setq x-face-string (substring x-face-string (match-end 0)))) (insert "X-Face: " x-face-string)) - (if (not (= (preceding-char) ?\n)) - (insert ?\n)) - (and (fboundp 'x-face-insert-version-header) ; x-face.el... - (boundp 'x-face-add-x-face-version-header) - x-face-add-x-face-version-header - (x-face-insert-version-header))) + (when (not (= (preceding-char) ?\n)) ; for chomped (choped) x-face-string + (insert ?\n)) + ;; Insert X-Face-Version: field + (when (and (fboundp 'x-face-insert-version-header) + (boundp 'x-face-add-x-face-version-header) + x-face-add-x-face-version-header) + (x-face-insert-version-header))) (defun wl-draft-setup () (let ((field wl-draft-fields) @@ -225,16 +225,12 @@ (defun wl-draft-delete-myself-from-cc (to cc) (let ((myself (or wl-user-mail-address-list (list (wl-address-header-extract-address wl-from))))) - (if wl-draft-always-delete-myself - (elmo-list-delete myself cc) - (if (elmo-list-member myself cc) - (if (elmo-list-member (append to cc) - (mapcar 'downcase wl-subscribed-mailing-list)) - ;; member list is contained in recipients. - (elmo-list-delete myself cc) - cc - ) - cc)))) + (cond (wl-draft-always-delete-myself ; always-delete option + (elmo-list-delete myself cc)) + ((elmo-list-member (append to cc) ; subscribed mailing-list + (mapcar 'downcase wl-subscribed-mailing-list)) + (elmo-list-delete myself cc)) + (t cc)))) (defun wl-draft-forward (original-subject summary-buf) (let (references) @@ -246,8 +242,8 @@ references (mapconcat 'identity references " ") references (wl-draft-parse-msg-id-list-string references) references (wl-delete-duplicates references) - references (if references - (mapconcat 'identity references "\n\t")))) + references (when references + (mapconcat 'identity references "\n\t")))) (wl-draft "" (concat "Forward: " original-subject) nil nil references nil nil nil nil nil nil summary-buf)) (goto-char (point-max)) @@ -260,6 +256,17 @@ (substring subject (match-end 0)) subject)) +(defun wl-draft-reply-list-symbol (from no-arg) + "Check FROM and NO-ARG, return symbol `wl-draft-reply-*-argument-list'. +Return symbol, not list. Use symbol-name" + (if (wl-address-user-mail-address-p from) + (if no-arg + 'wl-draft-reply-myself-without-argument-list + 'wl-draft-reply-myself-with-argument-list) + (if no-arg + 'wl-draft-reply-without-argument-list + 'wl-draft-reply-with-argument-list))) + (defun wl-draft-reply (buf no-arg summary-buf) "" ;;;(save-excursion @@ -273,16 +280,13 @@ eword-analyze-atom)) eword-lexical-analyzer to mail-followup-to cc subject in-reply-to references newsgroups - from to-alist cc-alist) + from to-alist cc-alist r-list-name) (setq eword-lexical-analyzer mime-header-lexical-analyzer) (set-buffer buf) (setq from (wl-address-header-extract-address (std11-field-body "From"))) - (setq r-list - (if (wl-address-user-mail-address-p from) - (if no-arg wl-draft-reply-myself-without-argument-list - wl-draft-reply-myself-with-argument-list) - (if no-arg wl-draft-reply-without-argument-list - wl-draft-reply-with-argument-list))) + ;; symbol-name use in error message + (setq r-list-name (symbol-name (wl-draft-reply-list-symbol from no-arg))) + (setq r-list (symbol-value (wl-draft-reply-list-symbol from no-arg))) (catch 'done (while r-list (when (let ((condition (car (car r-list)))) @@ -318,7 +322,7 @@ ","))) (throw 'done nil)) (setq r-list (cdr r-list))) - (error "No match field: check your `wl-draft-reply-without-argument-list'")) + (error "No match field: check your `%s'" r-list-name)) (setq subject (std11-field-body "Subject")) (setq to (wl-parse-addresses to) cc (wl-parse-addresses cc)) @@ -423,9 +427,9 @@ (setq ref-list (cons (substring ref (match-beginning 0) (setq st (match-end 0))) ref-list))) - (if (and ref-list - (member mes-id ref-list)) - (setq mes-id nil))) + (when (and ref-list + (member mes-id ref-list)) + (setq mes-id nil))) (when mes-id (save-excursion (when (mail-position-on-field "References") @@ -444,9 +448,9 @@ (insert (save-excursion (set-buffer mail-reply-buffer) - (if decode-it - (decode-mime-charset-region (point-min) (point-max) - wl-mime-charset)) + (when decode-it + (decode-mime-charset-region (point-min) (point-max) + wl-mime-charset)) (buffer-substring-no-properties (point-min) (point-max)))) (when ignored-fields @@ -461,19 +465,20 @@ (t (and wl-draft-cite-func (funcall wl-draft-cite-func)))) ; default cite (run-hooks 'wl-draft-cited-hook) - (and wl-draft-add-references - (if (wl-draft-add-references) - (wl-highlight-headers 'for-draft))) - (if wl-highlight-body-too - (wl-highlight-body-region beg (point-max))))) + (when (and wl-draft-add-references + (wl-draft-add-references)) + (wl-highlight-headers 'for-draft)) ; highlight when added References: + (when wl-highlight-body-too + (wl-highlight-body-region beg (point-max))))) (defun wl-draft-confirm () "Confirm send message." (interactive) (y-or-n-p (format "Send current draft as %s? " - (if (wl-message-mail-p) - (if (wl-message-news-p) "Mail and News" "Mail") - "News")))) + (cond ((and (wl-message-mail-p) (wl-message-news-p)) + "Mail and News") + ((wl-message-mail-p) "Mail") + ((wl-message-news-p) "News"))))) (defun wl-message-news-p () "If exist valid Newsgroups field, return non-nil." diff --git a/wl/wl-e21.el b/wl/wl-e21.el index a493abb..1c99c8e 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -603,6 +603,11 @@ Special commands: (defalias 'wl-defface 'defface) +(defun wl-read-event-char () + "Get the next event." + (let ((event (read-event))) + (cons (and (numberp event) event) event))) + (require 'product) (product-provide (provide 'wl-e21) (require 'wl-version)) diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index 96c4484..0fb0b9e 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -52,7 +52,7 @@ # This file is generated automatically by %s. # -" (wl-version t))) +" (product-string-1 'wl-version t))) ;;; Initial setup diff --git a/wl/wl-folder.el b/wl/wl-folder.el index b85818d..ba7ad28 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -1396,7 +1396,7 @@ If current line is group folder, all subfolders are marked." (defun wl-folder-mode () "Major mode for Wanderlust Folder. -See info under Wanderlust for full documentation. +See Info under Wanderlust for full documentation. Special commands: \\{wl-folder-mode-map} diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index d230b0e..c818ff7 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -33,8 +33,7 @@ (featurep 'dragdrop)) (require 'wl-dnd)) (require 'wl-vars) -(require 'product) -(product-provide (provide 'wl-highlight) (require 'wl-version)) +(provide 'wl-highlight) ; circular dependency (eval-when-compile (cond (wl-on-xemacs @@ -1028,8 +1027,8 @@ interpreted as cited text.)" (wl-highlight-message beg end nil) (unless for-draft (wl-highlight-message-add-buttons-to-header beg end) - (and wl-highlight-x-face-func - (funcall wl-highlight-x-face-func beg end))) + (when wl-highlight-x-face-func + (funcall wl-highlight-x-face-func beg end))) (run-hooks 'wl-highlight-headers-hook))) (defun wl-highlight-message-add-buttons-to-header (start end) @@ -1259,4 +1258,7 @@ interpreted as cited text.)" (inhibit-read-only t)) (put-text-property beg end 'mouse-face 'highlight))) +(require 'product) +(product-provide (provide 'wl-highlight) (require 'wl-version)) + ;;; wl-highlight.el ends here diff --git a/wl/wl-message.el b/wl/wl-message.el index a45ca4c..63ba80a 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -59,9 +59,6 @@ (make-variable-buffer-local 'wl-message-buffer-cur-folder) (make-variable-buffer-local 'wl-message-buffer-cur-number) -(require 'product) -(product-provide (provide 'wl-message) (require 'wl-version)) - (defvar wl-fixed-window-configuration nil) (defun wl-message-buffer-window () @@ -185,6 +182,14 @@ (select-window (get-buffer-window summary-buf)))) (run-hooks 'wl-message-exit-hook))) +(defvar wl-message-mode-map nil) +(if wl-message-mode-map + () + (setq wl-message-mode-map (make-sparse-keymap)) + (define-key wl-message-mode-map "q" 'wl-message-exit) + (define-key wl-message-mode-map "n" 'wl-message-exit) + (define-key wl-message-mode-map "p" 'wl-message-exit)) + (defun wl-message-decode (outbuf inbuf flag) (cond ((eq flag 'all-header) @@ -207,9 +212,7 @@ (elmo-set-buffer-multibyte nil)) (copy-to-buffer outbuf (point-min) (point-max)) (set-buffer outbuf) - (local-set-key "q" 'wl-message-exit) - (local-set-key "p" 'wl-message-exit) - (local-set-key "n" 'wl-message-exit) + (use-local-map wl-message-mode-map) (elmo-set-buffer-multibyte default-enable-multibyte-characters) ;;; (decode-mime-charset-region (point-min) (point-max) wl-mime-charset) ;; we can call decode-coding-region() directly, because multibyte flag is t. @@ -636,6 +639,7 @@ If failed, attempt to execute button-dispatcher." (set-buffer buf) filename)))) -;;; wl-message.el ends here - +(require 'product) +(product-provide (provide 'wl-message) (require 'wl-version)) +;;; wl-message.el ends here diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 76538e6..ad63c74 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -279,6 +279,11 @@ Warning: Unknown req `%S' with options `%S'" req options)) nil)))) match))))) +(defun wl-read-event-char () + "Get the next event." + (let ((event (read-event))) + (cons (and (numberp event) event) event))) + (require 'product) (product-provide (provide 'wl-mule) (require 'wl-version)) diff --git a/wl/wl-nemacs.el b/wl/wl-nemacs.el index aedf791..112f46b 100644 --- a/wl/wl-nemacs.el +++ b/wl/wl-nemacs.el @@ -53,10 +53,6 @@ (defmacro wl-defface (face spec doc &rest args) (` (defvar (, face) (, spec) (, doc)))) -(defsubst elmo-archive-call-process (prog args &optional output) - (apply 'call-process prog nil output nil args) - 0) - (defun wl-draft-mode-setup () (defalias 'wl-draft-mode 'mail-mode)) (defun wl-draft-key-setup ()) @@ -127,14 +123,13 @@ However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." (forward-char -1) (point)))))))) -(defun-maybe find-file-name-handler (filename operation)) +(defun wl-read-event-char () + "Get the next event." + ;; Nemacs does not have read-char-exclusive(). + (let ((event (read-char))) + (cons (and (numberp event) event) event))) -(defun-maybe read-event () - (setq unread-command-events - (if (fboundp 'read-char-exclusive) - (read-char-exclusive) - ;; XXX Emacs18.59 does not have read-char-exclusive(). - (read-char)))) +(defun-maybe find-file-name-handler (filename operation)) (defmacro easy-menu-define (a b c d) (` (defvar (, a) nil (, c)))) diff --git a/wl/wl-refile.el b/wl/wl-refile.el index 78b086d..467289f 100644 --- a/wl/wl-refile.el +++ b/wl/wl-refile.el @@ -31,8 +31,6 @@ (require 'wl-vars) (require 'wl-util) -(require 'product) -(product-provide (provide 'wl-refile) (require 'wl-version)) (defvar wl-refile-alist nil) (defvar wl-refile-alist-file-name "refile-alist") @@ -296,4 +294,7 @@ If RULE does not match ENTITY, returns nil." (elmo-msgdb-overview-entity-get-subject entity)) wl-refile-subject-alist))) +(require 'product) +(product-provide (provide 'wl-refile) (require 'wl-version)) + ;;; wl-refile.el ends here diff --git a/wl/wl-score.el b/wl/wl-score.el index be5832a..a0d93b8 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -337,21 +337,6 @@ Set `wl-score-cache' nil." (setq wl-current-score-file file) (setq wl-score-alist alist))) -(defun wl-score-guess-like-gnus (folder) - (let* (score-list - (spec (elmo-folder-get-spec folder)) - (method (symbol-name (car spec))) - (fld-name (elmo-string (car (cdr spec))))) - (when (stringp fld-name) - (while (string-match "[\\/:,;*?\"<>|]" fld-name) - (setq fld-name (replace-match "." t nil fld-name))) - (setq score-list (list (concat method "@" fld-name ".SCORE"))) - (while (string-match "[\\/.][^\\/.]*$" fld-name) - (setq fld-name (substring fld-name 0 (match-beginning 0))) - (wl-append score-list (list (concat method "@" fld-name - ".all.SCORE")))) - score-list))) - (defun wl-score-get-score-files (score-alist folder) (let ((files (wl-get-assoc-list-value score-alist folder @@ -362,8 +347,6 @@ Set `wl-score-cache' nil." fl (cond ((functionp f) (funcall f folder)) - ((and (symbolp f) (eq f 'guess)) - (wl-score-guess-like-gnus folder)) (t (list f))))) fl)) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 8782598..b84664c 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -749,50 +749,12 @@ you." (defun wl-summary-mode () "Major mode for reading threaded messages. -The keys that are defined for this mode are:\\ - -SPC Read messages. -DEL Back-scroll this message. -. Force to display this message. -RET Make this message scroll up with one line. -M-RET - Make this message scroll down with one line. - -C-n Go to the next line. -C-p Go to the previous line. -n Move to below then display. -N Move to next unread. -p Move to above then display. -P Move to previous unread. -s Sync current folder. -t Same as 's' but force update. -g Go to the folder which you input. -w Write a message. A new draft is prepared. -a Answer to this message. A new draft is prepared in Draft mode. -f Forward this message to a third person. A new draft is prepared in - Draft mode and this message is automatically attached. -v Toggle \"Summary and Folder view\". - You can quickly put the delete marks since the next message is not - displayed. -i Prefetch message if uncached. -o Put the refile mark('o') on this message. -! Mark current message as unread. -$ Toggle mark current message as important. -d Put the delete mark('D') on this message. -c Check all messages as read. -* Put the temporal mark('*') on this message. -u Cancel the mark on this message. -x Process marked messages. - -mo Put the refile mark onto all messages marked with '*'. - This is very convenient to refile all messages picked by '?'. -md Put the delete mark onto all messages marked with '*'. -mi Prefetch all messages marked with '*'. -mu Unmark all target-marked messages. -mt Put the '*' mark onto all messages which belong to th current thread. -ma Put the '*' mark onto all messages. -? Pick messages according to a pick pattern which you input, - then put the '*' mark onto them. -q Goto folder mode." +See Info under Wanderlust for full documentation. + +Special commands: +\\{wl-summary-mode-map} + +Entering Folder mode calls the value of `wl-summary-mode-hook'." (interactive) (unless (interactive-p) (kill-all-local-variables)) (setq major-mode 'wl-summary-mode) @@ -878,6 +840,7 @@ q Goto folder mode." expunged) (fset 'wl-summary-append-message-func-internal (wl-summary-get-append-message-func)) + (wl-summary-buffer-number-column-detect nil) (erase-buffer) (message "Re-scanning...") (setq i 0) @@ -1162,6 +1125,23 @@ q Goto folder mode." (message "%s" ret-val)) ret-val)) +(defsubst wl-summary-sync-all-init () + (wl-summary-cleanup-temp-marks) + (erase-buffer) + (wl-summary-set-message-modified) + (wl-summary-set-mark-modified) + (setq wl-thread-entity-hashtb (elmo-make-hash + (* (length (elmo-msgdb-get-number-alist + wl-summary-buffer-msgdb)) 2))) + (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil)) + (setq wl-thread-entity-list nil) + (setq wl-thread-entities nil) + (setq wl-summary-buffer-target-mark-list nil) + (setq wl-summary-buffer-refile-list nil) + (setq wl-summary-buffer-copy-list nil) + (setq wl-summary-buffer-delete-list nil) + (wl-summary-buffer-number-column-detect nil)) + (defun wl-summary-sync (&optional unset-cursor force-range) (interactive) (let* ((folder wl-summary-buffer-folder-name) @@ -1170,12 +1150,11 @@ q Goto folder mode." (msgdb-dir (elmo-msgdb-expand-path folder)) (range (or force-range (wl-summary-input-range folder))) - mes seen-list) + mes seen-list killed-list) (cond ((string= range "all") ;; initialize buffer local databases. (unless (elmo-folder-plugged-p folder) ; forbidden (error "Unplugged")) - (wl-summary-cleanup-temp-marks) (setq seen-list (nconc (elmo-msgdb-mark-alist-to-seen-list @@ -1186,19 +1165,15 @@ q Goto folder mode." (concat wl-summary-important-mark wl-summary-read-uncached-mark)) (elmo-msgdb-seen-load msgdb-dir))) - (setq wl-thread-entity-hashtb (elmo-make-hash - (* (length (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) 2))) - (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil)) - (setq wl-thread-entity-list nil) - (setq wl-thread-entities nil) - (setq wl-summary-buffer-target-mark-list nil) - (setq wl-summary-buffer-refile-list nil) - (setq wl-summary-buffer-copy-list nil) - (setq wl-summary-buffer-delete-list nil) - (wl-summary-buffer-number-column-detect nil) - (elmo-clear-killed folder) - (setq mes (wl-summary-sync-update3 seen-list unset-cursor)) + (setq killed-list (elmo-msgdb-killed-list-load msgdb-dir)) + (elmo-clear-killed wl-summary-buffer-folder-name) + (condition-case nil + (setq mes (wl-summary-sync-update3 seen-list unset-cursor + 'sync-all)) + (quit + ;; Resume killed-list if quit. + (message "") ; clear minibuffer. + (elmo-msgdb-killed-list-save msgdb-dir killed-list))) (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen. (if mes (message "%s" mes))) ;;; (wl-summary-sync-all folder t)) @@ -1276,8 +1251,12 @@ q Goto folder mode." the-email (elmo-get-hash-val the-email wl-address-petname-hash) (wl-address-header-extract-realname - (cdr (assoc (downcase the-email) - wl-address-completion-list))) t) + (cdr (assoc + (let ((completion-ignore-case t) comp) + (setq comp + (try-completion the-email wl-address-completion-list)) + (if (equal comp t) the-email comp)) + wl-address-completion-list))) t) "edited") ((eq char ?d) ;; Delete Addresses @@ -2131,37 +2110,33 @@ If ARG is non-nil, checking is omitted." (if (interactive-p) (message mes))))) (defun wl-summary-confirm-appends (appends) - (condition-case nil - (let ((len (length appends)) - in) - (if (> len wl-summary-update-confirm-threshold) - (if (y-or-n-p (format "Too many messages(%d). Continue? " len)) - appends - (setq in wl-summary-update-confirm-threshold) - (catch 'end - (while t - (setq in (read-from-minibuffer "Update number: " - (int-to-string in)) - in (string-to-int in)) - (if (< len in) - (throw 'end len)) - (if (y-or-n-p (format "%d messages are disappeared. OK? " - (max (- len in) 0))) - (throw 'end in)))) - (nthcdr (max (- len in) 0) appends)) - appends)) - (quit nil) - (error nil))) ; - -(defun wl-summary-sync-update3 (&optional seen-list unset-cursor) + (let ((len (length appends)) + in) + (if (> len wl-summary-update-confirm-threshold) + (if (y-or-n-p (format "Too many messages(%d). Continue? " len)) + appends + (setq in wl-summary-update-confirm-threshold) + (catch 'end + (while t + (setq in (read-from-minibuffer "Update number: " + (int-to-string in)) + in (string-to-int in)) + (if (< len in) + (throw 'end len)) + (if (y-or-n-p (format "%d messages are disappeared. OK? " + (max (- len in) 0))) + (throw 'end in)))) + (nthcdr (max (- len in) 0) appends)) + appends))) + +(defun wl-summary-sync-update3 (&optional seen-list unset-cursor sync-all) "Update the summary view." (interactive) (let* ((folder wl-summary-buffer-folder-name) (cur-buf (current-buffer)) - (msgdb wl-summary-buffer-msgdb) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - (overview (elmo-msgdb-get-overview msgdb)) + (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) + (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) ;;; (location (elmo-msgdb-get-location msgdb)) (case-fold-search nil) (elmo-mime-charset wl-summary-buffer-mime-charset) @@ -2173,7 +2148,7 @@ If ARG is non-nil, checking is omitted." in-folder in-db curp overview-append - entity ret-val crossed crossed2 sync-all + entity ret-val crossed crossed2 update-thread update-top-list mark expunged msgs unreads importants) ;;; (setq seen-list nil) ;for debug. @@ -2187,15 +2162,7 @@ If ARG is non-nil, checking is omitted." (message "Checking folder diff...") (elmo-commit folder) (setq in-folder (elmo-list-folder folder)) - (setq in-db (sort (mapcar 'car number-alist) '<)) - (when (or (eq msgdb nil) ; trick for unplugged... - (and (null overview) - (null number-alist) - (null mark-alist))) - (setq sync-all t) - (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) - (erase-buffer)) + (setq in-db (unless sync-all (sort (mapcar 'car number-alist) '<))) (if (not elmo-use-killed-list) (setq diff (if (eq (elmo-folder-get-type folder) 'multi) (elmo-multi-list-bigger-diff in-folder in-db) @@ -2204,6 +2171,15 @@ If ARG is non-nil, checking is omitted." (setq initial-append-list (car diff)) (setq delete-list (cadr diff)) (message "Checking folder diff...done") + ;; Confirm appended message number. + (setq append-list (wl-summary-confirm-appends initial-append-list)) + (when (and elmo-use-killed-list + (not (eq (length initial-append-list) + (length append-list))) + (setq diff (elmo-list-diff initial-append-list append-list))) + (elmo-msgdb-append-to-killed-list folder (car diff))) + ;; Setup sync-all + (if sync-all (wl-summary-sync-all-init)) ;; Don't delete important-marked msgs other than 'internal. (unless (eq (elmo-folder-get-type folder) 'internal) (setq delete-list @@ -2213,7 +2189,9 @@ If ARG is non-nil, checking is omitted." (elmo-nntp-max-number-precedes-list-active-p)) ;; XXX this does not work correctly in rare case. (setq delete-list - (wl-summary-delete-canceled-msgs-from-list delete-list msgdb))) + (wl-summary-delete-canceled-msgs-from-list + delete-list + wl-summary-buffer-msgdb))) (if (or (equal diff '(nil nil)) (equal diff '(nil)) (and (eq (length delete-list) 0) @@ -2221,13 +2199,14 @@ If ARG is non-nil, checking is omitted." (progn ;; For max-number update... (if (and (elmo-folder-contains-type folder 'nntp) - (elmo-nntp-max-number-precedes-list-active-p) - (elmo-update-number folder msgdb)) + (elmo-nntp-max-number-precedes-list-active-p) + (elmo-update-number folder wl-summary-buffer-msgdb)) (wl-summary-set-message-modified) (setq ret-val (format "No update is needed for \"%s\"" folder)))) (when delete-list (message "Deleting...") - (elmo-msgdb-delete-msgs folder delete-list msgdb t) ; reserve cache. + (elmo-msgdb-delete-msgs folder delete-list + wl-summary-buffer-msgdb t) ; reserve cache. ;;; (set-buffer cur-buf) (wl-summary-delete-messages-on-buffer delete-list "Deleting...") (message "Deleting...done")) @@ -2239,13 +2218,6 @@ If ARG is non-nil, checking is omitted." (wl-summary-set-status-marks-on-buffer wl-summary-new-mark wl-summary-unread-uncached-mark) - ;; Confirm appended message number. - (setq append-list (wl-summary-confirm-appends initial-append-list)) - (when (and elmo-use-killed-list - (not (eq (length initial-append-list) - (length append-list))) - (setq diff (elmo-list-diff initial-append-list append-list))) - (elmo-msgdb-append-to-killed-list folder (car diff))) (setq num (length append-list)) (if append-list (progn @@ -2261,15 +2233,18 @@ If ARG is non-nil, checking is omitted." ;; delete duplicated messages. (when (elmo-folder-contains-multi folder) (setq crossed (elmo-multi-delete-crossposts - msgdb result)) + wl-summary-buffer-msgdb result)) (setq result (cdr crossed)) (setq crossed (car crossed))) (setq overview-append (car result)) - (setq msgdb (elmo-msgdb-append msgdb result t)) + (setq wl-summary-buffer-msgdb + (elmo-msgdb-append wl-summary-buffer-msgdb result t)) ;; set these value for append-message-func - (setq overview (elmo-msgdb-get-overview msgdb)) - (setq number-alist (elmo-msgdb-get-number-alist msgdb)) - (setq mark-alist (elmo-msgdb-get-mark-alist msgdb)) + (setq overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) + (setq number-alist (elmo-msgdb-get-number-alist + wl-summary-buffer-msgdb)) + (setq mark-alist (elmo-msgdb-get-mark-alist + wl-summary-buffer-msgdb)) ;;; (setq location (elmo-msgdb-get-location msgdb)) (setq curp overview-append) (setq num (length curp)) @@ -2315,7 +2290,6 @@ If ARG is non-nil, checking is omitted." )) (wl-summary-set-message-modified) (wl-summary-set-mark-modified) - (setq wl-summary-buffer-msgdb msgdb) (when (and sync-all (eq wl-summary-buffer-view 'thread)) (elmo-kill-buffer wl-summary-search-buf-name) (message "Inserting thread...") @@ -2333,7 +2307,7 @@ If ARG is non-nil, checking is omitted." ;; scoring (when wl-use-scoring (setq wl-summary-scored nil) - (wl-summary-score-headers nil msgdb + (wl-summary-score-headers nil wl-summary-buffer-msgdb (and sync-all (wl-summary-rescore-msgs number-alist)) sync-all) @@ -2358,7 +2332,7 @@ If ARG is non-nil, checking is omitted." (wl-folder-set-folder-updated folder (list 0 (wl-summary-count-unread (elmo-msgdb-get-mark-alist - msgdb)) + wl-summary-buffer-msgdb)) (length in-folder))) (wl-summary-update-modeline) (wl-summary-buffer-number-column-detect t) @@ -2540,7 +2514,7 @@ If ARG is non-nil, checking is omitted." nil)))) (defun wl-summary-toggle-thread (&optional arg) - "Toggle thread status (T)hread and (S)equencial. + "Toggle thread status (T)hread and (S)equential. If ARG, without confirm." (interactive "P") (when (or arg @@ -4326,6 +4300,9 @@ If ARG, exit virtual folder." (unless no-server-update (elmo-unmark-important folder (list number) msgdb) (elmo-msgdb-global-mark-delete message-id)) + ;; Remove cache if local it is folder. + (if (elmo-folder-local-p folder) + (elmo-cache-delete message-id folder number)) (when visible (delete-region (match-beginning 2) (match-end 2)) (insert " ")) diff --git a/wl/wl-thread.el b/wl/wl-thread.el index e028615..e153785 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -550,47 +550,51 @@ The closed parent will be opened." "Close all top threads." (interactive) (message "Closing all threads...") - (let ((entities wl-thread-entity-list) - (cur 0) - (len (length wl-thread-entity-list))) - (while entities - (when (and (wl-thread-entity-get-opened (wl-thread-get-entity - (car entities))) - (wl-thread-entity-get-children (wl-thread-get-entity - (car entities)))) - (wl-summary-jump-to-msg (car entities)) - (wl-thread-open-close)) - (when (> len elmo-display-progress-threshold) - (setq cur (1+ cur)) - (if (or (zerop (% cur 5)) (= cur len)) - (elmo-display-progress - 'wl-thread-close-all "Closing all threads..." - (/ (* cur 100) len)))) - (setq entities (cdr entities)))) - (message "Closing all threads...done") - (goto-char (point-max))) + (save-excursion + (let ((entities wl-thread-entity-list) + (cur 0) + (len (length wl-thread-entity-list))) + (while entities + (when (and (wl-thread-entity-get-opened (wl-thread-get-entity + (car entities))) + (wl-thread-entity-get-children (wl-thread-get-entity + (car entities)))) + (wl-summary-jump-to-msg (car entities)) + (wl-thread-open-close)) + (when (> len elmo-display-progress-threshold) + (setq cur (1+ cur)) + (if (or (zerop (% cur 5)) (= cur len)) + (elmo-display-progress + 'wl-thread-close-all "Closing all threads..." + (/ (* cur 100) len)))) + (setq entities (cdr entities))))) + (message "Closing all threads...done")) (defun wl-thread-open-all () "Open all threads." (interactive) (message "Opening all threads...") - (let ((entities wl-thread-entity-list) - (cur 0) - (len (length wl-thread-entity-list))) - (while entities - (if (not (wl-thread-entity-get-opened (wl-thread-get-entity - (car entities)))) - (wl-thread-entity-force-open (wl-thread-get-entity - (car entities)))) - (when (> len elmo-display-progress-threshold) - (setq cur (1+ cur)) - (if (or (zerop (% cur 5)) (= cur len)) - (elmo-display-progress - 'wl-thread-open-all "Opening all threads..." - (/ (* cur 100) len)))) - (setq entities (cdr entities)))) - (message "Opening all threads...done") - (goto-char (point-max))) + (save-excursion + (goto-char (point-min)) + (let ((len (count-lines (point-min) (point-max))) + (cur 0) + entity) + (while (not (eobp)) + (unless (wl-thread-entity-get-opened + (setq entity (wl-thread-get-entity + (wl-summary-message-number)))) + (wl-thread-entity-force-open entity)) + (wl-thread-goto-bottom-of-sub-thread) + (when (> len elmo-display-progress-threshold) + (setq cur (1+ cur)) + (elmo-display-progress + 'wl-thread-open-all "Opening all threads..." + (/ (* cur 100) len))))) + ;; Make sure to be 100%. + (elmo-display-progress + 'wl-thread-open-all "Opening all threads..." + 100)) + (message "Opening all threads...done")) (defun wl-thread-open-all-unread () (interactive) diff --git a/wl/wl-util.el b/wl/wl-util.el index 5f57d24..6ad81f5 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -33,8 +33,6 @@ ;;; Code: ;; -(require 'product) -(product-provide (provide 'wl-util) (require 'wl-version)) (eval-when-compile (require 'elmo-util)) @@ -43,7 +41,6 @@ (eval-when-compile (require 'time-stamp) - (defalias-maybe 'read-event 'ignore) (defalias-maybe 'next-command-event 'ignore) (defalias-maybe 'event-to-character 'ignore) (defalias-maybe 'key-press-event-p 'ignore) @@ -151,28 +148,6 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses, (append list (list element)) list)) -(defun wl-read-event-char () - "Get the next event." - (let ((event (read-event))) - ;; should be gnus-characterp, but this can't be called in XEmacs anyway - (cons (and (numberp event) event) event))) - -(defun wl-xmas-read-event-char () - "Get the next event." - (let ((event (next-command-event))) - (sit-for 0) - ;; We junk all non-key events. Is this naughty? - (while (not (or (key-press-event-p event) - (button-press-event-p event))) - (dispatch-event event) - (setq event (next-command-event))) - (cons (and (key-press-event-p event) - (event-to-character event)) - event))) - -(if wl-on-xemacs - (fset 'wl-read-event-char 'wl-xmas-read-event-char)) - (defmacro wl-push (v l) "Insert V at the head of the list stored in L." (list 'setq l (list 'cons v l))) @@ -901,4 +876,7 @@ This function is imported from Emacs 20.7." notify-minibuf) (setq wl-biff-check-folders-running nil))))) +(require 'product) +(product-provide (provide 'wl-util) (require 'wl-version)) + ;;; wl-util.el ends here diff --git a/wl/wl-version.el b/wl/wl-version.el index 4c83a1c..b3d014b 100644 --- a/wl/wl-version.el +++ b/wl/wl-version.el @@ -27,11 +27,17 @@ ;;; Commentary: ;; +;; Put the following lines to each file of Wanderlust package. +;; +;; (require 'product) +;; (product-provide (provide FEATURE) (require 'wl-version)) ;;; Code: ;; (require 'product) (require 'elmo-version) ; product-version-as-string +(eval-when-compile + (require 'elmo-util)) ; elmo-match-string (provide 'wl-version) ; before product-provide ;; product-define in the first place @@ -45,9 +51,6 @@ ;; set version-string (product-version-as-string 'wl-version) -;; require wl-util after product-provide. -(eval-when-compile (require 'wl-util)) ; wl-match-string - (defun wl-version (&optional with-codename) "Return Wanderlust version. If WITH-CODENAME add codename." @@ -57,12 +60,13 @@ If WITH-CODENAME add codename." "Print Wanderlust version. If ARG insert string at point." (interactive "P") - (if arg - (insert (message "%s" (wl-version t))) - (message "%s" (wl-version t)))) + (let ((product-info (product-string-1 'wl-version t))) + (if arg + (insert product-info) + (message "%s" product-info)))) (defvar wl-version-status-alist - '(((eq (% (nth 1 (product-version (product-find 'wl-version))) 2) 0) + '(((zerop (% (nth 1 (product-version (product-find 'wl-version))) 2)) . "stable") (t . "beta")) "An alist to define the version status.") @@ -78,7 +82,7 @@ If ARG insert string at point." (setq salist (cdr salist))) status)) -;; compile warning +;; avoid compile warnings (defvar mule-version) (defvar nemacs-version) (defvar emacs-beta-version) @@ -93,48 +97,45 @@ If ARG insert string at point." Insert User-Agent field instead of X-Mailer field." (concat "User-Agent: " (wl-generate-user-agent-string-1 + ;; for backward compatibility (or (and (boundp 'mime-edit-insert-user-agent-field) - mime-edit-insert-user-agent-field) + mime-edit-insert-user-agent-field) ; SEMI (and (boundp 'mime-editor/version) - mime-editor/version))))) + mime-editor/version))))) ; verbose User-Agent when tm (defun wl-generate-user-agent-string-1 (&optional verbose) "Return User-Agent field value. If VERBOSE return with SEMI, FLIM and APEL version." - (if (not verbose) - ;; Don't use product-string-verbose for short User-Agent field value. - (concat (product-string-1 'wl-version t) " " - (wl-extended-emacs-version3 "/" t)) - ;; verbose - (cond - ;; SEMI - ((and (boundp 'mime-edit-user-agent-value) mime-edit-user-agent-value) - (concat (product-string-verbose 'wl-version) " " - mime-edit-user-agent-value)) - ;; tm - ((and (boundp 'mime-editor/version) mime-editor/version) - (concat (product-string-verbose 'wl-version) " " - "tm/" mime-editor/version - (if (and (boundp 'mime-editor/codename) - mime-editor/codename) - (concat " (" mime-editor/codename ")")) - (if (and (boundp 'mime-library-product) - mime-library-product) - (concat " " (aref mime-library-product 0) - "/" - (mapconcat 'int-to-string + (cond + ;; Don't use `product-string-verbose' for short User-Agent field value. + ((not verbose) + (concat (product-string-1 'wl-version t) " " + (wl-extended-emacs-version3 "/" t))) + ;; SEMI (verbose) + ((and (boundp 'mime-edit-user-agent-value) mime-edit-user-agent-value) + (concat (product-string-verbose 'wl-version) " " + mime-edit-user-agent-value)) + ;; tm (verbose) + ((and (boundp 'mime-editor/version) mime-editor/version) + (concat (product-string-verbose 'wl-version) " " + "tm/" mime-editor/version + (when (and (boundp 'mime-editor/codename) mime-editor/codename) + (concat " (" mime-editor/codename ")")) + (when (and (boundp 'mime-library-product) mime-library-product) + (concat " " (aref mime-library-product 0) + "/" (mapconcat 'int-to-string (aref mime-library-product 1) ".") - " (" (aref mime-library-product 2) ")")) - (condition-case nil - (progn - (require 'apel-ver) - (concat " " (apel-version))) - (file-error nil)) - " " (wl-extended-emacs-version3 "/" t))) - ;; error case - (t - (product-string-1 'wl-version nil))))) + " (" (aref mime-library-product 2) ")")) + (condition-case nil + (progn + (require 'apel-ver) + (concat " " (apel-version))) + (file-error nil)) + " " (wl-extended-emacs-version3 "/" t))) + ;; error case + (t + (product-string-1 'wl-version nil)))) ;; from gnus (defun wl-extended-emacs-version (&optional with-codename) @@ -142,34 +143,32 @@ If VERBOSE return with SEMI, FLIM and APEL version." If WITH-CODENAME add XEmacs codename." (cond ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs " (wl-match-string 1 emacs-version) - (and (boundp 'mule-version)(concat "/Mule " mule-version)))) + (concat "Emacs " (elmo-match-string 1 emacs-version) + (when (boundp 'mule-version) (concat "/Mule " mule-version)))) ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" emacs-version) - (concat (wl-match-string 1 emacs-version) + (concat (elmo-match-string 1 emacs-version) (format " %d.%d" emacs-major-version emacs-minor-version) - (if (and (boundp 'emacs-beta-version) - emacs-beta-version) - (format "b%d" emacs-beta-version)) - (if with-codename - (if (boundp 'xemacs-codename) - (concat " - \"" xemacs-codename "\""))))) + (when (and (boundp 'emacs-beta-version) emacs-beta-version) + (format "b%d" emacs-beta-version)) + (when (and with-codename + (boundp 'xemacs-codename) xemacs-codename) + (concat " - \"" xemacs-codename "\"")))) (t emacs-version))) (defun wl-extended-emacs-version2 (&optional delimiter with-codename) "Stringified Emacs version. Separate DELIMITER (default is \" \"). If WITH-CODENAME add XEmacs codename." (cond - ((and (boundp 'mule-version) - mule-version + ((and (boundp 'mule-version) mule-version (string-match "\\([0-9]+\.[0-9]+\\)\\(.*$\\)" mule-version)) (format "Mule%s%s@%d.%d%s" (or delimiter " ") - (wl-match-string 1 mule-version) + (elmo-match-string 1 mule-version) emacs-major-version emacs-minor-version (if with-codename - (wl-match-string 2 mule-version) + (elmo-match-string 2 mule-version) ""))) ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) (if (boundp 'nemacs-version) @@ -180,36 +179,33 @@ Separate DELIMITER (default is \" \"). If WITH-CODENAME add XEmacs codename." (match-beginning 1) (match-end 1))) (concat "Emacs" (or delimiter " ") - (wl-match-string 1 emacs-version)))) + (elmo-match-string 1 emacs-version)))) ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" emacs-version) - (concat (wl-match-string 1 emacs-version) + (concat (elmo-match-string 1 emacs-version) (or delimiter " ") (format "%d.%d" emacs-major-version emacs-minor-version) - (if (and (boundp 'emacs-beta-version) - emacs-beta-version) - (format "b%d" emacs-beta-version)) - (if (and with-codename - (boundp 'xemacs-codename) - xemacs-codename) - (format " (%s)" xemacs-codename)))) + (when (and (boundp 'emacs-beta-version) emacs-beta-version) + (format "b%d" emacs-beta-version)) + (when (and with-codename + (boundp 'xemacs-codename) xemacs-codename) + (format " (%s)" xemacs-codename)))) (t emacs-version))) (defun wl-extended-emacs-version3 (&optional delimiter with-codename) "Stringified Emacs version. Separate DELIMITER (default is \" \"). If WITH-CODENAME add XEmacs codename." (cond - ((and (boundp 'mule-version) - mule-version + ((and (boundp 'mule-version) mule-version (string-match "\\([0-9]+\.[0-9]+\\)\\(.*$\\)" mule-version)) (format "Emacs%s%d.%d Mule%s%s%s" (or delimiter " ") emacs-major-version emacs-minor-version (or delimiter " ") - (wl-match-string 1 mule-version) + (elmo-match-string 1 mule-version) (if with-codename - (wl-match-string 2 mule-version) + (elmo-match-string 2 mule-version) ""))) ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) (if (boundp 'nemacs-version) @@ -218,7 +214,7 @@ Separate DELIMITER (default is \" \"). If WITH-CODENAME add XEmacs codename." ("3.2.3" . " (YUMENO-AWAYUKI)")))) (format "Emacs%s%s Nemacs%s%s%s" (or delimiter " ") - (wl-match-string 1 emacs-version) + (elmo-match-string 1 emacs-version) (or delimiter " ") nemacs-version (or (and with-codename @@ -226,19 +222,17 @@ Separate DELIMITER (default is \" \"). If WITH-CODENAME add XEmacs codename." nemacs-codename-assoc))) ""))) (concat "Emacs" (or delimiter " ") - (wl-match-string 1 emacs-version)))) + (elmo-match-string 1 emacs-version)))) ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" emacs-version) - (concat (wl-match-string 1 emacs-version) + (concat (elmo-match-string 1 emacs-version) (or delimiter " ") (format "%d.%d" emacs-major-version emacs-minor-version) - (if (and (boundp 'emacs-beta-version) - emacs-beta-version) - (format "b%d" emacs-beta-version)) - (if (and with-codename - (boundp 'xemacs-codename) - xemacs-codename) - (format " (%s)" xemacs-codename)))) + (when (and (boundp 'emacs-beta-version) emacs-beta-version) + (format "b%d" emacs-beta-version)) + (when (and with-codename + (boundp 'xemacs-codename) xemacs-codename) + (format " (%s)" xemacs-codename)))) (t emacs-version))) diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index d301722..8e95570 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -518,6 +518,19 @@ Special commands: (defalias 'wl-defface 'defface) +(defun wl-read-event-char () + "Get the next event." + (let ((event (next-command-event))) + (sit-for 0) + ;; We junk all non-key events. Is this naughty? + (while (not (or (key-press-event-p event) + (button-press-event-p event))) + (dispatch-event event) + (setq event (next-command-event))) + (cons (and (key-press-event-p event) + (event-to-character event)) + event))) + (require 'product) (product-provide (provide 'wl-xmas) (require 'wl-version)) diff --git a/wl/wl.el b/wl/wl.el index e5b3926..573e363 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -32,6 +32,8 @@ ;; (require 'elmo2) +(require 'wl-version) ; reduce recursive-load-depth + ;; from x-face.el (unless (and (fboundp 'defgroup) (fboundp 'defcustom)) @@ -43,7 +45,6 @@ (require 'wl-vars) (require 'wl-util) -(require 'wl-version) (cond (wl-on-xemacs (require 'wl-xmas)) @@ -54,7 +55,7 @@ (t (require 'wl-mule))) -(provide 'wl) ; circular dependency +(provide 'wl) ; circular dependency (require 'wl-folder) (require 'wl-summary) (require 'wl-thread)