* Version number is increased to 2.5.5.
* elmo-version.el (elmo-version): Up to 2.5.5.
@c %**end of header
@documentlanguage ja
@documentencoding iso-2022-jp
-@set VERSION 2.5.4
+@set VERSION 2.5.5
@synindex pg cp
@finalout
@c %**end of header
@documentlanguage en
@documentencoding us-ascii
-@set VERSION 2.5.4
+@set VERSION 2.5.5
@synindex pg cp
@finalout
+2001-01-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-version.el (elmo-version): Up to 2.5.5.
+
2000-12-22 Yuuichi Teranishi <teranisi@gohome.org>
* elmo-imap4.el (elmo-network-authenticate-session):
* elmo-version.el (elmo-version): Up to 2.5.2.
-2000-11-15 Yuuichi Teranishi <teranisi@gohome.org>
+2001-01-16 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <sa264@cam.ac.uk>)
+
+ * elmo-pop3.el (elmo-pop3-msgdb-create-as-numlist): Sort msgdb by date.
+ (Pointed out by Mikiya Tani <m-tani@hml.cl.nec.co.jp>)
+
+2001-01-13 Takaaki MORIYAMA <taka@airlab.cs.ritsumei.ac.jp>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <imai@on.rim.or.jp>)
+
+2001-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * elmo-archive.el (elmo-archive-call-process): Don't check for
+ the exit status when Nemacs is running.
+
+2001-01-09 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <kaoru@kaisei.org>
+
+ * elmo2.el (toplevel): Move `product-provide' declare.
+ * mmelmo.el (toplevel): Ditto.
+
+2000-12-26 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-util.el (elmo-folder-get-store-type): Rewrite.
+
+2000-12-26 OKAZAKI Tetsurou <okazaki@be.to>
+
+ * elmo-util.el (elmo-folder-get-store-type): New function.
+ (elmo-folder-direct-copy-p): Use it.
+
+2000-12-26 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <okada@opaopa.org>
+
+ * elmo-imap4.el (toplevel): Require 'ssl.
+ Add autoload 'starttls.
+ * elmo-pop3.el (toplevel): Ditto.
+ * elmo-nntp.el (toplevel): Ditto.
+
+2000-11-20 Kenichi OKADA <okada@opaopa.org>
+
+ * 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 <okada@opaopa.org>
+
+ * elmo-imap4.el (elmo-network-authenticate-session): Use `elmo-imap4-login'
+
+2000-11-20 Kenichi OKADA <okada@opaopa.org>
+
+ * 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 <okada@opaopa.org>
+
+ * elmo-pop3.el (elmo-network-authenticate-session): Fix for `APOP'.
+
+2000-11-20 Kenichi OKADA <okada@opaopa.org>
+
+ * elmo-pop3.el (elmo-network-authenticate-session): Split
+ encoded response value.
+
+2000-11-20 Kenichi OKADA <okada@opaopa.org>
+
+ * 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 <okada@opaopa.org>
+
+ * 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 <okada@opaopa.org>
+
+ * 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 <okada@opaopa.org>
+
+ * elmo-pop3.el (toplevel): Delete defun-maybe for sasl-*.
+ Delete `elmo-pop3-authenticator-alist'.
+
+2000-11-19 Kenichi OKADA <okada@opaopa.org>
+
+ * elmo-pop3.el (elmo-network-authenticate-session): Rewrite for
+ new SASL API.
+ * elmo-imap4.el (elmo-network-authenticate-session): Ditto.
+
+\f
+2000-12-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-nntp.el (elmo-nntp-get-folders-info): Fixed last change.
+
+2000-12-01 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-nntp.el (elmo-nntp-get-folders-info):
+ Fixed problem when '\' character is contained in user-id.
+ (Reported by Yoichiro Okabe <okabe@wizsoft.co.jp>)
+
+\f
+2000-11-28 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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.
;;; Commentary:
;;
;; TODO:
-;; [\e$B%\%=\e(B] append-msgs() \e$B$,M_$7$$!J$1$I\e(B multi-refile \e$BIT2D!K!#\e(B
-;; Info-Zip \e$B@lMQ%(!<%8%'%s%H$rMQ$$$?F|K\8l8!:w!J\e(BOS/2 \e$B@lMQ!K!#\e(B
+;; [¥Ü¥½] append-msgs() ¤¬Íߤ·¤¤¡Ê¤±¤É multi-refile ÉԲġˡ£
+;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£
;;; Code:
;;
(` (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
(require 'utf7)
;;; Code:
-;; silence byte compiler.
(eval-when-compile (require 'cl))
(defvar elmo-imap4-use-lock t
;;;
(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)
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)
(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
;;
;; 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)))))
(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
(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
" "
(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)
(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
(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
;;; (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)
(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))
(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)
(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))
(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.
(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))
(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)))
(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 ()
(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
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
(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
(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
(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)
(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)))))
(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)))
(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))
(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)))
;;; Commentary:
;;
+;; Put the following lines to each file of ELMO package.
+;;
+;; (require 'product)
+;; (product-provide (provide FEATURE) (require 'elmo-version))
;;; Code:
;;
;; 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)
;;; 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)
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)))
"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)
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)
(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
(require 'mime-parse)
(require 'mmbuffer)
-(require 'product)
-(product-provide (provide 'mmelmo) (require 'elmo-version))
+(provide 'mmelmo) ; circular dependency
(require 'mmelmo-imap4)
(eval-and-compile
;; (mime-buffer-entity-body-end-internal entity)))
;; (mime-entity-encoding entity)))
+(require 'product)
+(product-provide (provide 'mmelmo) (require 'elmo-version))
+
;;; mmelmo.el ends here
;;; -*- emacs-lisp -*-
;;; ~/.wl (setting file for Wanderlust)
-;;; Last-Modified: 1999-11-07
;;;
;; Following must be included in ~/.emacs
("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.
;; 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)
)))
;;; -*- emacs-lisp -*-
;;; ~/.wl (setting file for Wanderlust)
-;;; Last-Modified: 1999-11-07
;;;
;; \e$B$^$:!$<!$N@_Dj$r\e(B ~/.emacs \e$B$J$I$K=q$$$F$/$@$5$$!#\e(B
("To" . "boss@company.jp")
("Subject" . "\e$BJs9p\e(B")
(top . "\e$B:#=5$NJs9p$G$9!#\e(B\n") ;; \e$BK\J8@hF,$X$NA^F~\e(B
-;; (file-bottom . "~/work/report.txt") ;; \e$BK\J8KvHx$X%U%!%$%k$NA^F~\e(B
+;; (bottom-file . "~/work/report.txt") ;; \e$BK\J8KvHx$X%U%!%$%k$NA^F~\e(B
)
))
;; x-face-mule 0.20\e$B0J8e\e(B
(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)
)))
+2001-01-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * wl-summary.el (wl-summary-rescan):
+ Call `wl-summary-buffer-number-column-detect'.
+ (Advised by Akihiro MOTOKI <mokkun@iname.com>)
+
+ * wl-message.el (wl-message-mode-map): Define.
+ (wl-message-decode): Use it as local-map.
+
+2001-01-16 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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 <yamaoka@jpl.org>
+
+ * wl-nemacs.el (elmo-archive-call-process): Moved to
+ elmo-archive.el.
+
+2001-01-02 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * 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 <kaoru@kaisei.org>
+
+ * 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 <kaoru@kaisei.org>
+
+ * wl-highlight.el (wl-highlight-headers): Revert
+ `wl-highlight-x-face-func' argument (`beg' and `end').
+
+2000-12-29 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * wl-thread.el (wl-thread-open-all): Rewrite to open all threads and
+ keep cursor position. (Advised by OKAZAKI Tetsurou <okazaki@be.to>)
+ (wl-thread-close-all): keep cursor position.
+
+2000-12-24 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * 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 <okada@opaopa.org>
+
+ * wl.el (wl-check-environment): Additional check for
+ 'wl-local-domain' and `wl-message-id-domain'.
+
+2000-11-19 Kenichi OKADA <okada@opaopa.org>
+
+ * wl-draft.el (toplevel): Delete defvar for sasl-*.
+
+2000-11-19 Kenichi OKADA <okada@opaopa.org>
+
+ * wl-draft.el (wl-smtp-extension-bind): Use `smtp-sasl-properties'
+ instead of `smtp-sasl-user-realm'.
+
+2000-11-19 Kenichi OKADA <okada@opaopa.org>
+
+ * wl-draft.el (wl-smtp-extension-bind): Rewrite for new SASL API.
+
+2000-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <kaoru@kaisei.org>
+
+ * 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 <kaoru@kaisei.org>
+
+ * wl-summary.el (wl-summary-mode): Use \\{wl-summary-mode-map} in
+ docstring.
+
+2000-12-10 Hironori Fukuchi <nory@valis.co.jp>
+
+ * wl-summary.el (wl-summary-toggle-thread): Docstring typo fix.
+
+2000-12-15 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * wl-highlight.el (wl-highlight-headers): Remove
+ `wl-highlight-x-face-func' argument (`beg' and `end').
+
+2000-12-15 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-summary.el (wl-summary-mark-as-important):
+ Remove cache if folder is local.
+
+2000-12-06 Taro Kawagishi <taro.kawagishi@nokia.com>
+
+ * wl-summary.el (wl-summary-edit-addresses-subr): Call `try-completion'
+ to get existing e-mail address string.
+
+2000-12-13 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+ * 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 <teranisi@gohome.org>
+
+ * 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" <hirose31@t3.rim.or.jp>)
+
2000-12-12 KOGURO Naoki <koguro@dd.iij4u.or.jp>
* wl-draft.el (wl-draft-send-mail-with-pop-before-smtp): Close POP
(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))
;;
(defconst wl-demo-copyright-notice
- "Copyright (C) 1998-2000 Yuuichi Teranishi <teranisi@gohome.org>")
+ "Copyright (C) 1998-2001 Yuuichi Teranishi <teranisi@gohome.org>")
(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"))
(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
;;; Code:
;;
-(require 'product)
-(product-provide (provide 'wl-dnd) (require 'wl-version))
-
(static-cond
((featurep 'offix)
(defun start-drag (event what &optional typ)
(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
(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
(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)
(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)
(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)
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))
(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
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))))
",")))
(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))
(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")
(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
(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."
(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))
# This file is generated automatically by %s.
#
-" (wl-version t)))
+" (product-string-1 'wl-version t)))
;;; Initial setup
(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}
(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
(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)
(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
(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 ()
(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)
(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.
(set-buffer buf)
filename))))
-;;; wl-message.el ends here
-
+(require 'product)
+(product-provide (provide 'wl-message) (require 'wl-version))
+;;; wl-message.el ends here
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))
(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 ())
(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))))
(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")
(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
(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
fl
(cond ((functionp f)
(funcall f folder))
- ((and (symbolp f) (eq f 'guess))
- (wl-score-guess-like-gnus folder))
(t
(list f)))))
fl))
(defun wl-summary-mode ()
"Major mode for reading threaded messages.
-The keys that are defined for this mode are:\\<wl-summary-mode-map>
-
-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)
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)
(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)
(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
(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))
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
(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)
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.
(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)
(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
(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)
(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"))
(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
;; 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))
))
(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...")
;; 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)
(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)
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
(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 " "))
"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)
;;; Code:
;;
-(require 'product)
-(product-provide (provide 'wl-util) (require 'wl-version))
(eval-when-compile
(require 'elmo-util))
(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)
(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)))
notify-minibuf)
(setq wl-biff-check-folders-running nil)))))
+(require 'product)
+(product-provide (provide 'wl-util) (require 'wl-version))
+
;;; wl-util.el ends here
;;; 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
;; 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."
"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.")
(setq salist (cdr salist)))
status))
-;; compile warning
+;; avoid compile warnings
(defvar mule-version)
(defvar nemacs-version)
(defvar emacs-beta-version)
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)
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)
(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)
("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
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)))
(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))
;;
(require 'elmo2)
+(require 'wl-version) ; reduce recursive-load-depth
+
;; from x-face.el
(unless (and (fboundp 'defgroup)
(fboundp 'defcustom))
(require 'wl-vars)
(require 'wl-util)
-(require 'wl-version)
(cond (wl-on-xemacs
(require 'wl-xmas))
(t
(require 'wl-mule)))
-(provide 'wl) ; circular dependency
+(provide 'wl) ; circular dependency
(require 'wl-folder)
(require 'wl-summary)
(require 'wl-thread)
projects / elisp / wanderlust.git / commitdiff