Skip to content

Instantly share code, notes, and snippets.

@dabrahams

dabrahams/more-wl.diff

Created January 11, 2010 19:10
Show Gist options
  • Save dabrahams/274490 to your computer and use it in GitHub Desktop.
Save dabrahams/274490 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
more-wl.diff
Changes in HEAD
Modified ChangeLog
diff --git a/ChangeLog b/ChangeLog
index 1e9d30b..acb0953 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2010-01-04 TAKAHASHI Kaoru <[email protected]>
+
+ * WL-MK (wl-scan-source, wl-uninstall)
+ (compile-wl-package, install-wl-package)
+ (compile-wl-package-xmas, install-wl-package-xmas)
+ (wl-texinfo-format, wl-texinfo-install) : Use `mapc' instead of
+ `mapcar'. Don't quote `lambda'.
+
2008-11-25 TAKAHASHI Kaoru <[email protected]>
* INSTALL: Updated recommended version of FLIM.
Modified INSTALL
diff --git a/INSTALL b/INSTALL
index 4c604a8..6728742 100644
--- a/INSTALL
+++ b/INSTALL
@@ -18,7 +18,7 @@ System Requirements
modules.
SEMI (1.14.6 or later)
- FLIM (1.14.6 or later)
+ FLIM (1.14.9 or later)
Wanderlust and MIME modules require APEL. Before installing MIME
modules, please install the APEL.
Modified NEWS
diff --git a/NEWS b/NEWS
index 8c0aa06..70ae975 100644
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,8 @@ Wanderlust NEWS -- User-visible changes in Wanderlust.
** Open following thread when you put mark on message in summary buffer.
+** Add new command wl-summary-display-raw.
+
** Use EasyPG (http://www.easypg.org) if it is available.
** A folder type `namazu' is abolished. New folder type `search' is added instead.
Modified WL-MK
diff --git a/WL-MK b/WL-MK
index 89d7af2..d7ab2d6 100644
--- a/WL-MK
+++ b/WL-MK
@@ -212,25 +212,25 @@
(defun wl-scan-source (path)
(let (ret)
- (mapcar
- '(lambda (x)
- (mapcar '(lambda (y)
- (setq ret (append (list y (concat y "c")) ret)))
- (directory-files x nil "\\(.+\\)\\.el$" t)))
+ (mapc
+ (lambda (x)
+ (mapc (lambda (y)
+ (setq ret (append (list y (concat y "c")) ret)))
+ (directory-files x nil "\\(.+\\)\\.el$" t)))
path)
ret))
(defun wl-uninstall (objs path)
;(message (mapconcat 'identity objs " "))
- (mapcar
- '(lambda (x)
- (let ((filename (expand-file-name x path)))
- (if (and (file-exists-p filename)
- (file-writable-p filename))
- (progn
- (princ (format "%s was uninstalled.\n" filename))
- (delete-file filename)))))
+ (mapc
+ (lambda (x)
+ (let ((filename (expand-file-name x path)))
+ (if (and (file-exists-p filename)
+ (file-writable-p filename))
+ (progn
+ (princ (format "%s was uninstalled.\n" filename))
+ (delete-file filename)))))
objs))
@@ -246,9 +246,9 @@
(defun compile-wl-package ()
(config-wl-package)
(make-wl-news)
- (mapcar
- '(lambda (x)
- (compile-elisp-modules (cdr x) (car x)))
+ (mapc
+ (lambda (x)
+ (compile-elisp-modules (cdr x) (car x)))
modules-alist))
(defun install-wl-icons ()
@@ -269,12 +269,12 @@
(compile-wl-package)
(let ((wl-install-dir (expand-file-name WL_PREFIX LISPDIR))
(elmo-install-dir (expand-file-name ELMO_PREFIX LISPDIR)))
- (mapcar
- '(lambda (x)
- (install-elisp-modules (cdr x) (car x)
- (if (string= (car x) ELMODIR)
- elmo-install-dir
- wl-install-dir)))
+ (mapc
+ (lambda (x)
+ (install-elisp-modules (cdr x) (car x)
+ (if (string= (car x) ELMODIR)
+ elmo-install-dir
+ wl-install-dir)))
modules-alist))
(if PIXMAPDIR
(install-wl-icons)))
@@ -333,9 +333,9 @@
(Custom-make-dependencies)
;; WL-AUTOLOAD-MODULES
(compile-elisp-modules WL-AUTOLOAD-MODULES WLDIR)
- (mapcar
- '(lambda (x)
- (compile-elisp-modules (cdr x) (car x)))
+ (mapc
+ (lambda (x)
+ (compile-elisp-modules (cdr x) (car x)))
modules-alist))
(defun install-wl-package-xmas ()
@@ -354,9 +354,9 @@
;; copy xpm files
(install-wl-icons)
- (mapcar '(lambda (x)
- (install-elisp-modules (cdr x) (car x) LISPDIR))
- modules-alist)
+ (mapc (lambda (x)
+ (install-elisp-modules (cdr x) (car x) LISPDIR))
+ modules-alist)
;; WL-AUTOLOAD-MODULES
(install-elisp-modules WL-AUTOLOAD-MODULES WLDIR LISPDIR)
;;
@@ -403,7 +403,7 @@
(wl-detect-info-directory)
(cond ((null wl-info-lang))
((listp wl-info-lang)
- (mapcar 'wl-texinfo-format-file wl-info-lang))
+ (mapc 'wl-texinfo-format-file wl-info-lang))
((stringp wl-info-lang)
(wl-texinfo-format-file wl-info-lang))))
@@ -414,7 +414,7 @@
(defun wl-texinfo-install ()
(cond ((null wl-info-lang))
((listp wl-info-lang)
- (mapcar 'wl-texinfo-install-file wl-info-lang))
+ (mapc 'wl-texinfo-install-file wl-info-lang))
((stringp wl-info-lang)
(wl-texinfo-install-file wl-info-lang))))
Modified doc/version.tex
diff --git a/doc/version.tex b/doc/version.tex
index e28e31d..da3039d 100644
--- a/doc/version.tex
+++ b/doc/version.tex
@@ -1 +1 @@
-\def\versionnumber{2.15.6}
+\def\versionnumber{2.15.8}
Modified doc/version.texi
diff --git a/doc/version.texi b/doc/version.texi
index 7ad8153..ad49f49 100644
--- a/doc/version.texi
+++ b/doc/version.texi
@@ -1 +1 @@
-@set VERSION 2.15.6
+@set VERSION 2.15.8
Modified elmo/acap.el
diff --git a/elmo/acap.el b/elmo/acap.el
index 7047dcd..c2ad7e3 100644
--- a/elmo/acap.el
+++ b/elmo/acap.el
@@ -812,7 +812,8 @@ ENTRIES is a store-entry list."
(progn
(acap-forward)
(acap-parse-return-data-list)))))
- (ALERT ;(cons 'alert (acap-parse-resp-body))
+ (ALERT
+;;; (cons 'alert (acap-parse-resp-body))
(message "%s" (nth 1 (acap-parse-resp-body))))
((BYE Bye bye)
(cons 'bye (acap-parse-resp-body)))
@@ -834,7 +835,8 @@ ENTRIES is a store-entry list."
;; response-stat
(OK (cons 'stat-ok (acap-parse-resp-body)))
(NO (cons 'stat-no (acap-parse-resp-body)))
- (BAD ;(cons 'stat-bad (acap-parse-resp-body))
+ (BAD
+;;; (cons 'stat-bad (acap-parse-resp-body))
;; XXX cyrus-sml-acap does not return tagged bad response?
(error "%s" (nth 1 (acap-parse-resp-body))))))
((integerp token)
Modified elmo/elmo-archive.el
diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el
index 31b7c70..a2b9549 100644
--- a/elmo/elmo-archive.el
+++ b/elmo/elmo-archive.el
@@ -147,11 +147,11 @@
(defvar elmo-archive-suffix-alist
'((lha . ".lzh") ; default
-;;; (lha . ".lzs")
+;;; (lha . ".lzs")
(zip . ".zip")
(zoo . ".zoo")
-;;; (arc . ".arc")
-;;; (arj . ".arj")
+;;; (arc . ".arc")
+;;; (arj . ".arj")
(rar . ".rar")
(tar . ".tar")
(tgz . ".tar.gz")))
@@ -219,7 +219,7 @@
'((ls . ("gtar" "-tf"))
(cat . ("gtar" "-Oxf"))
(ext . ("gtar" "-xf"))
-;;; (rm . ("gtar" "--delete" "-f")) ;; well not work
+;;; (rm . ("gtar" "--delete" "-f")) ; well not work
)))
;;; GNU tar (*.tar.gz, *.tar.Z, *.tar.bz2)
@@ -227,7 +227,7 @@
'((ls . ("gtar" "-ztf"))
(cat . ("gtar" "-Ozxf"))
(create . ("gtar" "-zcf"))
-;;; (rm . elmo-archive-tgz-rm-func)
+;;; (rm . elmo-archive-tgz-rm-func)
(cp . elmo-archive-tgz-cp-func)
(mv . elmo-archive-tgz-mv-func)
(ext . ("gtar" "-zxf"))
@@ -235,17 +235,17 @@
(decompress . ("gzip" "-d"))
(compress . ("gzip"))
(append . ("gtar" "-uf"))
-;;; (delete . ("gtar" "--delete" "-f")) ; well not work
+;;; (delete . ("gtar" "--delete" "-f")) ; well not work
))
(defvar elmo-archive-method-list
'(elmo-archive-lha-method-alist
elmo-archive-zip-method-alist
elmo-archive-zoo-method-alist
-;;; elmo-archive-tar-method-alist
+;;; elmo-archive-tar-method-alist
elmo-archive-tgz-method-alist
-;;; elmo-archive-arc-method-alist
-;;; elmo-archive-arj-method-alist
+;;; elmo-archive-arc-method-alist
+;;; elmo-archive-arj-method-alist
elmo-archive-rar-method-alist))
;;; Internal vars.
@@ -508,7 +508,7 @@ TYPE specifies the archiver's symbol."
nil)))
(regexp (format "^\\(.*\\)\\(%s\\)$"
(mapconcat
- '(lambda (x) (regexp-quote (cdr x)))
+ (lambda (x) (regexp-quote (cdr x)))
elmo-archive-suffix-alist
"\\|"))))
(if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'.
@@ -518,29 +518,29 @@ TYPE specifies the archiver's symbol."
(delq
nil
(mapcar
- '(lambda (x)
- (when (and (string-match regexp x)
- (eq suffix
- (car
- (rassoc (elmo-match-string 2 x)
- elmo-archive-suffix-alist))))
- (format "%s%s;%s%s"
- (elmo-folder-prefix-internal folder)
- (elmo-concat-path base-folder (elmo-match-string 1 x))
- suffix prefix)))
+ (lambda (x)
+ (when (and (string-match regexp x)
+ (eq suffix
+ (car
+ (rassoc (elmo-match-string 2 x)
+ elmo-archive-suffix-alist))))
+ (format "%s%s;%s%s"
+ (elmo-folder-prefix-internal folder)
+ (elmo-concat-path base-folder (elmo-match-string 1 x))
+ suffix prefix)))
flist)))
(elmo-mapcar-list-of-list
- (function (lambda (x)
- (if (file-exists-p
- (expand-file-name
- (concat elmo-archive-basename
- (elmo-archive-get-suffix
- (elmo-archive-folder-archive-type-internal
- folder)))
- (expand-file-name
- x
- (elmo-archive-folder-path folder))))
- (concat (elmo-folder-prefix-internal folder) x))))
+ (lambda (x)
+ (if (file-exists-p
+ (expand-file-name
+ (concat elmo-archive-basename
+ (elmo-archive-get-suffix
+ (elmo-archive-folder-archive-type-internal
+ folder)))
+ (expand-file-name
+ x
+ (elmo-archive-folder-path folder))))
+ (concat (elmo-folder-prefix-internal folder) x)))
(elmo-list-subdirectories
(elmo-archive-folder-path folder)
(or (elmo-archive-folder-dir-name-internal folder) "")
@@ -560,7 +560,7 @@ TYPE specifies the archiver's symbol."
(prefix (elmo-archive-folder-archive-prefix-internal folder))
(method (elmo-archive-get-method type 'cat))
(args (list arc (elmo-concat-path
- prefix (int-to-string number)))))
+ prefix (number-to-string number)))))
(and (file-exists-p arc)
(as-binary-process
(elmo-archive-call-method method args t))
@@ -600,7 +600,7 @@ TYPE specifies the archiver's symbol."
(elmo-make-directory (directory-file-name tmp-dir))))
(setq newfile (elmo-concat-path
prefix
- (int-to-string next-num)))
+ (number-to-string next-num)))
(elmo-bind-directory
tmp-dir
(if (and (or (functionp method) (car method))
@@ -667,7 +667,7 @@ TYPE specifies the archiver's symbol."
(setq base-dir (expand-file-name ".." temp-dir)))
(setq files
(mapcar
- '(lambda (x) (elmo-concat-path prefix x))
+ (lambda (x) (elmo-concat-path prefix x))
(directory-files temp-dir nil "^[^\\.]")))
(unless (elmo-archive-append-files folder
base-dir
@@ -703,7 +703,7 @@ TYPE specifies the archiver's symbol."
(n-method (elmo-archive-get-method type 'ext))
(tmp-msgs (mapcar (lambda (x) (elmo-concat-path
prefix
- (int-to-string x))) numbers))
+ (number-to-string x))) numbers))
number)
;; Expand files in the tmp-dir-src.
(elmo-bind-directory
@@ -730,7 +730,7 @@ TYPE specifies the archiver's symbol."
tmp-dir-src)
(expand-file-name
(if start-number
- (int-to-string number)
+ (number-to-string number)
(file-name-nondirectory tmp-file))
tmp-dir-dst))
(if start-number (incf number)))
@@ -776,9 +776,9 @@ TYPE specifies the archiver's symbol."
(arc (elmo-archive-get-archive-name folder))
(p-method (elmo-archive-get-method type 'rm-pipe))
(n-method (elmo-archive-get-method type 'rm))
- (numbers (mapcar '(lambda (x) (elmo-concat-path
- prefix
- (int-to-string x)))
+ (numbers (mapcar (lambda (x) (elmo-concat-path
+ prefix
+ (number-to-string x)))
numbers)))
(cond ((functionp n-method)
(funcall n-method (cons arc numbers)))
@@ -811,20 +811,22 @@ TYPE specifies the archiver's symbol."
(setq sum 0)
(catch 'done
(while (and rest (<= i n))
- (mapcar '(lambda (x)
- (let* ((len (length x))
- (files (member x (reverse rest))))
- ;; total(previous) + current + white space
- (if (<= max-len (+ sum len 1))
- (progn
- (unless
- (elmo-archive-call-process
- prog (append args files))
- (throw 'done nil))
- (setq sum 0) ;; reset
- (setq rest (nthcdr i rest)))
- (setq sum (+ sum len 1)))
- (setq i (1+ i)))) msgs))
+ (mapc
+ (lambda (x)
+ (let* ((len (length x))
+ (files (member x (reverse rest))))
+ ;; total(previous) + current + white space
+ (if (<= max-len (+ sum len 1))
+ (progn
+ (unless
+ (elmo-archive-call-process
+ prog (append args files))
+ (throw 'done nil))
+ (setq sum 0) ;; reset
+ (setq rest (nthcdr i rest)))
+ (setq sum (+ sum len 1)))
+ (setq i (1+ i))))
+ msgs))
(throw 'done
(or (not rest)
(elmo-archive-call-process prog (append args rest))))
@@ -919,7 +921,7 @@ TYPE specifies the archiver's symbol."
method
archive number type
&optional prefix)
- (let* ((msg (elmo-concat-path prefix (int-to-string number)))
+ (let* ((msg (elmo-concat-path prefix (number-to-string number)))
(arg-list (list archive msg)))
(when (elmo-archive-article-exists-p archive msg type)
;; insert article.
@@ -989,7 +991,8 @@ TYPE specifies the archiver's symbol."
(insert
(mapconcat
'concat
- (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs)
+ (mapcar (lambda (x) (elmo-concat-path prefix (number-to-string x)))
+ msgs)
"\n"))
(as-binary-process (apply 'call-process-region
(point-min) (point-max)
@@ -1000,7 +1003,7 @@ TYPE specifies the archiver's symbol."
(elmo-msgdb-append
new-msgdb
(elmo-archive-parse-mmdf folder msgs flag-table)))
-;;; ((looking-at delim2) ;; UNIX MAIL
+;;; ((looking-at delim2) ; UNIX MAIL
;;; (elmo-msgdb-append
;;; new-msgdb
;;; (elmo-archive-parse-unixmail msgs flag-table)))
@@ -1046,7 +1049,7 @@ TYPE specifies the archiver's symbol."
(let* ((type (elmo-archive-folder-archive-type-internal folder))
(arc (elmo-archive-get-archive-name folder))
(method (elmo-archive-get-method type 'cat))
- (args (list arc (elmo-concat-path prefix (int-to-string number)))))
+ (args (list arc (elmo-concat-path prefix (number-to-string number)))))
(elmo-set-work-buf
(when (file-exists-p arc)
(as-binary-process
@@ -1057,12 +1060,11 @@ TYPE specifies the archiver's symbol."
(luna-define-method elmo-folder-search ((folder elmo-archive-folder)
condition &optional from-msgs)
- (let* (;;(args (elmo-string-to-list key))
- ;; XXX: I don't know whether `elmo-archive-list-folder'
- ;; updates match-data.
- ;; (msgs (or from-msgs (elmo-archive-list-folder spec)))
+ (let* ((case-fold-search nil)
+;;; (args (elmo-string-to-list key))
+;;; XXX: I don't know whether `elmo-archive-list-folder' updates match-data.
+;;; (msgs (or from-msgs (elmo-archive-list-folder spec)))
(msgs (or from-msgs (elmo-folder-list-messages folder)))
- (case-fold-search nil)
ret-val)
(elmo-with-progress-display (elmo-folder-search (length msgs)) "Searching"
(dolist (number msgs)
Modified elmo/elmo-date.el
diff --git a/elmo/elmo-date.el b/elmo/elmo-date.el
index 7a4fe4c..7d986ea 100644
--- a/elmo/elmo-date.el
+++ b/elmo/elmo-date.el
@@ -72,24 +72,23 @@ Otherwise treat \\ in NEWTEXT string as special:
(substring str prev-start match)
(cond (literal newtext)
(t (mapconcat
- (function
- (lambda (c)
- (if special
- (progn
- (setq special nil)
- (cond ((eq c ?\\) "\\")
- ((eq c ?&)
- (elmo-match-string 0 str))
- ((and (>= c ?0) (<= c ?9))
- (if (> c (+ ?0 (length
- (match-data))))
- ;; Invalid match num
- (error "Invalid match num: %c" c)
- (setq c (- c ?0))
- (elmo-match-string c str)))
- (t (char-to-string c))))
- (if (eq c ?\\) (progn (setq special t) nil)
- (char-to-string c)))))
+ (lambda (c)
+ (if special
+ (progn
+ (setq special nil)
+ (cond ((eq c ?\\) "\\")
+ ((eq c ?&)
+ (elmo-match-string 0 str))
+ ((and (>= c ?0) (<= c ?9))
+ (if (> c (+ ?0 (length
+ (match-data))))
+ ;; Invalid match num
+ (error "Invalid match num: %c" c)
+ (setq c (- c ?0))
+ (elmo-match-string c str)))
+ (t (char-to-string c))))
+ (if (eq c ?\\) (progn (setq special t) nil)
+ (char-to-string c))))
newtext ""))))))
(concat rtn-str (substring str start))))
Modified elmo/elmo-dop.el
diff --git a/elmo/elmo-dop.el b/elmo/elmo-dop.el
index e124b68..734479b 100644
--- a/elmo/elmo-dop.el
+++ b/elmo/elmo-dop.el
@@ -197,7 +197,7 @@ Saved queue is old version(2.6). Clear all pending operations? ")
(setq elmo-dop-queue new-queue)))
;;; dop spool folder
-(defsubst elmo-dop-spool-folder (folder)
+(defun elmo-dop-spool-folder (folder)
"Return a spool folder for disconnected operations
which is corresponded to the FOLDER."
(elmo-make-folder
Modified elmo/elmo-file.el
diff --git a/elmo/elmo-file.el b/elmo/elmo-file.el
index da33f4e..572528a 100644
--- a/elmo/elmo-file.el
+++ b/elmo/elmo-file.el
@@ -181,7 +181,7 @@
(elmo-copy-file
(elmo-message-file-name folder number)
(expand-file-name
- (int-to-string (if start-number cur-number number))
+ (number-to-string (if start-number cur-number number))
temp-dir))
(incf cur-number))
temp-dir))
Modified elmo/elmo-flag.el
diff --git a/elmo/elmo-flag.el b/elmo/elmo-flag.el
index b7e4e71..7765a8a 100644
--- a/elmo/elmo-flag.el
+++ b/elmo/elmo-flag.el
@@ -322,7 +322,7 @@ NUMBER is the message number."
1))
(setq new-file
(expand-file-name
- (int-to-string
+ (number-to-string
(setq new-number
(elmo-flag-folder-max-number-internal flag-folder)))
(elmo-localdir-folder-directory-internal flag-folder)))
Modified elmo/elmo-imap4.el
diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el
index f9a111f..723b4ca 100644
--- a/elmo/elmo-imap4.el
+++ b/elmo/elmo-imap4.el
@@ -274,13 +274,13 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
;;; Session commands.
-; (defun elmo-imap4-send-command-wait (session command)
-; "Send COMMAND to the SESSION and wait for response.
-; Returns RESPONSE (parsed lisp object) of IMAP session."
-; (elmo-imap4-read-response session
-; (elmo-imap4-send-command
-; session
-; command)))
+;;;(defun elmo-imap4-send-command-wait (session command)
+;;; "Send COMMAND to the SESSION and wait for response.
+;;;Returns RESPONSE (parsed lisp object) of IMAP session."
+;;; (elmo-imap4-read-response session
+;;; (elmo-imap4-send-command
+;;; session
+;;; command)))
(defun elmo-imap4-send-command-wait (session command)
"Send COMMAND to the SESSION.
@@ -304,7 +304,8 @@ Returns a TAG string which is assigned to the COMMAND."
(number-to-string
(setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))))
(setq cmdstr (concat tag " "))
- ;; (erase-buffer) No need.
+;;; No need.
+;;; (erase-buffer)
(goto-char (point-min))
(when (elmo-imap4-response-bye-p elmo-imap4-current-response)
(elmo-imap4-process-bye session))
@@ -737,9 +738,9 @@ Returns response value if selecting folder succeed. "
;;;(elmo-imap4-send-command-wait
;;;(elmo-imap4-get-session spec)
;;;(list "status "
-;;; (elmo-imap4-mailbox
-;;; (elmo-imap4-spec-mailbox spec))
-;;; " (uidvalidity)")))
+;;; (elmo-imap4-mailbox
+;;; (elmo-imap4-spec-mailbox spec))
+;;; " (uidvalidity)")))
)
(defun elmo-imap4-sync-validity (spec validity-file)
@@ -896,7 +897,7 @@ If CHOP-LENGTH is not specified, message set is not chopped."
(cond ((consp x)
(format "%s:%s" (car x) (cdr x)))
((integerp x)
- (int-to-string x))))
+ (number-to-string x))))
cont-list
","))
set-list)))
@@ -911,8 +912,8 @@ If CHOP-LENGTH is not specified, message set is not chopped."
(flag-table (car app-data))
(msg-id (elmo-message-entity-field entity 'message-id))
saved-flags flag-list)
-;; (when (elmo-string-member-ignore-case "\\Flagged" flags)
-;; (elmo-msgdb-global-mark-set msg-id elmo-msgdb-important-mark))
+;;; (when (elmo-string-member-ignore-case "\\Flagged" flags)
+;;; (elmo-msgdb-global-mark-set msg-id elmo-msgdb-important-mark))
(setq saved-flags (elmo-flag-table-get flag-table msg-id)
flag-list
(if use-flag
@@ -1007,7 +1008,7 @@ If CHOP-LENGTH is not specified, message set is not chopped."
elmo-network-initialize-session-buffer :after ((session
elmo-imap4-session) buffer)
(with-current-buffer buffer
- (mapcar 'make-variable-buffer-local elmo-imap4-local-variables)
+ (mapc 'make-variable-buffer-local elmo-imap4-local-variables)
(setq elmo-imap4-seqno 0)
(setq elmo-imap4-status 'initial)))
@@ -1024,11 +1025,11 @@ If CHOP-LENGTH is not specified, message set is not chopped."
(erase-buffer)
(set-process-filter process 'elmo-imap4-arrival-filter)
(set-process-sentinel process 'elmo-imap4-sentinel)
-;;; (while (and (memq (process-status process) '(open run))
+;;; (while (and (memq (process-status process) '(open run))
;;; (eq elmo-imap4-status 'initial))
;;; (message "Waiting for server response...")
;;; (accept-process-output process 1))
-;;; (message "")
+;;; (message "")
(unless (memq elmo-imap4-status '(nonauth auth))
(signal 'elmo-open-error
(list 'elmo-network-initialize-session)))
@@ -1069,15 +1070,15 @@ If CHOP-LENGTH is not specified, message set is not chopped."
(sasl-mechanisms
(delq nil
(mapcar
- '(lambda (cap)
- (if (string-match "^auth=\\(.*\\)$"
- (symbol-name cap))
- (match-string 1 (upcase (symbol-name cap)))))
+ (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
- (mapcar '(lambda (cap) (upcase (symbol-name cap)))
+ (mapcar (lambda (cap) (upcase (symbol-name cap)))
(if (listp auth)
auth
(list auth)))))) ;)
@@ -1108,10 +1109,9 @@ If CHOP-LENGTH is not specified, message set is not chopped."
session
(intern (downcase name)))
(setq sasl-read-passphrase
- (function
- (lambda (prompt)
- (elmo-get-passwd
- (elmo-network-session-password-key session)))))
+ (lambda (prompt)
+ (elmo-get-passwd
+ (elmo-network-session-password-key session))))
(setq tag
(elmo-imap4-send-command
session
@@ -1248,8 +1248,8 @@ If CHOP-LENGTH is not specified, message set is not chopped."
(luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder))
(let ((session (elmo-imap4-get-session folder)))
- ;; commit.
- ;; (elmo-imap4-commit spec)
+;;; ;; commit.
+;;; (elmo-imap4-commit spec)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback
'elmo-imap4-server-diff-async-callback-1)
@@ -1397,7 +1397,8 @@ Return nil if no complete line has arrived."
(elmo-imap4-forward)
(while (and (not (eq (char-after (point)) ?\)))
;; next line for MS Exchange bug
- (progn (and (eq (char-after (point)) ? ) (elmo-imap4-forward)) t)
+ (progn (and (eq (char-after (point)) (string-to-char " "))
+ (elmo-imap4-forward)) t)
(setq address (elmo-imap4-parse-address)))
(setq addresses (cons address addresses)))
(when (eq (char-after (point)) ?\))
@@ -1577,7 +1578,7 @@ Return nil if no complete line has arrived."
(1-
(progn (re-search-forward "[] ]" nil t)
(point))))))
- (if (eq (char-before) ? )
+ (if (eq (char-before) (string-to-char " "))
(prog1
(mapconcat 'identity
(cons section (elmo-imap4-parse-header-list)) " ")
@@ -1720,7 +1721,7 @@ Return nil if no complete line has arrived."
(defun elmo-imap4-parse-acl ()
(let ((mailbox (elmo-imap4-parse-mailbox))
identifier rights acl)
- (while (eq (char-after (point)) ?\ )
+ (while (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(setq identifier (elmo-imap4-parse-astring))
(elmo-imap4-forward)
@@ -1775,7 +1776,7 @@ Return nil if no complete line has arrived."
(let (b-e)
(elmo-imap4-forward)
(push (elmo-imap4-parse-body-extension) b-e)
- (while (eq (char-after (point)) ?\ )
+ (while (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(push (elmo-imap4-parse-body-extension) b-e))
(assert (eq (char-after (point)) ?\)))
@@ -1786,7 +1787,7 @@ Return nil if no complete line has arrived."
(defsubst elmo-imap4-parse-body-ext ()
(let (ext)
- (when (eq (char-after (point)) ?\ );; body-fld-dsp
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-dsp
(elmo-imap4-forward)
(let (dsp)
(if (eq (char-after (point)) ?\()
@@ -1798,12 +1799,12 @@ Return nil if no complete line has arrived."
(elmo-imap4-forward))
(assert (elmo-imap4-parse-nil)))
(push (nreverse dsp) ext))
- (when (eq (char-after (point)) ?\ );; body-fld-lang
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-lang
(elmo-imap4-forward)
(if (eq (char-after (point)) ?\()
(push (elmo-imap4-parse-string-list) ext)
(push (elmo-imap4-parse-nstring) ext))
- (while (eq (char-after (point)) ?\ );; body-extension
+ (while (eq (char-after (point)) (string-to-char " "));; body-extension
(elmo-imap4-forward)
(setq ext (append (elmo-imap4-parse-body-extension) ext)))))
ext))
@@ -1819,7 +1820,7 @@ Return nil if no complete line has arrived."
(push subbody body))
(elmo-imap4-forward)
(push (elmo-imap4-parse-string) body);; media-subtype
- (when (eq (char-after (point)) ?\ );; body-ext-mpart:
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-mpart:
(elmo-imap4-forward)
(if (eq (char-after (point)) ?\();; body-fld-param
(push (elmo-imap4-parse-string-list) body)
@@ -1835,7 +1836,8 @@ Return nil if no complete line has arrived."
(push (elmo-imap4-parse-string) body);; media-subtype
(elmo-imap4-forward)
;; next line for Sun SIMS bug
- (and (eq (char-after (point)) ? ) (elmo-imap4-forward))
+ (and (eq (char-after (point)) (string-to-char " "))
+ (elmo-imap4-forward))
(if (eq (char-after (point)) ?\();; body-fld-param
(push (elmo-imap4-parse-string-list) body)
(push (and (elmo-imap4-parse-nil) nil) body))
@@ -1858,7 +1860,7 @@ Return nil if no complete line has arrived."
;; the problem is that the two first are in turn optionally followed
;; by the third. So we parse the first two here (if there are any)...
- (when (eq (char-after (point)) ?\ )
+ (when (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(let (lines)
(cond ((eq (char-after (point)) ?\();; body-type-msg:
@@ -1874,7 +1876,7 @@ Return nil if no complete line has arrived."
;; ...and then parse the third one here...
- (when (eq (char-after (point)) ?\ );; body-ext-1part:
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-1part:
(elmo-imap4-forward)
(push (elmo-imap4-parse-nstring) body);; body-fld-md5
(setq body
@@ -2074,7 +2076,7 @@ Return nil if no complete line has arrived."
(elmo-net-folder-server-internal folder))))
(unless (eq (elmo-net-folder-port-internal folder) elmo-imap4-default-port)
(setq append-serv (concat append-serv ":"
- (int-to-string
+ (number-to-string
(elmo-net-folder-port-internal folder)))))
(setq type (elmo-net-folder-stream-type-internal folder))
(unless (eq (elmo-network-stream-type-symbol type)
@@ -2267,10 +2269,10 @@ If optional argument REMOVE is non-nil, remove FLAG."
(elmo-imap4-send-command session "expunge"))
t))
-(defmacro elmo-imap4-detect-search-charset (string)
- `(with-temp-buffer
- (insert ,string)
- (detect-mime-charset-region (point-min) (point-max))))
+(defun elmo-imap4-detect-search-charset (string)
+ (with-temp-buffer
+ (insert string)
+ (detect-mime-charset-region (point-min) (point-max))))
(defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
(let ((search-key (elmo-filter-key filter))
@@ -2290,7 +2292,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
(let* ((numbers (or from-msgs (elmo-folder-list-messages folder)))
(rest (nthcdr (string-to-number (elmo-filter-value filter) )
numbers)))
- (mapcar '(lambda (x) (delete x numbers)) rest)
+ (mapc (lambda (x) (delete x numbers)) rest)
numbers))
((string= "flag" search-key)
(elmo-imap4-folder-list-flagged
@@ -2506,7 +2508,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
(defsubst elmo-imap4-folder-diff-plugged (folder)
(let ((session (elmo-imap4-get-session folder))
messages new unread response killed uidnext)
-;;; (elmo-imap4-commit spec)
+;;; (elmo-imap4-commit spec)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback nil)
(setq elmo-imap4-status-callback-data nil))
@@ -2749,12 +2751,12 @@ If optional argument REMOVE is non-nil, remove FLAG."
(elmo-imap4-get-session folder)))
elmo-enable-disconnected-operation)) ; offline refile.
-;(luna-define-method elmo-message-fetch-unplugged
-; ((folder elmo-imap4-folder)
-; number strategy &optional section outbuf unseen)
-; (error "%d%s is not cached." number (if section
-; (format "(%s)" section)
-; "")))
+;;;(luna-define-method elmo-message-fetch-unplugged
+;;; ((folder elmo-imap4-folder)
+;;; number strategy &optional section outbuf unseen)
+;;; (error "%d%s is not cached." number (if section
+;;; (format "(%s)" section)
+;;; "")))
(defsubst elmo-imap4-message-fetch (folder number strategy
section outbuf unseen)
Modified elmo/elmo-localdir.el
diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el
index 935762d..9651f8a 100644
--- a/elmo/elmo-localdir.el
+++ b/elmo/elmo-localdir.el
@@ -109,7 +109,7 @@
(luna-define-method elmo-message-file-name ((folder
elmo-localdir-folder)
number)
- (expand-file-name (int-to-string number)
+ (expand-file-name (number-to-string number)
(elmo-localdir-folder-directory-internal folder)))
(luna-define-method elmo-folder-message-file-number-p ((folder
@@ -134,10 +134,10 @@
(dolist (number numbers)
(elmo-copy-file
(expand-file-name
- (int-to-string number)
+ (number-to-string number)
(elmo-localdir-folder-directory-internal folder))
(expand-file-name
- (int-to-string (if start-number cur-number number))
+ (number-to-string (if start-number cur-number number))
temp-dir))
(incf cur-number))
temp-dir))
@@ -145,7 +145,7 @@
(defun elmo-localdir-msgdb-create-entity (msgdb dir number)
(elmo-msgdb-create-message-entity-from-file
(elmo-msgdb-message-entity-handler msgdb)
- number (expand-file-name (int-to-string number) dir)))
+ number (expand-file-name (number-to-string number) dir)))
(luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
numbers
@@ -219,7 +219,7 @@
(elmo-copy-file
(elmo-message-file-name src-folder (car numbers))
(expand-file-name
- (int-to-string
+ (number-to-string
(if same-number (car numbers) next-num))
dir))
;; save flag-table only when src folder's msgdb is loaded.
@@ -332,8 +332,8 @@
(elmo-bind-directory
dir
;; xxx nfs,hardlink
- (rename-file (int-to-string old-number)
- (int-to-string new-number) t))
+ (rename-file (number-to-string old-number)
+ (number-to-string new-number) t))
(elmo-message-entity-set-number entity new-number))
(elmo-msgdb-append-entity new-msgdb entity
(elmo-msgdb-flags msgdb old-number))
Modified elmo/elmo-maildir.el
diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el
index c236770..2c29937 100644
--- a/elmo/elmo-maildir.el
+++ b/elmo/elmo-maildir.el
@@ -256,19 +256,19 @@ LOCATION."
(let ((cur-time (current-time))
(count 0)
last-accessed)
- (mapcar (function
- (lambda (file)
- (setq last-accessed (nth 4 (file-attributes file)))
- (when (or (> (- (car cur-time)(car last-accessed)) 1)
- (and (eq (- (car cur-time)(car last-accessed)) 1)
- (> (- (cadr cur-time)(cadr last-accessed))
- 64064))) ; 36 hours.
- (message "Maildir: %d tmp file(s) are cleared."
- (setq count (1+ count)))
- (delete-file file))))
- (directory-files (expand-file-name "tmp" dir)
- t ; full
- "^[^.].*$" t))))
+ (mapcar
+ (lambda (file)
+ (setq last-accessed (nth 4 (file-attributes file)))
+ (when (or (> (- (car cur-time)(car last-accessed)) 1)
+ (and (eq (- (car cur-time)(car last-accessed)) 1)
+ (> (- (cadr cur-time)(cadr last-accessed))
+ 64064))) ; 36 hours.
+ (message "Maildir: %d tmp file(s) are cleared."
+ (setq count (1+ count)))
+ (delete-file file)))
+ (directory-files (expand-file-name "tmp" dir)
+ t ; full
+ "^[^.].*$" t))))
(defun elmo-maildir-update-current (folder)
"Move all new msgs to cur in the maildir."
@@ -405,7 +405,7 @@ file name for maildir directories."
(make-directory (file-name-directory filename)))
(while (file-exists-p filename)
;;; I don't want to wait.
-;;; (sleep-for 2)
+;;; (sleep-for 2)
(setq filename
(expand-file-name
(concat "tmp/" (elmo-maildir-make-unique-string))
@@ -477,7 +477,7 @@ file name for maildir directories."
(elmo-copy-file
(elmo-message-file-name folder number)
(expand-file-name
- (int-to-string (if start-number cur-number number))
+ (number-to-string (if start-number cur-number number))
temp-dir))
(incf cur-number))
temp-dir))
Modified elmo/elmo-map.el
diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el
index 7bd64c7..0ba69ff 100644
--- a/elmo/elmo-map.el
+++ b/elmo/elmo-map.el
@@ -58,7 +58,7 @@
(defmacro elmo-location-map-key (number)
- `(concat "#" (int-to-string ,number)))
+ `(concat "#" (number-to-string ,number)))
(defun elmo-location-map-load (location-map directory)
(elmo-location-map-setup
Modified elmo/elmo-mime.el
diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el
index b3eec05..499dcd6 100644
--- a/elmo/elmo-mime.el
+++ b/elmo/elmo-mime.el
@@ -144,8 +144,7 @@ value is used."
(t
elmo-mime-header-max-column)))
vf-alist)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(save-restriction
(narrow-to-region start end)
(goto-char start)
@@ -176,8 +175,9 @@ value is used."
(throw 'done t))
(when (string-match re df)
(throw 'done nil)))
- t))))))
- (set-buffer the-buf)
+ t)))))))
+ (set-buffer the-buf) ; verbose. remove me.
+ (save-excursion
(while vf-alist
(let* ((vf (car vf-alist))
(field-name (nth 0 vf))
Modified elmo/elmo-msgdb.el
diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el
index 774ec47..0a10cdf 100644
--- a/elmo/elmo-msgdb.el
+++ b/elmo/elmo-msgdb.el
@@ -173,7 +173,7 @@ VALUE is the field value."
;;;
(defsubst elmo-msgdb-append-element (list element)
(if list
-;;; (append list (list element))
+;;; (append list (list element))
(nconc list (list element))
;; list is nil
(list element)))
Modified elmo/elmo-multi.el
diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el
index c95d4ab..2e52de3 100644
--- a/elmo/elmo-multi.el
+++ b/elmo/elmo-multi.el
@@ -353,11 +353,10 @@
(nconc
numbers
(mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal
- folder) cur-number) x)))
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number) x))
list)))
(setq flds (cdr flds)))
numbers))
@@ -405,13 +404,12 @@
(setq cur-number (+ cur-number 1))
(setq matches (append matches
(mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal
- folder)
- cur-number)
- x)))
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal
+ folder)
+ cur-number)
+ x))
(elmo-folder-search
(car flds) condition))))
(setq flds (cdr flds)))
@@ -497,11 +495,10 @@
(nconc
numbers
(mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal folder)
- cur-number) x)))
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal folder)
+ cur-number) x))
(elmo-folder-list-flagged child flag in-msgdb)))))
numbers))
Modified elmo/elmo-net.el
diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el
index 7abbd79..0c1e537 100644
--- a/elmo/elmo-net.el
+++ b/elmo/elmo-net.el
@@ -113,7 +113,7 @@ If nil, just once. If t, until success."
(luna-define-method elmo-network-close-session ((session elmo-network-session))
(when (elmo-network-session-process-internal session)
-;;; (memq (process-status (elmo-network-session-process-internal session))
+;;; (memq (process-status (elmo-network-session-process-internal session))
;;; '(open run))
(kill-buffer (process-buffer
(elmo-network-session-process-internal session)))
Modified elmo/elmo-nntp.el
diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el
index f297f95..9e57d86 100644
--- a/elmo/elmo-nntp.el
+++ b/elmo/elmo-nntp.el
@@ -257,7 +257,7 @@ Don't cache if nil.")
(if (and port
(null (eq port elmo-nntp-default-port)))
(concat ":" (if (numberp port)
- (int-to-string port) port)))
+ (number-to-string port) port)))
(unless (eq (elmo-network-stream-type-symbol type)
elmo-nntp-default-stream-type)
(elmo-network-stream-type-spec-string type))))
@@ -454,8 +454,7 @@ Don't cache if nil.")
(let* ((cache-time (car elmo-nntp-list-folders-cache)))
(unless (elmo-time-expire cache-time
elmo-nntp-list-folders-use-cache)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(erase-buffer)
(insert (nth 3 elmo-nntp-list-folders-cache))
(goto-char (point-min))
@@ -586,7 +585,7 @@ Don't cache if nil.")
"@" (elmo-net-folder-server-internal folder))))
(unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
(setq append-serv (concat append-serv
- ":" (int-to-string
+ ":" (number-to-string
(elmo-net-folder-port-internal folder)))))
(unless (eq (elmo-network-stream-type-symbol
(elmo-net-folder-stream-type-internal folder))
@@ -717,11 +716,11 @@ Don't cache if nil.")
(while ov-list
(setq ov-entity (car ov-list))
;;; INN bug??
-;;; (if (or (> (setq num (string-to-int (aref ov-entity 0)))
+;;; (if (or (> (setq num (string-to-number (aref ov-entity 0)))
;;; 99999)
;;; (<= num 0))
;;; (setq num 0))
-;;; (setq num (int-to-string num))
+;;; (setq num (number-to-string num))
(setq num (string-to-number (aref ov-entity 0)))
(when (or (null numlist)
(memq num numlist))
@@ -782,8 +781,8 @@ Don't cache if nil.")
session
(format
"xover %s-%s"
- (int-to-string cur)
- (int-to-string
+ (number-to-string cur)
+ (number-to-string
(+ cur
elmo-nntp-overview-fetch-chop-length))))
(with-current-buffer (elmo-network-session-buffer session)
@@ -913,7 +912,7 @@ Don't cache if nil.")
(forward-line 1)
(setq beg (point))
(setq ret-val (nconc ret-val (list ret-list))))
-;;; (kill-buffer tmp-buffer)
+;;; (kill-buffer tmp-buffer)
ret-val)))
(defun elmo-nntp-get-newsgroup-by-msgid (msgid server user port type)
@@ -981,8 +980,7 @@ Don't cache if nil.")
(elmo-get-network-stream-type
elmo-nntp-default-stream-type))))
response has-message-id)
- (save-excursion
- (set-buffer content-buf)
+ (with-current-buffer content-buf
(goto-char (point-min))
(if (search-forward mail-header-separator nil t)
(delete-region (match-beginning 0)(match-end 0)))
@@ -1000,7 +998,7 @@ Don't cache if nil.")
(run-hooks 'elmo-nntp-post-pre-hook)
(elmo-nntp-send-buffer session content-buf)
(elmo-nntp-send-command session ".")
-;;; (elmo-nntp-read-response buffer process t)
+;;; (elmo-nntp-read-response buffer process t)
(if (not (string-match
"^2" (setq response (elmo-nntp-read-raw-response
session))))
@@ -1082,7 +1080,7 @@ Returns a list of cons cells like (NUMBER . VALUE)"
(let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
(rest (nthcdr (string-to-number (elmo-filter-value condition) )
numbers)))
- (mapcar '(lambda (x) (delete x numbers)) rest)
+ (mapc (lambda (x) (delete x numbers)) rest)
numbers))
((or (string= "since" search-key)
(string= "before" search-key))
Modified elmo/elmo-pop3.el
diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el
index 321af6b..ac755f3 100644
--- a/elmo/elmo-pop3.el
+++ b/elmo/elmo-pop3.el
@@ -639,8 +639,7 @@ until the login delay period has expired"))
nil)))
(defun elmo-pop3-retrieve-headers (process tobuffer articles)
- (save-excursion
- (set-buffer (process-buffer process))
+ (with-current-buffer (process-buffer process)
(erase-buffer)
(let ((count 0)
(received 0)
@@ -652,7 +651,7 @@ until the login delay period has expired"))
(elmo-pop3-send-command process
(format "top %s 0" (car articles))
'no-erase)
- ;;; (accept-process-output process 1)
+;;; (accept-process-output process 1)
(setq articles (cdr articles))
(setq count (1+ count))
;; Every 200 requests we have to read the stream in
@@ -672,7 +671,7 @@ until the login delay period has expired"))
(< received count))
(elmo-progress-notify 'elmo-retrieve-header :set received)
(accept-process-output process 1)
- ;;; (accept-process-output process)
+;;; (accept-process-output process)
(discard-input)))))
;; Replace all CRLF with LF.
(elmo-delete-cr-buffer)
Modified elmo/elmo-util.el
diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el
index b796432..fb0e236 100644
--- a/elmo/elmo-util.el
+++ b/elmo/elmo-util.el
@@ -71,8 +71,7 @@
(defmacro elmo-set-work-buf (&rest body)
"Execute BODY on work buffer. Work buffer remains."
- `(save-excursion
- (set-buffer (get-buffer-create elmo-work-buf-name))
+ `(with-current-buffer (get-buffer-create elmo-work-buf-name)
(set-buffer-multibyte default-enable-multibyte-characters)
(erase-buffer)
,@body))
@@ -171,7 +170,7 @@ with FILENAME which defaults to `buffer-file-name'."
(goto-char (point-min))
(setq case-fold-search nil)
(re-search-forward "^;;;coding system: "
- ;;(+ (point-min) 3000) t))
+;;; (+ (point-min) 3000) t))
nil t))
(looking-at "[^\t\n\r ]+")
(find-coding-system
@@ -489,6 +488,10 @@ Return value is a cons cell of (STRUCTURE . REST)"
"Make a union of two lists"
(elmo-uniq-sorted-list (sort (append l1 l2) #'<)))
+(defun elmo-union (l1 l2)
+ "Make a union of two lists"
+ (elmo-uniq-sorted-list (sort (append l1 l2) #'<)))
+
(defun elmo-list-insert (list element after)
(let* ((match (memq after list))
(rest (and match (cdr (memq after list)))))
@@ -572,7 +575,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
print-length print-level)
(prin1 elmo-passwd-alist (current-buffer))
(princ "\n" (current-buffer))
-;;; (if (and (file-exists-p filename)
+;;; (if (and (file-exists-p filename)
;;; (not (equal 384 (file-modes filename))))
;;; (error "%s is not safe.chmod 600 %s!" filename filename))
(if (file-writable-p filename)
@@ -826,7 +829,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
(directory-files path t "^[^\\.]")
(error nil)))
(result 0.0))
- ;; (result (nth 7 file-attr))) ... directory size
+;;; (result (nth 7 file-attr))) ; ... directory size
(while files
(setq result (+ result (or (elmo-disk-usage (car files)) 0)))
(setq files (cdr files)))
@@ -1714,12 +1717,12 @@ NUMBER-SET is altered."
prev
(nconc
(list
- ;; (beg . (1- number))
+;;; (beg . (1- number))
(let ((new (cons (car elem) (1- number))))
(if (eq (car new) (cdr new))
(car new)
new))
- ;; ((1+ number) . end)
+;;; ((1+ number) . end)
(let ((new (cons (1+ number) (cdr elem))))
(if (eq (car new) (cdr new))
(car new)
@@ -2074,7 +2077,7 @@ If KBYTES is kilo bytes (This value must be float)."
(cons (car (car cfl))
(car flist)))))
(setq cfl (cdr cfl)))
-;;; (prin1 firsts)
+;;; (prin1 firsts)
(while firsts
(if (and (not oldest-entity)
(cdr (cdr (car firsts))))
@@ -2112,12 +2115,12 @@ If KBYTES is kilo bytes (This value must be float)."
"Expire cache file by age.
Optional argument DAYS specifies the days to expire caches."
(interactive)
- (let ((age (or (and days (int-to-string days))
+ (let ((age (or (and days (number-to-string days))
(and (interactive-p)
(read-from-minibuffer
(format "Enter days (%s): "
elmo-cache-expire-default-age)))
- (int-to-string elmo-cache-expire-default-age)))
+ (number-to-string elmo-cache-expire-default-age)))
(dirs (directory-files
elmo-cache-directory
t "^[^\\.]"))
Modified elmo/elmo-version.el
diff --git a/elmo/elmo-version.el b/elmo/elmo-version.el
index 4a2a840..61db262 100644
--- a/elmo/elmo-version.el
+++ b/elmo/elmo-version.el
@@ -41,7 +41,7 @@
(product-provide 'elmo-version
;; Don't forget to run `make update-version' and `make test'.
;; Don't forget to check codename in `wl-version.el'.
- (product-define "ELMO" nil '(2 15 6)))
+ (product-define "ELMO" nil '(2 15 8)))
;; set version-string
(product-version-as-string 'elmo-version)
Modified elmo/elmo.el
diff --git a/elmo/elmo.el b/elmo/elmo.el
index ed890eb..15c935e 100644
--- a/elmo/elmo.el
+++ b/elmo/elmo.el
@@ -860,7 +860,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).")
(when (and filename (file-readable-p filename))
(with-temp-buffer
(set-buffer-multibyte nil)
- ;;(insert-file-contents-as-binary filename)
+;;; (insert-file-contents-as-binary filename)
(elmo-message-fetch folder number
(elmo-make-fetch-strategy 'entire
(and cache t)
@@ -954,7 +954,8 @@ If optional argument IF-EXISTS is nil, load on demand.
(elmo-folder-set-info-hashtb
folder
(if numbers (apply #'max numbers) 0)
- nil ;;(length num-db)
+;;; (length num-db)
+ nil
))
(defun elmo-folder-get-info-max (folder)
@@ -973,7 +974,7 @@ If optional argument IF-EXISTS is nil, load on demand.
"Setup folder info hashtable by INFO-ALIST on HASHTB."
(let* ((hashtb (or hashtb
(elmo-make-hash (length info-alist)))))
- (mapcar
+ (mapc
(lambda (x)
(let ((info (cadr x)))
(and (intern-soft (car x) hashtb)
@@ -1209,7 +1210,7 @@ Returns a list of message numbers successfully appended."
result)
(if no-delete
(progn
- ;; (message "Copying messages...done")
+;;; (message "Copying messages...done")
t)
(if (eq len 0)
(message "No message was moved.")
@@ -1450,10 +1451,10 @@ If Optional LOCAL is non-nil, don't update server flag."
;; Do nothing.
)
-;;(luna-define-generic elmo-folder-append-message-entity (folder entity
-;; &optional
-;; flag-table)
-;; "Append ENTITY to the folder.")
+;;;(luna-define-generic elmo-folder-append-message-entity (folder entity
+;;; &optional
+;;; flag-table)
+;;; "Append ENTITY to the folder.")
(defun elmo-msgdb-merge (folder msgdb-merge)
"Return a list of messages which have duplicated message-id."
@@ -1497,7 +1498,7 @@ If Optional LOCAL is non-nil, don't update server flag."
(catch 'end
(while t
(setq in (read-from-minibuffer "Update number: "
- (int-to-string in))
+ (number-to-string in))
in (string-to-number in))
(if (< len in)
(throw 'end len))
@@ -1775,8 +1776,8 @@ Return a hashtable for newsgroups."
(while alist
(setq newsgroups
(elmo-delete-if
- '(lambda (x)
- (not (intern-soft x elmo-newsgroups-hashtb)))
+ (lambda (x)
+ (not (intern-soft x elmo-newsgroups-hashtb)))
(nth 1 (car alist))))
(if newsgroups
(setcar (cdar alist) newsgroups)
Modified elmo/modb-standard.el
diff --git a/elmo/modb-standard.el b/elmo/modb-standard.el
index f268c3a..8e56af4 100644
--- a/elmo/modb-standard.el
+++ b/elmo/modb-standard.el
@@ -264,6 +264,23 @@
(expand-file-name
(modb-standard-entity-filename entity) path))))))
+(defun modb-standard-cleanup-stale-entities (modb path)
+ (message "Removing stale entities...")
+ (let* ((entity-regex
+ (concat "^" modb-standard-entity-filename "-\\([0-9]+\\)"))
+ (entities (elmo-uniq-list
+ (mapcar
+ (lambda (x) (/ x modb-standard-divide-number))
+ (modb-standard-number-list-internal modb))))
+ (files (mapcar (lambda(x)
+ (when (string-match entity-regex x)
+ (string-to-number (match-string 1 x))))
+ (directory-files path nil entity-regex))))
+ (dolist (entity (car (elmo-list-diff-nonsortable files entities)))
+ (ignore-errors (delete-file
+ (expand-file-name
+ (modb-standard-entity-filename entity) path))))))
+
(defun modb-standard-save-entity (modb path)
(let ((modified (modb-generic-message-modified-internal modb)))
(cond ((listp modified)
Modified elmo/pldap.el
diff --git a/elmo/pldap.el b/elmo/pldap.el
index b6ae29a..bc8fc2e 100644
--- a/elmo/pldap.el
+++ b/elmo/pldap.el
@@ -78,10 +78,10 @@
(concat "\n" ldap-ldif-field-name-regexp ":")
"A Regexp for next field head.")
-(defmacro ldap/ldif-safe-string-p (string)
+(defun ldap/ldif-safe-string-p (string)
"Return t if STRING is a safe-string for LDIF."
;; Need better implentation.
- `(string-match ldap-ldif-safe-string-regexp ,string))
+ (string-match ldap-ldif-safe-string-regexp string))
(defgroup ldap nil
"Lightweight Directory Access Protocol"
@@ -930,10 +930,10 @@ entry according to the value of WITHDN."
(set-buffer-multibyte nil)
(if ldap-ignore-attribute-codings
result
- (mapcar (function
- (lambda (record)
- (mapcar 'ldap-decode-attribute record)))
- result)))))
+ (mapcar
+ (lambda (record)
+ (mapcar 'ldap-decode-attribute record))
+ result)))))
(defun ldap-add-entries (entries &optional host binddn passwd)
"Add entries to an LDAP directory.
@@ -961,22 +961,22 @@ PASSWD is the corresponding password"
(setq ldap (ldap-open host host-plist))
(if ldap-verbose
(message "Adding LDAP entries..."))
- (mapcar (lambda (thisentry)
- (setcdr thisentry
- (mapcar
- (lambda (add-spec)
- (setq add-spec (ldap-encode-attribute
- (list (car add-spec)
- (cdr add-spec))))
- (cons (nth 0 add-spec)
- (nth 1 add-spec)))
- (cdr thisentry)))
- (setq thisentry (ldap-encode-attribute thisentry))
- (ldap-add ldap (car thisentry) (cdr thisentry))
- (if ldap-verbose
- (message "%d added" i))
- (setq i (1+ i)))
- entries)
+ (mapc (lambda (thisentry)
+ (setcdr thisentry
+ (mapcar
+ (lambda (add-spec)
+ (setq add-spec (ldap-encode-attribute
+ (list (car add-spec)
+ (cdr add-spec))))
+ (cons (nth 0 add-spec)
+ (nth 1 add-spec)))
+ (cdr thisentry)))
+ (setq thisentry (ldap-encode-attribute thisentry))
+ (ldap-add ldap (car thisentry) (cdr thisentry))
+ (if ldap-verbose
+ (message "%d added" i))
+ (setq i (1+ i)))
+ entries)
(ldap-close ldap)))
(defun ldap-modify-entries (entry-mods &optional host binddn passwd)
@@ -1009,21 +1009,22 @@ PASSWD is the corresponding password"
(setq ldap (ldap-open host host-plist))
(if ldap-verbose
(message "Modifying LDAP entries..."))
- (mapcar (lambda (thisentry)
- (setcdr thisentry
- (mapcar
- (lambda (mod-spec)
- (if (or (eq (car mod-spec) 'add)
- (eq (car mod-spec) 'replace))
- (append (list (nth 0 mod-spec))
- (ldap-encode-attribute
- (cdr mod-spec)))))
- (cdr thisentry)))
- (ldap-modify ldap (car thisentry) (cdr thisentry))
- (if ldap-verbose
- (message "%d modified" i))
- (setq i (1+ i)))
- entry-mods)
+ (mapc
+ (lambda (thisentry)
+ (setcdr thisentry
+ (mapcar
+ (lambda (mod-spec)
+ (if (or (eq (car mod-spec) 'add)
+ (eq (car mod-spec) 'replace))
+ (append (list (nth 0 mod-spec))
+ (ldap-encode-attribute
+ (cdr mod-spec)))))
+ (cdr thisentry)))
+ (ldap-modify ldap (car thisentry) (cdr thisentry))
+ (if ldap-verbose
+ (message "%d modified" i))
+ (setq i (1+ i)))
+ entry-mods)
(ldap-close ldap)))
(defun ldap-delete-entries (dn &optional host binddn passwd)
@@ -1051,13 +1052,13 @@ PASSWD is the corresponding password."
(let ((i 1))
(if ldap-verbose
(message "Deleting LDAP entries..."))
- (mapcar (function
- (lambda (thisdn)
- (ldap-delete ldap thisdn)
- (if ldap-verbose
- (message "%d deleted" i))
- (setq i (1+ i))))
- dn))
+ (mapc
+ (lambda (thisdn)
+ (ldap-delete ldap thisdn)
+ (if ldap-verbose
+ (message "%d deleted" i))
+ (setq i (1+ i)))
+ dn))
(if ldap-verbose
(message "Deleting LDAP entry..."))
(ldap-delete ldap dn))
Modified elmo/utf7.el
diff --git a/elmo/utf7.el b/elmo/utf7.el
index c6081e8..30fdb74 100644
--- a/elmo/utf7.el
+++ b/elmo/utf7.el
@@ -91,8 +91,23 @@
(concat utf7-direct-encoding-chars "+\\~")
"Character ranges which do not need escaping in the IMAP variant of UTF-7.")
-(defconst utf7-utf-16-coding-system (and (fboundp 'find-coding-system)
- (find-coding-system 'utf-16-be))
+
+(eval-and-compile
+ (defun utf7-find-coding-system-without-bom (cs)
+ (and (fboundp 'find-coding-system)
+ (find-coding-system cs)
+ ;; Avoid versions with BOM.
+ (= 2 (length (encode-coding-string "a" cs)))
+ cs)))
+
+(defconst utf7-utf-16-coding-system
+ (or
+ ;; Emacs 22, Emacs 23
+ (utf7-find-coding-system-without-bom 'utf-16be)
+ ;;
+ (utf7-find-coding-system-without-bom 'utf-16-be)
+ ;; Mule-UCS
+ (utf7-find-coding-system-without-bom 'utf-16-be-no-signature))
"Coding system which encodes big endian UTF-16.")
(defsubst utf7-imap-get-pad-length (len modulus)
@@ -196,13 +211,11 @@ Use IMAP modification if FOR-IMAP is non-nil."
utf7-utf-16-coding-system)
(set-buffer-multibyte nil)
(goto-char (point-min))
- ;; Remove BOM (Big-endian UTF-16 FE FF)
+ ;; Remove BOM (Big-endian UTF-16 FE FF) for Mule-UCS
(while (re-search-forward "\376\377" nil t)
- (delete-region (match-beginning 0)(match-end 0))))
+ (delete-region (match-beginning 0) (match-end 0))))
(lambda ()
(goto-char (point-min))
- ;; Add BOM (Big-endian UTF-16 FE FF)
- (insert "\376\377")
(decode-coding-region (point-min) (point-max)
utf7-utf-16-coding-system)))))
New test-elmo-imap4.el
diff --git a/test-elmo-imap4.el b/test-elmo-imap4.el
new file mode 100644
index 0000000..bbb824e
--- /dev/null
+++ b/test-elmo-imap4.el
@@ -0,0 +1,33 @@
+(require 'lunit)
+(require 'elmo-imap4)
+
+(luna-define-class test-elmo-imap4 (lunit-test-case))
+
+(luna-define-method test-elmo-imap4-parse-greeting-ok ((case test-elmo-imap4))
+ (with-temp-buffer
+ (setq case-fold-search nil)
+ (let (elmo-imap4-status)
+ (insert-string "* OK [CAPABILITY IMAP4 IMAP4rev1 LITERAL+ ID"
+ " LOGINDISABLED AUTH=DIGEST-MD5 AUTH=CRAM-MD5 SASL-IR]"
+ " mail.example.org Cyrus IMAP v2.3.13 server ready\n")
+ (goto-char (point-min))
+ (lunit-assert
+ (eq 'nonauth (elmo-imap4-parse-greeting))))))
+
+(luna-define-method test-elmo-imap4-parse-greeting-preauth ((case test-elmo-imap4))
+ (with-temp-buffer
+ (setq case-fold-search nil)
+ (let (elmo-imap4-status)
+ (insert-string "* PREAUTH IMAP4rev1 server logged in as Smith\n")
+ (goto-char (point-min))
+ (lunit-assert
+ (eq 'auth (elmo-imap4-parse-greeting))))))
+
+(luna-define-method test-elmo-imap4-parse-greeting-bye ((case test-elmo-imap4))
+ (with-temp-buffer
+ (setq case-fold-search nil)
+ (let (elmo-imap4-status)
+ (insert-string "* BYE LOGOUT received\n")
+ (goto-char (point-min))
+ (lunit-assert
+ (eq 'closed (elmo-imap4-parse-greeting))))))
Modified tests/ChangeLog
diff --git a/tests/ChangeLog b/tests/ChangeLog
index 3113f69..147275c 100644
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
@@ -1,3 +1,31 @@
+2010-01-01 TAKAHASHI Kaoru <[email protected]>
+
+ * test-elmo-util.el (test-elmo-delete-cr-1): New testcase.
+ * test-elmo-date.el (test-elmo-time-parse-date-string-1)
+ (test-elmo-time-parse-date-string-2): New testcase.
+
+2009-08-01 TAKAHASHI Kaoru <[email protected]>
+
+ * test-elmo-imap4.el: New file.
+ (test-elmo-imap4-parse-greeting-ok): New testcase.
+ (test-elmo-imap4-parse-greeting-preauth): Ditto.
+ (test-elmo-imap4-parse-greeting-bye): Ditto.
+
+ * test-utf7.el (toplevel): Use `fboundp' instead of `boundp'.
+ Fix (require 'utf7) order for Mule-UCS.
+ (test-utf7-decode-string-plus): New testcase.
+ (test-utf7-decode-string-noconv): Ditto.
+ (test-utf7-encode-string-plus): Ditto.
+ (test-utf7-encode-string-noconv): Ditto.
+ (test-utf7-decode-string-nihongo): Rename from
+ `test-utf7-decode-string'. Use `make-char'.
+ (test-utf7-encode-string-nihongo): Rename from
+ `test-utf7-encode-string'. Use `make-char'.
+ (test-utf7-decode-string-alpha): New testcase.
+ (test-utf7-encode-string-alpha): Ditto.
+ (test-utf7-decode-string-smiling-face): Ditto.
+ (test-utf7-encode-string-smiling-face): Ditto.
+
2008-02-19 TAKAHASHI Kaoru <[email protected]>
* test-wl-util.el (test-wl-unique-id-by-user): New testcase.
Modified tests/test-elmo-date.el
diff --git a/tests/test-elmo-date.el b/tests/test-elmo-date.el
index 635a774..2f1562c 100644
--- a/tests/test-elmo-date.el
+++ b/tests/test-elmo-date.el
@@ -16,3 +16,52 @@
(string= "Sun" (elmo-date-get-week 2100 2 28)))
(lunit-assert
(string= "Mon" (elmo-date-get-week 2100 3 1)))))
+
+(luna-define-method test-elmo-time-parse-date-string-1 ((case test-elmo-date))
+ ""
+ (lunit-assert
+ ;; [RFC5322] Appendix A.1.1.
+ (equal '(13429 44762)
+ (elmo-time-parse-date-string
+ "Date: Fri, 21 Nov 1997 09:55:06 -0600")))
+ (lunit-assert
+ ;; [RFC5322] Appendix A.1.2.
+ (equal '(16129 19413)
+ (elmo-time-parse-date-string
+ "Date: Tue, 1 Jul 2003 10:52:37 +0200")))
+ ;; (lunit-assert
+ ;; ;; leapsec
+ ;; (elmo-time-parse-date-string
+ ;; "Date: Thu, 1 Jan 2009 08:59:60 +0900"))
+
+
+ (lunit-assert
+ ;; [RFC5322] Appendix A.1.3.
+ (equal '(-424 63838)
+ (elmo-time-parse-date-string
+ "Date: Thu, 13 Feb 1969 23:32:54 -0330")))
+)
+
+(luna-define-method test-elmo-time-parse-date-string-2 ((case test-elmo-date))
+ "Obsolete Date: format"
+ (lunit-assert
+ ;; [RFC5322] Appendix A.5.
+ (equal '(14403 4992)
+ (elmo-time-parse-date-string
+ (concat
+ "Date: Thu,\n"
+ " 13\n"
+ " Feb\n"
+ " 1969\n"
+ " 23:32\n"
+ " -0330 (Newfoundland Time)"))))
+ (lunit-assert
+ ;; [RFC5322] Appendix A.6.2.
+ (equal '(13429 23162)
+ (elmo-time-parse-date-string
+ "Date: 21 Nov 97 09:55:06 GMT")))
+ (lunit-assert
+ ;; [RFC5322] Appendix A.6.3.
+ (equal '(13428 52452)
+ (elmo-time-parse-date-string
+ "Date : Fri, 21 Nov 1997 09(comment): 55 : 06 -0600"))))
Modified tests/test-elmo-util.el
diff --git a/tests/test-elmo-util.el b/tests/test-elmo-util.el
index 2d5a5e1..01e178f 100644
--- a/tests/test-elmo-util.el
+++ b/tests/test-elmo-util.el
@@ -324,3 +324,9 @@
(lunit-assert
(equal '(1)
(elmo-number-set-to-number-list '(1)))))
+
+(luna-define-method test-elmo-delete-cr-1 ((case test-elmo-util))
+ (lunit-assert (string= "" (elmo-delete-cr "")))
+ (lunit-assert (string= "\n" (elmo-delete-cr "\r\n")))
+ (lunit-assert (string= "\n\n" (elmo-delete-cr "\r\n\n")))
+ (lunit-assert (string= "\n\n" (elmo-delete-cr "\r\n\r\n"))))
Modified tests/test-utf7.el
diff --git a/tests/test-utf7.el b/tests/test-utf7.el
index 1cab656..6d93943 100644
--- a/tests/test-utf7.el
+++ b/tests/test-utf7.el
@@ -1,22 +1,108 @@
(require 'lunit)
-(require 'utf7)
-;; Emacs 21.3.50 or later
-(if (boundp 'utf-translate-cjk-mode)
- (utf-translate-cjk-mode 1)
- ;; Use Mule-UCS if installed
+;; Emacs 21
+(unless (and (fboundp 'find-coding-system) (find-coding-system 'utf-16))
(ignore-errors (require 'un-define)))
+(require 'utf7)
+
+;; Emacs 21.3.50 to 22
+(when (fboundp 'utf-translate-cjk-mode)
+ (utf-translate-cjk-mode 1))
(luna-define-class test-utf7 (lunit-test-case))
-(luna-define-method test-utf7-encode-string ((case test-utf7))
+(luna-define-method test-utf7-encode-string-nihongo ((case test-utf7))
(lunit-assert
(string=
"+ZeVnLIqe-"
- (utf7-encode-string "日本語")))) ; FIXME!!: don't care coding system
+ (utf7-encode-string
+ (string (make-char 'japanese-jisx0208 70 124)
+ (make-char 'japanese-jisx0208 75 92)
+ (make-char 'japanese-jisx0208 56 108))))))
+
+(luna-define-method test-utf7-encode-string-smiling-face ((case test-utf7))
+ (lunit-assert
+ (string=
+ "Hi Mom -+Jjo--!"
+ (utf7-encode-string
+ (concat "Hi Mom -"
+ (string (make-char 'mule-unicode-2500-33ff 35 58))
+ "-!")))))
+
+(luna-define-method test-utf7-encode-string-alpha ((case test-utf7))
+ (lunit-assert
+ (string=
+ "A+ImIDkQ-."
+ (utf7-encode-string
+ (concat "A"
+ (string (make-char 'mule-unicode-0100-24ff 121 34)
+ (make-char 'mule-unicode-0100-24ff 38 113))
+ ".")))))
-(luna-define-method test-utf7-decode-string ((case test-utf7))
+(luna-define-method test-utf7-encode-string-plus ((case test-utf7))
+ (lunit-assert
+ (string= "+-" (utf7-encode-string "+"))))
+
+(luna-define-method test-utf7-encode-string-noconv ((case test-utf7))
+ (lunit-assert
+ (string= "" (utf7-encode-string "")))
+ (lunit-assert
+ (string= "a" (utf7-encode-string "a")))
+ (lunit-assert
+ (string= "-" (utf7-encode-string "-")))
+ (lunit-assert
+ (string= "=" (utf7-encode-string "="))))
+
+
+(luna-define-method test-utf7-decode-string-nihongo ((case test-utf7))
(lunit-assert
(string=
- "日本語" ; FIXME!!: don't care coding system
+ (string (make-char 'japanese-jisx0208 70 124)
+ (make-char 'japanese-jisx0208 75 92)
+ (make-char 'japanese-jisx0208 56 108))
(utf7-decode-string "+ZeVnLIqe-"))))
+
+(luna-define-method test-utf7-decode-string-smiling-face ((case test-utf7))
+ (lunit-assert
+ (string=
+ (concat "Hi Mom -"
+ (string (make-char 'mule-unicode-2500-33ff 35 58))
+ "-!")
+ (utf7-decode-string "Hi Mom -+Jjo--!"))))
+
+(luna-define-method test-utf7-decode-string-alpha ((case test-utf7))
+ (lunit-assert
+ (string=
+ (concat "A"
+ (string (make-char 'mule-unicode-0100-24ff 121 34)
+ (make-char 'mule-unicode-0100-24ff 38 113))
+ ".")
+ (utf7-decode-string "A+ImIDkQ."))) ; omit `-'
+ ;;
+ (lunit-assert
+ (string=
+ (concat "A"
+ (string (make-char 'mule-unicode-0100-24ff 121 34)
+ (make-char 'mule-unicode-0100-24ff 38 113))
+ ".")
+ (utf7-decode-string "A+ImIDkQ-."))))
+
+(luna-define-method test-utf7-decode-string-plus ((case test-utf7))
+ (lunit-assert
+ (string= "+" (utf7-decode-string "+-")))
+ (lunit-assert
+ (string= "++" (utf7-decode-string "+-+-")))
+ (lunit-assert
+ (string= "+++" (utf7-decode-string "+-+-+-")))
+ (lunit-assert
+ (string= "++++" (utf7-decode-string "+-+-+-+-"))))
+
+(luna-define-method test-utf7-decode-string-noconv ((case test-utf7))
+ (lunit-assert
+ (string= "" (utf7-decode-string "")))
+ (lunit-assert
+ (string= "a" (utf7-decode-string "a")))
+ (lunit-assert
+ (string= "-" (utf7-decode-string "-")))
+ (lunit-assert
+ (string= "=" (utf7-encode-string "="))))
Modified utils/ChangeLog
diff --git a/utils/ChangeLog b/utils/ChangeLog
index 3217402..d0f205a 100644
--- a/utils/ChangeLog
+++ b/utils/ChangeLog
@@ -1,3 +1,8 @@
+2010-01-06 TAKAHASHI Kaoru <[email protected]>
+
+ * wl-addrbook.el (wl-summary-addrbook-add): Use
+ `with-current-buffer' instead of `save-excursion' & `set-buffer'.
+
2008-04-22 TAKAHASHI Kaoru <[email protected]>
* ptexinfmt.el: Fix Comments.
Modified utils/wl-addrbook.el
diff --git a/utils/wl-addrbook.el b/utils/wl-addrbook.el
index 5a8c3a9..b553230 100644
--- a/utils/wl-addrbook.el
+++ b/utils/wl-addrbook.el
@@ -400,8 +400,7 @@ it will add an alias."
(wl-summary-redisplay)
(let ((buf wl-message-buffer)
from shortname address addrs name)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(setq address (std11-field-body "From"))
(if (wl-address-user-mail-address-p address)
(setq address (std11-field-body "To")))
Modified wl/wl-acap.el
diff --git a/wl/wl-acap.el b/wl/wl-acap.el
index f9be6c2..4c9605e 100644
--- a/wl/wl-acap.el
+++ b/wl/wl-acap.el
@@ -390,11 +390,11 @@ If nil, default acap port is used."
(nreverse settings)))
(message "Storing folders...")
(wl-acap-store-folders proc)
- ;; Does not work correctly??
- ;; (acap-setacl proc (list
- ;; (concat
- ;; "/" wl-acap-dataset-class "/~/"))
- ;; "anyone" "") ; protect.
+;;; Does not work correctly??
+;;; (acap-setacl proc (list
+;;; (concat
+;;; "/" wl-acap-dataset-class "/~/"))
+;;; "anyone" "") ; protect.
)
(acap-close proc))
(if (interactive-p)
Modified wl/wl-action.el
diff --git a/wl/wl-action.el b/wl/wl-action.el
index d82580e..27fe11d 100644
--- a/wl/wl-action.el
+++ b/wl/wl-action.el
@@ -251,11 +251,11 @@ Return number if put mark succeed"
(when (wl-summary-action-argument-function action)
(wl-summary-remove-argument)))
(set-buffer-modified-p nil))))
- ;; Move the cursor.
- ;; (if (or interactive (interactive-p))
- ;; (if (eq wl-summary-move-direction-downward nil)
- ;; (wl-summary-prev)
- ;; (wl-summary-next))))
+;;; Move the cursor.
+;;; (if (or interactive (interactive-p))
+;;; (if (eq wl-summary-move-direction-downward nil)
+;;; (wl-summary-prev)
+;;; (wl-summary-next))))
)
(defun wl-summary-make-destination-numbers-list (mark-list)
@@ -544,9 +544,8 @@ Return number if put mark succeed"
"Resend the message with NUMBER to ADDRESS."
(message "Resending message to %s..." address)
(let ((folder wl-summary-buffer-elmo-folder))
- (save-excursion
+ (with-current-buffer (get-buffer-create " *wl-draft-resend*")
;; We first set up a normal mail buffer.
- (set-buffer (get-buffer-create " *wl-draft-resend*"))
(set-buffer-multibyte nil)
(erase-buffer)
(setq wl-sent-message-via nil)
@@ -604,8 +603,8 @@ Return number if put mark succeed"
(buffer-read-only nil)
(buf (current-buffer))
sol eol rs re)
+ (setq sol (point-at-bol))
(beginning-of-line)
- (setq sol (point))
(search-forward "\r")
(forward-char -1)
(setq eol (point))
@@ -747,7 +746,8 @@ Return number if put mark succeed"
(put-text-property rs re 'invisible t))
(when (and width
(> (setq padding (- width len c)) 0))
- (setq data (concat (make-string padding ?\ ) data)))
+ (setq data (concat (make-string padding (string-to-char " "))
+ data)))
(setq rs (1- re))))
(put-text-property rs re 'wl-summary-action-argument t)
(goto-char re)
@@ -825,7 +825,7 @@ Return number if put mark succeed"
checked-dsts
(count 0)
number dst thr-entity)
- (goto-line 1)
+ (goto-char (point-min))
(while (not (eobp))
(setq number (wl-summary-message-number))
(dolist (number (cons number
Modified wl/wl-address.el
diff --git a/wl/wl-address.el b/wl/wl-address.el
index 69abb20..c63c5f1 100644
--- a/wl/wl-address.el
+++ b/wl/wl-address.el
@@ -266,7 +266,7 @@ Matched address lists are append to CL."
;; make mail addrses list
(while mails
(if (null (assoc (car mails) cl)); Not already in cl.
- ;; (string-match regexp (car mails))
+;;; (string-match regexp (car mails))
;; add mail address itself to completion list
(setq result (cons (cons (car mails)
(concat cn " <" (car mails) ">"))
@@ -365,8 +365,7 @@ Matched address lists are append to CL."
(if (and (get-buffer-window wl-completion-buf-name)
(equal wl-complete-candidates all))
(let ((win (get-buffer-window wl-completion-buf-name)))
- (save-excursion
- (set-buffer wl-completion-buf-name)
+ (with-current-buffer wl-completion-buf-name
(if (pos-visible-in-window-p (point-max) win)
(set-window-start win 1)
(scroll-other-window))))
@@ -456,7 +455,7 @@ Matched address lists are append to CL."
((and epand-char
(> len 0)
(or (char-equal (aref pattern (1- len)) epand-char)
- (char-equal (aref pattern (1- len)) ?\ ))
+ (char-equal (aref pattern (1- len)) (string-to-char " ")))
(assoc (substring pattern 0 (1- len)) cl))
(wl-complete-insert
start end
@@ -564,10 +563,10 @@ Refresh `wl-address-list', `wl-address-completion-list', and
(defsubst wl-address-header-extract-address (str)
"Extracts a real e-mail address from STR and return it.
-e.g. \"Mine Sakurai <[email protected]>\"
- -> \"[email protected]\".
-e.g. \"[email protected] (Mine Sakurai)\"
- -> \"[email protected]\"."
+e.g. \"Mine Sakurai <[email protected]>\"
+ -> \"[email protected]\".
+e.g. \"[email protected] (Mine Sakurai)\"
+ -> \"[email protected]\"."
(cond ((string-match ".*<\\([^>]*\\)>" str) ; .* to extract last <>
(wl-match-string 1 str))
((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str)
@@ -576,7 +575,7 @@ e.g. \"[email protected] (Mine Sakurai)\"
(defsubst wl-address-header-extract-realname (str)
"Extracts a real name from STR and return it.
-e.g. \"Mr. bar <[email protected]>\"
+e.g. \"Mr. bar <[email protected]>\"
-> \"Mr. bar\"."
(cond ((string-match "\\(.*[^ \t]\\)[ \t]*<[^>]*>" str)
(wl-match-string 1 str))
@@ -721,10 +720,7 @@ If already registerd, change it."
(insert "\n")))
;; override
(while (re-search-forward (concat "^[ \t]*" address) nil t)
- (delete-region (save-excursion (beginning-of-line)
- (point))
- (save-excursion (end-of-line)
- (+ 1 (point))))))
+ (delete-region (point-at-bol) (1+ (point-at-eol)))))
(insert (format "%s\t%s\t%s\n"
(or new-addr address)
(prin1-to-string the-petname)
Modified wl/wl-addrmgr.el
diff --git a/wl/wl-addrmgr.el b/wl/wl-addrmgr.el
index 5c27f35..72e6c96 100644
--- a/wl/wl-addrmgr.el
+++ b/wl/wl-addrmgr.el
@@ -439,8 +439,7 @@ Return nil if no ADDRESS exists."
(let ((entry (wl-addrmgr-address-entry))
buffer-read-only)
(save-excursion
- (beginning-of-line)
- (delete-region (point) (progn (end-of-line)(point)))
+ (delete-region (point-at-bol) (point-at-eol))
(wl-addrmgr-insert-line entry))
(set-buffer-modified-p nil)
(wl-addrmgr-next)))
@@ -552,20 +551,15 @@ Return nil if no ADDRESS exists."
;;; Operations.
(defun wl-addrmgr-address-entry ()
- (save-excursion
- (end-of-line)
- (get-text-property (previous-single-property-change
- (point) 'wl-addrmgr-entry nil
- (progn
- (beginning-of-line)
- (point)))
- 'wl-addrmgr-entry)))
+ (get-text-property (previous-single-property-change
+ (point-at-eol) 'wl-addrmgr-entry nil
+ (point-at-bol))
+ 'wl-addrmgr-entry))
(defun wl-addrmgr-mark-write (&optional mark)
"Set MARK to the current address entry."
(save-excursion
- (end-of-line)
- (unless (< (count-lines (point-min) (point)) 3)
+ (unless (< (count-lines (point-min) (point-at-eol)) 3)
(let ((buffer-read-only nil) beg end)
(beginning-of-line)
(delete-char 4)
@@ -574,16 +568,12 @@ Return nil if no ADDRESS exists."
(cc "Cc: ")
(bcc "Bcc:")
(t " ")))
- (insert (make-string (- 4 (current-column)) ? ))
- (beginning-of-line)
- (setq beg (point))
- (setq end (progn (end-of-line)
- (point)))
+ (insert (make-string (- 4 (current-column)) (string-to-char " ")))
+ (setq beg (point-at-bol))
+ (setq end (point-at-eol))
(put-text-property beg end 'face nil)
(wl-highlight-message beg end nil))
- (set-buffer-modified-p nil)
- (beginning-of-line)
- (forward-char 4))))
+ (set-buffer-modified-p nil))))
(defun wl-addrmgr-apply ()
(interactive)
@@ -672,12 +662,10 @@ Return nil if no ADDRESS exists."
(while (re-search-forward (concat "^" (regexp-quote field) ":") nil t)
;; delete field
(progn
- (save-excursion
- (beginning-of-line)
- (setq beg (point)))
+ (setq beg (point-at-bol))
(re-search-forward "^[^ \t]" nil 'move)
- (beginning-of-line)
- (delete-region beg (point))))
+ (delete-region beg (point-at-bol))
+ (beginning-of-line)))
(when content
;; add field to top.
(goto-char (point-min))
Modified wl/wl-demo.el
diff --git a/wl/wl-demo.el b/wl/wl-demo.el
index c9bbfe3..38f78c0 100644
--- a/wl/wl-demo.el
+++ b/wl/wl-demo.el
@@ -31,7 +31,7 @@
;;; Code:
(defconst wl-demo-copyright-notice
- "Copyright (C) 1998-2008 Yuuichi Teranishi <[email protected]>"
+ "Copyright (C) 1998-2010 Yuuichi Teranishi <[email protected]>"
"A declaration of the copyright on Wanderlust.")
(eval-when-compile
@@ -190,9 +190,10 @@ Return a number of lines that an image occupies in the buffer."
file image-type)))))
(when (eq 'xbm image-type)
(set-glyph-face image 'wl-highlight-logo-face))
- (insert-char ?\ (max 0 (/ (+ (* (- width (glyph-width image))
- (window-width)) width)
- (* 2 width))))
+ (insert-char (string-to-char " ")
+ (max 0 (/ (+ (* (- width (glyph-width image))
+ (window-width)) width)
+ (* 2 width))))
(set-extent-end-glyph (make-extent (point) (point)) image)
(insert "\n")
(/ (+ (* 2 (glyph-height image) (window-height)) height)
@@ -235,11 +236,11 @@ Return a number of lines that an image occupies in the buffer."
;; Emacs 21.x may fail on computing the end of the
;; column if there're bitmap characters.
- ;;(setq width 0)
- ;;(while (progn
- ;; (end-of-line 0)
- ;; (not (bobp)))
- ;; (setq width (max width (current-column))))
+;;; (setq width 0)
+;;; (while (progn
+;;; (end-of-line 0)
+;;; (not (bobp)))
+;;; (setq width (max width (current-column))))
(setq width 1024)
(while (progn
(end-of-line 0)
Modified wl/wl-dnd.el
diff --git a/wl/wl-dnd.el b/wl/wl-dnd.el
index 4aa4a42..cf159f1 100644
--- a/wl/wl-dnd.el
+++ b/wl/wl-dnd.el
@@ -49,7 +49,7 @@
(mouse-set-point event)
(start-drag event (concat
wl-summary-buffer-folder-name " "
- (int-to-string (wl-summary-message-number)))))
+ (number-to-string (wl-summary-message-number)))))
(defun wl-dnd-drop-func (event object text)
(interactive "@e")
@@ -93,7 +93,7 @@
(defun wl-dnd-set-drag-starter (beg end)
(let (ext kmap)
(setq ext (make-extent beg end))
-;;; (set-extent-property ext 'mouse-face 'isearch)
+;;; (set-extent-property ext 'mouse-face 'isearch)
(setq kmap (make-keymap))
(define-key kmap [button1] 'wl-dnd-start-drag)
(set-extent-property ext 'keymap kmap)))
Modified wl/wl-draft.el
diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index 1b40de7..afda8ff 100644
--- a/wl/wl-draft.el
+++ b/wl/wl-draft.el
@@ -407,7 +407,7 @@ or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
(setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
(with-temp-buffer ; to keep raw buffer unibyte.
(set-buffer-multibyte default-enable-multibyte-characters)
- (setq newsgroups (wl-parse newsgroups
+ (setq newsgroups (elmo-parse newsgroups
"[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
newsgroups (wl-delete-duplicates newsgroups)
newsgroups
@@ -423,24 +423,24 @@ or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
to (copy-sequence to))
t t))
(and to (setq to (mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr to-alist)) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr to-alist)) addr)
+ addr))
to ",\n\t")))
(and cc (setq cc (mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr cc-alist)) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr cc-alist)) addr)
+ addr))
cc ",\n\t")))
(and mail-followup-to
(setq mail-followup-to
(mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr (append to-alist cc-alist))) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr (append to-alist cc-alist))) addr)
+ addr))
mail-followup-to ",\n\t")))
(and (null to) (setq to cc cc nil))
(setq references (delq nil references)
@@ -487,8 +487,7 @@ or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
(wl-draft-add-in-reply-to "References"))
(defun wl-draft-add-in-reply-to (&optional alt-field)
- (let* ((mes-id (save-excursion
- (set-buffer mail-reply-buffer)
+ (let* ((mes-id (with-current-buffer mail-reply-buffer
(std11-field-body "message-id")))
(field (or alt-field "In-Reply-To"))
(ref (std11-field-body field))
@@ -756,9 +755,8 @@ or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
(defun wl-draft-delete (editing-buffer)
"Kill the editing draft buffer and delete the file corresponds to it."
- (save-excursion
- (when editing-buffer
- (set-buffer editing-buffer)
+ (when editing-buffer
+ (with-current-buffer editing-buffer
(when wl-draft-buffer-message-number
(elmo-folder-delete-messages (wl-draft-get-folder)
(list
@@ -867,7 +865,7 @@ text was killed."
(concat " to="
(mapconcat
'identity
- (mapcar '(lambda(x) (format "<%s>" x)) to)
+ (mapcar (lambda (x) (format "<%s>" x)) to)
","))))
""))
(id (if id (concat " id=" id) ""))
@@ -1070,8 +1068,7 @@ non-nil."
(newline))
(run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(if mail-interactive
- (save-excursion
- (set-buffer errbuf)
+ (with-current-buffer errbuf
(erase-buffer)))
(wl-draft-delete-field "bcc" delimline)
(wl-draft-delete-field "resent-bcc" delimline)
@@ -1170,7 +1167,7 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
nil t)
(when (string= "" (match-string 1))
(replace-match ""))))
-;;; (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
+;;; (run-hooks 'wl-mail-send-pre-hook) ; X-PGP-Sig, Cancel-Lock
(wl-draft-dispatch-message)
(when kill-when-done
;; hide editing-buffer.
@@ -1304,9 +1301,9 @@ This variable is valid when `wl-interactive-send' has non-nil value."
"Send current draft message.
If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(interactive)
- ;; Don't call this explicitly.
- ;; Added to 'wl-draft-send-hook (by teranisi)
- ;; (wl-draft-config-exec)
+;;; Don't call this explicitly.
+;;; Added to 'wl-draft-send-hook (by teranisi)
+;;; (wl-draft-config-exec)
(run-hooks 'wl-draft-send-hook)
(when (or (not wl-interactive-send)
(wl-draft-send-confirm))
@@ -1322,8 +1319,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(wl-draft-verbose-msg nil)
err)
(unwind-protect
- (save-excursion
- (set-buffer sending-buffer)
+ (with-current-buffer sending-buffer
(if (and (not (wl-message-mail-p))
(not (wl-message-news-p)))
(error "No recipient is specified"))
@@ -1559,15 +1555,12 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(defun wl-draft-do-fcc (header-end &optional fcc-list)
(let ((send-mail-buffer (current-buffer))
- (tembuf (generate-new-buffer " fcc output"))
(case-fold-search t)
beg end)
(or (markerp header-end) (error "HEADER-END must be a marker"))
- (save-excursion
- (unless fcc-list
- (setq fcc-list (wl-draft-get-fcc-list header-end)))
- (set-buffer tembuf)
- (erase-buffer)
+ (unless fcc-list
+ (setq fcc-list (wl-draft-get-fcc-list header-end)))
+ (with-temp-buffer
;; insert just the headers to avoid moving the gap more than
;; necessary (the message body could be arbitrarily huge.)
(insert-buffer-substring send-mail-buffer 1 header-end)
@@ -1588,8 +1581,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(or (equal (car fcc-list) (car wl-read-folder-history))
(setq wl-read-folder-history
(append (list (car fcc-list)) wl-read-folder-history))))
- (setq fcc-list (cdr fcc-list)))))
- (kill-buffer tembuf)))
+ (setq fcc-list (cdr fcc-list)))))))
(defun wl-draft-on-field-p ()
(if (< (point)
@@ -1857,7 +1849,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
field
nil)))
-(defsubst wl-draft-default-headers ()
+(defun wl-draft-default-headers ()
(list
(cons 'Mail-Reply-To (and wl-insert-mail-reply-to
(wl-address-header-extract-address
@@ -1936,8 +1928,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(defun wl-draft-generate-clone-buffer (name &optional local-variables)
"Generate clone of current buffer named NAME."
(let ((editing-buffer (current-buffer)))
- (save-excursion
- (set-buffer (generate-new-buffer name))
+ (with-current-buffer (generate-new-buffer name)
(erase-buffer)
(wl-draft-mode)
(wl-draft-editor-mode)
@@ -1946,8 +1937,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(while local-variables
(make-local-variable (car local-variables))
(set (car local-variables)
- (save-excursion
- (set-buffer editing-buffer)
+ (with-current-buffer editing-buffer
(symbol-value (car local-variables))))
(setq local-variables (cdr local-variables)))
(current-buffer))))
@@ -2009,22 +1999,20 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(goto-char (point-max))
buffer))
-(defmacro wl-draft-body-goto-top ()
- `(progn
- (goto-char (point-min))
- (if (re-search-forward mail-header-separator nil t)
- (forward-char 1)
- (goto-char (point-max)))))
+(defun wl-draft-body-goto-top ()
+ (goto-char (point-min))
+ (if (re-search-forward mail-header-separator nil t)
+ (forward-char 1)
+ (goto-char (point-max))))
-(defmacro wl-draft-body-goto-bottom ()
- `(goto-char (point-max)))
+(defun wl-draft-body-goto-bottom ()
+ (goto-char (point-max)))
-(defmacro wl-draft-config-body-goto-header ()
- `(progn
- (goto-char (point-min))
- (if (re-search-forward mail-header-separator nil t)
- (beginning-of-line)
- (goto-char (point-max)))))
+(defun wl-draft-config-body-goto-header ()
+ (goto-char (point-min))
+ (if (re-search-forward mail-header-separator nil t)
+ (beginning-of-line)
+ (goto-char (point-max))))
(defsubst wl-draft-config-sub-eval-insert (content &optional newline)
(let (content-value)
@@ -2166,8 +2154,7 @@ Automatically applied in draft sending time."
((eq key 'reply)
(when (and
reply-buf
- (save-excursion
- (set-buffer reply-buf)
+ (with-current-buffer reply-buf
(save-restriction
(std11-narrow-to-header)
(goto-char (point-min))
@@ -2452,8 +2439,8 @@ Automatically applied in draft sending time."
((looking-at wl-folder-complete-header-regexp)
(and (boundp 'wl-read-folder-history)
(setq history wl-read-folder-history)))
- ;; ((looking-at wl-address-complete-header-regexp)
- ;; (setq history .....))
+;;; ((looking-at wl-address-complete-header-regexp)
+;;; (setq history .....))
(t
nil)))
(eolp))
Modified wl/wl-e21.el
diff --git a/wl/wl-e21.el b/wl/wl-e21.el
index c385827..325475c 100644
--- a/wl/wl-e21.el
+++ b/wl/wl-e21.el
@@ -657,7 +657,7 @@ Special commands:
(define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select)
(define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message)
(define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr)
-;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save)
+;;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save)
(define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)
(define-key wl-draft-mode-map "\C-c\C-d" 'wl-draft-elide-region)
(define-key wl-draft-mode-map "\C-a" 'wl-draft-beginning-of-line)
@@ -666,7 +666,7 @@ Special commands:
(defun wl-draft-overload-functions ()
(wl-mode-line-buffer-identification)
-;; (local-set-key "\C-c\C-s" 'wl-draft-send);; override
+;;; (local-set-key "\C-c\C-s" 'wl-draft-send) ; override
(wl-e21-setup-draft-toolbar)
(wl-draft-overload-menubar))
Modified wl/wl-expire.el
diff --git a/wl/wl-expire.el b/wl/wl-expire.el
index f916269..cab4d9f 100644
--- a/wl/wl-expire.el
+++ b/wl/wl-expire.el
@@ -72,11 +72,11 @@
(t
(error "Invalid marks: %s" wl-summary-expire-reserve-marks))))
-(defmacro wl-expire-make-sortable-date (date)
- `(timezone-make-sortable-date
- (aref ,date 0) (aref ,date 1) (aref ,date 2)
- (timezone-make-time-string
- (aref ,date 3) (aref ,date 4) (aref ,date 5))))
+(defsubst wl-expire-make-sortable-date (date)
+ (timezone-make-sortable-date
+ (aref date 0) (aref date 1) (aref date 2)
+ (timezone-make-time-string
+ (aref date 3) (aref date 4) (aref date 5))))
;; New functions to avoid accessing to the msgdb directly.
(defsubst wl-expire-message-p (folder number)
Modified wl/wl-fldmgr.el
diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el
index a505606..1989a36 100644
--- a/wl/wl-fldmgr.el
+++ b/wl/wl-fldmgr.el
@@ -106,14 +106,11 @@
;;; Macro and misc Function
;;
-(defmacro wl-fldmgr-delete-line ()
- '(delete-region (save-excursion (beginning-of-line)
- (point))
- (save-excursion (end-of-line)
- (+ 1 (point)))))
+(defun wl-fldmgr-delete-line ()
+ (delete-region (point-at-bol) (1+ (point-at-eol))))
-(defmacro wl-fldmgr-make-indent (level)
- `(concat " " (make-string (* 2 ,level) ,(string-to-char " "))))
+(defun wl-fldmgr-make-indent (level)
+ (concat " " (make-string (* 2 level) (string-to-char " "))))
(defmacro wl-fldmgr-get-entity-id (&optional entity)
`(get-text-property (if ,entity
@@ -246,29 +243,29 @@ return value is diffs '(-new -unread -all)."
(setq result-path (cdr result-path))
(setq entities (wl-pop entity-stack)))))))))
-;; (defun wl-fldmgr-get-previous-entity (entity key-id)
-;; (cdr (wl-fldmgr-get-previous-entity-internal '(nil . nil) entity key-id)))
-;;
-;; (defun wl-fldmgr-get-previous-entity-internal (result entity key-id)
-;; (cond
-;; ((stringp entity)
-;; (if (eq key-id (wl-fldmgr-get-entity-id entity))
-;; (cons t result)
-;; (cons nil (cons entity entity))))
-;; ((consp entity)
-;; (if (eq key-id (wl-fldmgr-get-entity-id (car entity)))
-;; (cons t result)
-;; (setcar result (car entity))
-;; (let ((flist (nth 2 entity))
-;; return found)
-;; (while (and flist (not found))
-;; (if (car (setq return
-;; (wl-fldmgr-get-previous-entity-internal
-;; result (car flist) key-id)))
-;; (setq found t))
-;; (setq result (cdr return))
-;; (setq flist (cdr flist)))
-;; (cons found result))))))
+;;;(defun wl-fldmgr-get-previous-entity (entity key-id)
+;;; (cdr (wl-fldmgr-get-previous-entity-internal '(nil . nil) entity key-id)))
+;;;
+;;;(defun wl-fldmgr-get-previous-entity-internal (result entity key-id)
+;;; (cond
+;;; ((stringp entity)
+;;; (if (eq key-id (wl-fldmgr-get-entity-id entity))
+;;; (cons t result)
+;;; (cons nil (cons entity entity))))
+;;; ((consp entity)
+;;; (if (eq key-id (wl-fldmgr-get-entity-id (car entity)))
+;;; (cons t result)
+;;; (setcar result (car entity))
+;;; (let ((flist (nth 2 entity))
+;;; return found)
+;;; (while (and flist (not found))
+;;; (if (car (setq return
+;;; (wl-fldmgr-get-previous-entity-internal
+;;; result (car flist) key-id)))
+;;; (setq found t))
+;;; (setq result (cdr return))
+;;; (setq flist (cdr flist)))
+;;; (cons found result))))))
;; path is get `wl-fldmgr-get-path-from-buffer'.
(defun wl-fldmgr-update-group (path diffs)
@@ -765,10 +762,9 @@ return value is diffs '(-new -unread -all)."
(let ((table
(catch 'found
(mapatoms
- (function
- (lambda (atom)
- (if (string-match (symbol-name atom) string)
- (throw 'found (symbol-value atom)))))
+ (lambda (atom)
+ (if (string-match (symbol-name atom) string)
+ (throw 'found (symbol-value atom))))
wl-fldmgr-add-completion-hashtb)))
(pattern
(if (string-match "\\.$"
@@ -797,8 +793,8 @@ return value is diffs '(-new -unread -all)."
(defun wl-fldmgr-add-completion-subr (string predicate flag)
(let ((table
(if (string= string "")
- (mapcar (function (lambda (spec)
- (list (char-to-string (car spec)))))
+ (mapcar (lambda (spec)
+ (list (char-to-string (car spec))))
elmo-folder-type-alist)
(when (assq (aref string 0) elmo-folder-type-alist)
(delq nil (mapcar
Modified wl/wl-folder.el
diff --git a/wl/wl-folder.el b/wl/wl-folder.el
index 7edd76c..7eac53f 100644
--- a/wl/wl-folder.el
+++ b/wl/wl-folder.el
@@ -88,7 +88,7 @@
["Next Folder" wl-folder-next-entity t]
["Check Current Folder" wl-folder-check-current-entity t]
["Sync Current Folder" wl-folder-sync-current-entity t]
-; ["Drop Current Folder" wl-folder-drop-unsync-current-entity t]
+;;; ["Drop Current Folder" wl-folder-drop-unsync-current-entity t]
["Prefetch Current Folder" wl-folder-prefetch-current-entity t]
"----"
["Mark as Read all Current Folder" wl-folder-mark-as-read-all-current-entity t]
@@ -147,7 +147,7 @@
nil
(setq wl-folder-mode-map (make-sparse-keymap))
(define-key wl-folder-mode-map " " 'wl-folder-jump-to-current-entity)
-; (define-key wl-folder-mode-map "\M- " 'wl-folder-open-close)
+;;; (define-key wl-folder-mode-map "\M- " 'wl-folder-open-close)
(define-key wl-folder-mode-map "/" 'wl-folder-open-close)
(define-key wl-folder-mode-map "\C-m" 'wl-folder-jump-to-current-entity)
(define-key wl-folder-mode-map [(shift return)] 'wl-folder-jump-to-current-entity-with-arg)
@@ -169,7 +169,7 @@
(define-key wl-folder-mode-map "rs" 'wl-folder-check-region)
(define-key wl-folder-mode-map "s" 'wl-folder-check-current-entity)
(define-key wl-folder-mode-map "I" 'wl-folder-prefetch-current-entity)
-; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
+;;; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
(define-key wl-folder-mode-map "p" 'wl-folder-prev-entity)
(define-key wl-folder-mode-map "n" 'wl-folder-next-entity)
(define-key wl-folder-mode-map "v" 'wl-folder-toggle-disp-summary)
@@ -224,14 +224,14 @@
"Menu used in Folder mode."
wl-folder-mode-menu-spec))
-(defmacro wl-folder-unread-regex (group)
- `(concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$"
- (if ,group
- "\\|^[ ]*\\[[+-]\\]"
- "")))
+(defun wl-folder-unread-regex (group)
+ (concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$"
+ (if group
+ "\\|^[ ]*\\[[+-]\\]"
+ "")))
-(defmacro wl-folder-buffer-group-p ()
- '(get-text-property (point) 'wl-folder-is-group))
+(defun wl-folder-buffer-group-p ()
+ (get-text-property (point) 'wl-folder-is-group))
(defun wl-folder-buffer-search-group (group)
(let ((prev-point (point))
@@ -273,12 +273,12 @@
(defmacro wl-folder-get-entity-id (entity)
`(get-text-property 0 'wl-folder-entity-id ,entity))
-(defmacro wl-folder-get-entity-from-buffer (&optional getid)
- `(let ((id (get-text-property (point)
- 'wl-folder-entity-id)))
- (if ,getid
- id
- (wl-folder-get-folder-name-by-id id))))
+(defun wl-folder-get-entity-from-buffer (&optional getid)
+ (let ((id (get-text-property (point)
+ 'wl-folder-entity-id)))
+ (if getid
+ id
+ (wl-folder-get-folder-name-by-id id))))
(defmacro wl-folder-entity-exists-p (entity &optional hashtb)
`(let ((sym (intern-soft ,entity (or ,hashtb wl-folder-entity-hashtb))))
@@ -445,9 +445,9 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'."
(setq entity (wl-pop entities))
(cond
((consp entity)
-;; (if (and (string= name (car entity))
-;; (eq id (wl-folder-get-entity-id (car entity))))
-;; (throw 'done last-entity))
+;;; (if (and (string= name (car entity))
+;;; (eq id (wl-folder-get-entity-id (car entity))))
+;;; (throw 'done last-entity))
(and entities
(wl-push entities entity-stack))
(setq entities (nth 2 entity)))
@@ -671,14 +671,14 @@ Optional argument ARG is repeart count."
(wl-folder-update-newest indent entity)
(wl-folder-insert-entity indent entity))
(wl-highlight-folder-path wl-folder-buffer-cur-path))
- ; (quit
- ; (setq err t)
- ; (setcdr (assoc fld-name wl-folder-group-alist) nil))
- ; (error
- ; (elmo-display-error errobj t)
- ; (ding)
- ; (setq err t)
- ; (setcdr (assoc fld-name wl-folder-group-alist) nil)))
+;;; (quit
+;;; (setq err t)
+;;; (setcdr (assoc fld-name wl-folder-group-alist) nil))
+;;; (error
+;;; (elmo-display-error errobj t)
+;;; (ding)
+;;; (setq err t)
+;;; (setcdr (assoc fld-name wl-folder-group-alist) nil)))
(if (not err)
(let ((buffer-read-only nil))
(delete-region (save-excursion (beginning-of-line)
@@ -701,8 +701,8 @@ Optional argument ARG is repeart count."
(wl-folder-insert-entity indent entity) ; insert entity
(forward-line -1)
(wl-highlight-folder-path wl-folder-buffer-cur-path)
- ; (wl-delete-all-overlays)
- ; (wl-highlight-folder-current-line)
+;;; (wl-delete-all-overlays)
+;;; (wl-highlight-folder-current-line)
))
;; ordinal folder
(wl-folder-set-current-entity-id
@@ -839,8 +839,8 @@ Optional argument ARG is repeart count."
ret-val
(wl-folder-check-entity (car flist))))
(setq flist (cdr flist)))
- ;(wl-folder-buffer-search-entity (car entity))
- ;(wl-folder-update-line ret-val)
+;;; (wl-folder-buffer-search-entity (car entity))
+;;; (wl-folder-update-line ret-val)
))
((stringp entity)
(message "Checking \"%s\"" entity)
@@ -949,7 +949,7 @@ Optional argument ARG is repeart count."
ret-val
(wl-folder-check-one-entity (elmo-folder-name-internal
folder))))
- ;;(sit-for 0)
+;;; (sit-for 0)
))
;; check network entity at last
(when async-folder-list
@@ -963,7 +963,7 @@ Optional argument ARG is repeart count."
ret-val
(wl-folder-check-one-entity (elmo-folder-name-internal
folder))))
- ;;(sit-for 0)
+;;; (sit-for 0)
)))
ret-val))
@@ -1263,16 +1263,16 @@ If current line is group folder, all subfolders are marked."
(let (name)
(setq name (wl-match-buffer 1))
(goto-char (+ 1 (match-end 0)))
-; (condition-case ()
-; (unwind-protect
-; (setq flist (elmo-list-folders name)))
-; (error (message "Access to folder %s failed." name)))
-;; (setq flist (elmo-msgdb-flist-load name)) ; load flist.
-;; (setq unsublist (nth 1 flist))
-;; (setq flist (car flist))
-;; (list name 'access flist unsublist)))
+;;; (condition-case ()
+;;; (unwind-protect
+;;; (setq flist (elmo-list-folders name)))
+;;; (error (message "Access to folder %s failed." name)))
+;;; (setq flist (elmo-msgdb-flist-load name)) ; load flist.
+;;; (setq unsublist (nth 1 flist))
+;;; (setq flist (car flist))
+;;; (list name 'access flist unsublist)))
(append (list name 'access) (wl-create-access-folder-entity name))))
- ;((looking-at "^[\t ]*\\([^\t \n}]+\\)[\t ]*\\(\"[^\"]*\"\\)?[\t ]*$") ; normal folder entity
+;;; ((looking-at "^[\t ]*\\([^\t \n}]+\\)[\t ]*\\(\"[^\"]*\"\\)?[\t ]*$") ; normal folder entity
((looking-at "^[\t ]*=[ \t]+\\([^\n]+\\)$"); petname definition
(goto-char (+ 1 (match-end 0)))
(let ((rest (elmo-match-buffer 1))
@@ -1623,12 +1623,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
(list new unread all)))
(defsubst wl-folder-make-save-access-list (list)
- (mapcar '(lambda (x)
- (cond
- ((consp x)
- (list (elmo-string (car x)) 'access))
- (t
- (elmo-string x))))
+ (mapcar (lambda (x)
+ (cond
+ ((consp x)
+ (list (elmo-string (car x)) 'access))
+ (t
+ (elmo-string x))))
list))
(defun wl-folder-update-newest (indent entity)
@@ -1905,31 +1905,31 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
hashtb))
;; Unsync number is reserved.
-;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name)
-;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
-;; (entities (list entity))
-;; entity-stack)
-;; (while entities
-;; (setq entity (wl-pop entities))
-;; (cond
-;; ((consp entity)
-;; (if id-name
-;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity))
-;; (car entity)))
-;; (and entities
-;; (wl-push entities entity-stack))
-;; (setq entities (nth 2 entity))
-;; )
-;; ((stringp entity)
-;; (wl-folder-set-entity-info entity
-;; (wl-folder-get-entity-info entity)
-;; hashtb)
-;; (if id-name
-;; (wl-folder-set-id-name (wl-folder-get-entity-id entity)
-;; entity))))
-;; (unless entities
-;; (setq entities (wl-pop entity-stack))))
-;; hashtb))
+;;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name)
+;;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
+;;; (entities (list entity))
+;;; entity-stack)
+;;; (while entities
+;;; (setq entity (wl-pop entities))
+;;; (cond
+;;; ((consp entity)
+;;; (if id-name
+;;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity))
+;;; (car entity)))
+;;; (and entities
+;;; (wl-push entities entity-stack))
+;;; (setq entities (nth 2 entity))
+;;; )
+;;; ((stringp entity)
+;;; (wl-folder-set-entity-info entity
+;;; (wl-folder-get-entity-info entity)
+;;; hashtb)
+;;; (if id-name
+;;; (wl-folder-set-id-name (wl-folder-get-entity-id entity)
+;;; entity))))
+;;; (unless entities
+;;; (setq entities (wl-pop entity-stack))))
+;;; hashtb))
(defun wl-folder-create-newsgroups-from-nntp-access (entity)
(let ((flist (nth 2 entity))
@@ -2675,9 +2675,9 @@ Use `wl-subscribed-mailing-list'."
(if (or new-flist removes)
(setq diff t))
(setq new-flist
- (mapcar '(lambda (x)
- (cond ((consp x) (list (car x) 'access))
- (t x)))
+ (mapcar (lambda (x)
+ (cond ((consp x) (list (car x) 'access))
+ (t x)))
new-flist))
;; check new groups
(let ((new-list new-flist))
@@ -2794,50 +2794,50 @@ If current line is group folder, all subfolders are prefetched."
(wl-folder-check-entity entity))
(wl-folder-prefetch-entity entity)))))
-;(defun wl-folder-drop-unsync-entity (entity)
-; "Drop all unsync messages in the ENTITY."
-; (cond
-; ((consp entity)
-; (let ((flist (nth 2 entity)))
-; (while flist
-; (wl-folder-drop-unsync-entity (car flist))
-; (setq flist (cdr flist)))))
-; ((stringp entity)
-; (let ((nums (wl-folder-get-entity-info entity))
-; wl-summary-highlight wl-auto-select-first new)
-; (setq new (or (car nums) 0))
-; (if (< 0 new)
-; (save-window-excursion
-; (save-excursion
-; (let ((wl-summary-buffer-name (concat
-; wl-summary-buffer-name
-; (symbol-name this-command))))
-; (wl-summary-goto-folder-subr entity 'no-sync nil)
-; (wl-summary-drop-unsync)
-; (wl-summary-exit)))))))))
-
-;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
-; "Drop all unsync messages in the folder at position.
-;If current line is group folder, all subfolders are dropped.
-;If optional arg exists, don't check any folders."
-; (interactive "P")
-; (save-excursion
-; (let ((entity-name (wl-folder-get-entity-from-buffer))
-; (group (wl-folder-buffer-group-p))
-; wl-folder-check-entity-hook
-; summary-buf entity)
-; (when (and entity-name
-; (y-or-n-p (format
-; "Drop all unsync messages in %s? " entity-name)))
-; (setq entity
-; (if group
-; (wl-folder-search-group-entity-by-name entity-name
-; wl-folder-entity)
-; entity-name))
-; (if (null force-check)
-; (wl-folder-check-entity entity))
-; (wl-folder-drop-unsync-entity entity)
-; (message "All unsync messages in %s are dropped!" entity-name)))))
+;;;(defun wl-folder-drop-unsync-entity (entity)
+;;; "Drop all unsync messages in the ENTITY."
+;;; (cond
+;;; ((consp entity)
+;;; (let ((flist (nth 2 entity)))
+;;; (while flist
+;;; (wl-folder-drop-unsync-entity (car flist))
+;;; (setq flist (cdr flist)))))
+;;; ((stringp entity)
+;;; (let ((nums (wl-folder-get-entity-info entity))
+;;; wl-summary-highlight wl-auto-select-first new)
+;;; (setq new (or (car nums) 0))
+;;; (if (< 0 new)
+;;; (save-window-excursion
+;;; (save-excursion
+;;; (let ((wl-summary-buffer-name (concat
+;;; wl-summary-buffer-name
+;;; (symbol-name this-command))))
+;;; (wl-summary-goto-folder-subr entity 'no-sync nil)
+;;; (wl-summary-drop-unsync)
+;;; (wl-summary-exit)))))))))
+
+;;;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
+;;; "Drop all unsync messages in the folder at position.
+;;;If current line is group folder, all subfolders are dropped.
+;;;If optional arg exists, don't check any folders."
+;;; (interactive "P")
+;;; (save-excursion
+;;; (let ((entity-name (wl-folder-get-entity-from-buffer))
+;;; (group (wl-folder-buffer-group-p))
+;;; wl-folder-check-entity-hook
+;;; summary-buf entity)
+;;; (when (and entity-name
+;;; (y-or-n-p (format
+;;; "Drop all unsync messages in %s? " entity-name)))
+;;; (setq entity
+;;; (if group
+;;; (wl-folder-search-group-entity-by-name entity-name
+;;; wl-folder-entity)
+;;; entity-name))
+;;; (if (null force-check)
+;;; (wl-folder-check-entity entity))
+;;; (wl-folder-drop-unsync-entity entity)
+;;; (message "All unsync messages in %s are dropped!" entity-name)))))
(defun wl-folder-write-current-folder ()
"Write message to current folder's newsgroup or mailing-list.
@@ -2927,10 +2927,10 @@ Call `wl-summary-write-current-folder' with current folder name."
(setq folder-list (cdr folder-list)))
(if results
(message "%s are picked."
- (mapconcat '(lambda (res)
- (format "%s(%d)"
- (car res)
- (length (cdr res))))
+ (mapconcat (lambda (res)
+ (format "%s(%d)"
+ (car res)
+ (length (cdr res))))
results
","))
(message "No message was picked.")))))
Modified wl/wl-highlight.el
diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el
index 0476c58..c2fd339 100644
--- a/wl/wl-highlight.el
+++ b/wl/wl-highlight.el
@@ -811,14 +811,14 @@
wl-highlight-message-cited-text-9
wl-highlight-message-cited-text-10))
-(defmacro wl-delete-all-overlays ()
+(defun wl-delete-all-overlays ()
"Delete all momentary overlays."
- '(let ((overlays (overlays-in (point-min) (point-max)))
- overlay)
- (while (setq overlay (car overlays))
- (if (overlay-get overlay 'wl-momentary-overlay)
- (delete-overlay overlay))
- (setq overlays (cdr overlays)))))
+ (let ((overlays (overlays-in (point-min) (point-max)))
+ overlay)
+ (while (setq overlay (car overlays))
+ (if (overlay-get overlay 'wl-momentary-overlay)
+ (delete-overlay overlay))
+ (setq overlays (cdr overlays)))))
(defun wl-highlight-summary-displaying ()
(interactive)
Modified wl/wl-message.el
diff --git a/wl/wl-message.el b/wl/wl-message.el
index c7c22cd..71748aa 100644
--- a/wl/wl-message.el
+++ b/wl/wl-message.el
@@ -106,14 +106,14 @@ With association ((\"folder\" message \"message-id\") . cache-buffer).")
"Move ENTRY to the top of `wl-message-buffer-cache'."
(setq wl-message-buffer-cache
(cons entry (delete entry wl-message-buffer-cache))))
-; (let* ((pointer (cons nil wl-message-buffer-cache))
-; (top pointer))
-; (while (cdr pointer)
-; (if (equal (car (cdr pointer)) entry)
-; (setcdr pointer (cdr (cdr pointer)))
-; (setq pointer (cdr pointer))))
-; (setcdr pointer (list entry))
-; (setq wl-message-buffer-cache (cdr top))))
+;;; (let* ((pointer (cons nil wl-message-buffer-cache))
+;;; (top pointer))
+;;; (while (cdr pointer)
+;;; (if (equal (car (cdr pointer)) entry)
+;;; (setcdr pointer (cdr (cdr pointer)))
+;;; (setq pointer (cdr pointer))))
+;;; (setcdr pointer (list entry))
+;;; (setq wl-message-buffer-cache (cdr top))))
(defconst wl-original-message-buffer-name " *Original*")
@@ -208,8 +208,8 @@ Return its cache buffer."
(mes (cdr wl-message-window-size))
whi)
(when (and window
- (not (eq (save-excursion (set-buffer (window-buffer window))
- wl-message-buffer-cur-summary-buffer)
+ (not (eq (with-current-buffer (window-buffer window)
+ wl-message-buffer-cur-summary-buffer)
(current-buffer))))
(delete-window window)
(run-hooks 'wl-message-window-deleted-hook)
@@ -511,9 +511,9 @@ Returns non-nil if bottom of message."
wl-message-mode-line-format-spec-alist)
(setq mode-line-buffer-identification
(funcall wl-message-buffer-mode-line-formatter))
- ;; highlight body
-; (when wl-highlight-body-too
-; (wl-highlight-body))
+;;; ;; highlight body
+;;; (when wl-highlight-body-too
+;;; (wl-highlight-body))
(ignore-errors (wl-message-narrow-to-page))
(goto-char (point-min))
(when (re-search-forward "^$" nil t)
@@ -653,8 +653,8 @@ Returns non-nil if bottom of message."
(t wl-message-buffer-prefetch-folder-list)))))
(defsubst wl-message-buffer-prefetch-clear-timer ()
-;;; cannot use for the bug of fsf-compat package (1.09).
-;;; (cancel-function-timers 'wl-message-buffer-prefetch-subr)
+;;; cannot use for the bug of fsf-compat package (1.09).
+;;; (cancel-function-timers 'wl-message-buffer-prefetch-subr)
(if (fboundp 'run-with-idle-timer)
(if (featurep 'xemacs)
(let ((p itimer-list))
@@ -778,15 +778,16 @@ Returns non-nil if bottom of message."
(when wl-message-buffer-prefetch-debug
(message "Buffer Cached Messages: %s"
(mapconcat
- '(lambda (cache)
- (if (numberp (nth 1 (car cache)))
- (if (string=
- (nth 0 (car cache))
- (elmo-folder-name-internal folder))
- (format "%d"
- (nth 1 (car cache)))
- (format "*%d" (nth 1 (car cache))))
- "-"))
+
+ (lambda (cache)
+ (if (numberp (nth 1 (car cache)))
+ (if (string=
+ (nth 0 (car cache))
+ (elmo-folder-name-internal folder))
+ (format "%d"
+ (nth 1 (car cache)))
+ (format "*%d" (nth 1 (car cache))))
+ "-"))
wl-message-buffer-cache " "))) )))
(defvar wl-message-button-map (make-sparse-keymap))
@@ -821,8 +822,7 @@ Returns non-nil if bottom of message."
(wl-summary-redisplay)))
(defun wl-message-uu-substring (buf outbuf &optional first last)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(search-forward "\n\n")
(let ((sp (point))
ep filename case-fold-search)
@@ -833,18 +833,16 @@ Returns non-nil if bottom of message."
(setq filename (buffer-substring (match-beginning 1)(match-end 1)))
(throw 'done nil)))
(re-search-forward "^M.*$" nil t)) ; uuencoded string
- (beginning-of-line)
- (setq sp (point))
+ (setq sp (point-at-bol))
(goto-char (point-max))
(if last
(re-search-backward "^end" sp t)
(re-search-backward "^M.*$" sp t)) ; uuencoded string
(forward-line 1)
(setq ep (point))
- (set-buffer outbuf)
- (goto-char (point-max))
- (insert-buffer-substring buf sp ep)
- (set-buffer buf)
+ (with-current-buffer outbuf
+ (goto-char (point-max))
+ (insert-buffer-substring buf sp ep))
filename))))
;;; Header narrowing courtesy of Hideyuki Shirai.
Modified wl/wl-mime.el
diff --git a/wl/wl-mime.el b/wl/wl-mime.el
index 52cfad2..0c14cfd 100644
--- a/wl/wl-mime.el
+++ b/wl/wl-mime.el
@@ -62,8 +62,7 @@ has Non-nil value\)"
(function wl-draft-yank-to-draft-buffer))))
(message-buffer (wl-current-message-buffer)))
(if message-buffer
- (save-excursion
- (set-buffer message-buffer)
+ (with-current-buffer message-buffer
(save-restriction
(widen)
(cond
@@ -94,8 +93,7 @@ It calls following-method selected from variable
(setq min (point-min)
beg (re-search-forward "^$" nil t)
end (point-max)))
- (save-excursion
- (set-buffer (setq new-buf (get-buffer-create new-name)))
+ (with-current-buffer (setq new-buf (get-buffer-create new-name))
(erase-buffer)
(insert-buffer-substring the-buf beg end)
(goto-char (point-min))
@@ -126,8 +124,7 @@ It calls following-method selected from variable
new-buf
(the-buf (current-buffer))
fields)
- (save-excursion
- (set-buffer (setq new-buf (get-buffer-create new-name)))
+ (with-current-buffer (setq new-buf (get-buffer-create new-name))
(erase-buffer)
(insert ?\n)
(insert-buffer-substring the-buf r-beg r-end)
@@ -154,8 +151,7 @@ It calls following-method selected from variable
(setq field-name (car rest))
(or (std11-field-body field-name)
(progn
- (save-excursion
- (set-buffer the-buf)
+ (with-current-buffer the-buf
(let ((entity (when mime-mother-buffer
(set-buffer mime-mother-buffer)
(get-text-property (point)
@@ -419,7 +415,7 @@ It calls following-method selected from variable
(defsubst wl-mime-node-id-to-string (node-id)
(if (consp node-id)
- (mapconcat (function (lambda (num) (format "%s" (1+ num))))
+ (mapconcat (lambda (num) (format "%s" (1+ num)))
(reverse node-id)
".")
"0"))
Modified wl/wl-mule.el
diff --git a/wl/wl-mule.el b/wl/wl-mule.el
index c37c710..1c70621 100644
--- a/wl/wl-mule.el
+++ b/wl/wl-mule.el
@@ -162,7 +162,7 @@ Special commands:
(define-key wl-draft-mode-map "\C-c\C-e" 'wl-draft-config-exec)
(define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select)
(define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message)
-;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save)
+;;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save)
(define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr)
(define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)
(define-key wl-draft-mode-map "\C-c\C-d" 'wl-draft-elide-region)
@@ -199,7 +199,7 @@ Special commands:
(defun wl-draft-overload-functions ()
(wl-mode-line-buffer-identification)
-;; (local-set-key "\C-c\C-s" 'wl-draft-send);; override
+;;; (local-set-key "\C-c\C-s" 'wl-draft-send) ; override
(wl-draft-overload-menubar))
;; for "ja-mule-canna-2.3.mini" on PocketBSD
Modified wl/wl-score.el
diff --git a/wl/wl-score.el b/wl/wl-score.el
index 2010fec..328c5bd 100644
--- a/wl/wl-score.el
+++ b/wl/wl-score.el
@@ -538,14 +538,14 @@ Set `wl-score-cache' nil."
(setq extras (cdr extras)))
nil))
-(defmacro wl-score-put-alike ()
- '(elmo-set-hash-val (format "#%d" (wl-count-lines))
- alike
+(defmacro wl-score-put-alike (alike)
+ `(elmo-set-hash-val (format "#%d" (wl-count-lines))
+ ,alike
wl-score-alike-hashtb))
-(defmacro wl-score-get-alike ()
- '(elmo-get-hash-val (format "#%d" (wl-count-lines))
- wl-score-alike-hashtb))
+(defsubst wl-score-get-alike ()
+ (elmo-get-hash-val (format "#%d" (wl-count-lines))
+ wl-score-alike-hashtb))
(defun wl-score-insert-header (header messages &optional extra-header)
(let ((mime-decode (nth 3 (assoc header wl-score-header-index)))
@@ -576,12 +576,12 @@ Set `wl-score-cache' nil."
;; headers.
(wl-push art alike)
(when last
- (wl-score-put-alike)
+ (wl-score-put-alike alike)
(insert last ?\n))
(setq alike (list art)
last this)))
(when last
- (wl-score-put-alike)
+ (wl-score-put-alike alike)
(insert last ?\n))
(when mime-decode
(decode-mime-charset-region (point-min) (point-max)
@@ -711,7 +711,6 @@ Set `wl-score-cache' nil."
(defun wl-score-followup (scores header now expire &optional thread)
"Insert the unique message headers in the buffer."
- ;; Insert the unique message headers in the buffer.
(let ((wl-score-index (nth 2 (assoc header wl-score-header-index)))
(all-scores scores)
entries alist messages
@@ -868,7 +867,7 @@ Set `wl-score-cache' nil."
(car entry)
(if increase "raise" "lower"))
(if (numberp match)
- (int-to-string match)
+ (number-to-string match)
match)))
;; transform from string to int.
(when (eq (nth 1 (assoc (car entry) wl-score-header-index))
@@ -937,8 +936,7 @@ Set `wl-score-cache' nil."
(setq wl-score-help-winconf (current-window-configuration))
(let ((cur-win (selected-window))
mes-win)
- (save-excursion
- (set-buffer (get-buffer-create "*Score Help*"))
+ (with-current-buffer (get-buffer-create "*Score Help*")
(buffer-disable-undo (current-buffer))
(delete-windows-on (current-buffer))
(erase-buffer)
@@ -963,7 +961,7 @@ Set `wl-score-cache' nil."
(delete-char -1) ; the `\n' takes a char
(insert "\n"))
(setq pad (- width 3))
- (setq format (concat "%c: %-" (int-to-string pad) "s"))
+ (setq format (concat "%c: %-" (number-to-string pad) "s"))
(insert (format format (caar alist) (nth idx (car alist))))
(setq alist (cdr alist))
(setq i (1+ i)))
@@ -1374,8 +1372,7 @@ Entering Score mode calls the value of `wl-score-mode-hook'."
(let ((sum-buf (wl-score-edit-get-summary-buf))
(index (nth 2 (assoc header wl-score-header-index))))
(when (and sum-buf index)
- (save-excursion
- (set-buffer sum-buf)
+ (with-current-buffer sum-buf
(wl-score-get-header header extra)))))
(defun wl-score-edit-insert-number ()
@@ -1383,8 +1380,7 @@ Entering Score mode calls the value of `wl-score-mode-hook'."
(let ((sum-buf (wl-score-edit-get-summary-buf))
num)
(when sum-buf
- (if (setq num (save-excursion
- (set-buffer sum-buf)
+ (if (setq num (with-current-buffer sum-buf
(wl-summary-message-number)))
(prin1 num (current-buffer))))))
Modified wl/wl-summary.el
diff --git a/wl/wl-summary.el b/wl/wl-summary.el
index 7817579..3eb4bb0 100644
--- a/wl/wl-summary.el
+++ b/wl/wl-summary.el
@@ -69,9 +69,9 @@
(defvar wl-summary-buffer-elmo-folder nil)
-(defmacro wl-summary-buffer-folder-name ()
- `(and wl-summary-buffer-elmo-folder
- (elmo-folder-name-internal wl-summary-buffer-elmo-folder)))
+(defun wl-summary-buffer-folder-name ()
+ (and wl-summary-buffer-elmo-folder
+ (elmo-folder-name-internal wl-summary-buffer-elmo-folder)))
(defvar wl-summary-buffer-disp-msg nil)
(defvar wl-summary-buffer-disp-folder nil)
@@ -197,8 +197,8 @@
(defvar wl-temp-mark)
(defvar wl-persistent-mark)
-(defmacro wl-summary-sticky-buffer-name (name)
- `(concat wl-summary-buffer-name ":" ,name))
+(defun wl-summary-sticky-buffer-name (name)
+ (concat wl-summary-buffer-name ":" name))
(defun wl-summary-default-subject (subject-string)
(if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string)
@@ -606,9 +606,9 @@ See also variable `wl-use-petname'."
(setq wl-summary-buffer-message-ring
(cdr wl-summary-buffer-message-ring)))))
-(defmacro wl-summary-message-status (&optional number)
- `(elmo-message-status wl-summary-buffer-elmo-folder
- (or ,number (wl-summary-message-number))))
+(defsubst wl-summary-message-status (&optional number)
+ (elmo-message-status wl-summary-buffer-elmo-folder
+ (or number (wl-summary-message-number))))
(defun wl-summary-update-mark-and-highlight-window (&optional win beg)
"A function to be called as window-scroll-functions."
@@ -653,34 +653,34 @@ See also variable `wl-use-petname'."
;; Handler of event from elmo-folder
(defun wl-summary-update-persistent-mark-on-event (buffer numbers)
- (save-excursion
- (set-buffer buffer)
- (if wl-summary-lazy-update-mark
- (let ((window-list (get-buffer-window-list (current-buffer) 'nomini t))
- invalidate)
- (dolist (number numbers)
- (when (wl-summary-message-visible-p number)
- (if (catch 'visible
- (let ((window-list window-list)
- win)
- (while (setq win (car window-list))
- (when (wl-summary-jump-to-msg number
- (window-start win)
- (window-end win))
- (throw 'visible t))
- (setq window-list (cdr window-list)))))
- (wl-summary-update-persistent-mark number)
- (setq invalidate t))))
- (when invalidate
- (wl-summary-invalidate-persistent-mark)
- (dolist (win window-list)
- (wl-summary-validate-persistent-mark
- (window-start win)
- (window-end win)))))
- (dolist (number numbers)
- (when (and (wl-summary-message-visible-p number)
- (wl-summary-jump-to-msg number))
- (wl-summary-update-persistent-mark number))))))
+ (with-current-buffer buffer
+ (save-excursion
+ (if wl-summary-lazy-update-mark
+ (let ((window-list (get-buffer-window-list (current-buffer) 'nomini t))
+ invalidate)
+ (dolist (number numbers)
+ (when (wl-summary-message-visible-p number)
+ (if (catch 'visible
+ (let ((window-list window-list)
+ win)
+ (while (setq win (car window-list))
+ (when (wl-summary-jump-to-msg number
+ (window-start win)
+ (window-end win))
+ (throw 'visible t))
+ (setq window-list (cdr window-list)))))
+ (wl-summary-update-persistent-mark number)
+ (setq invalidate t))))
+ (when invalidate
+ (wl-summary-invalidate-persistent-mark)
+ (dolist (win window-list)
+ (wl-summary-validate-persistent-mark
+ (window-start win)
+ (window-end win)))))
+ (dolist (number numbers)
+ (when (and (wl-summary-message-visible-p number)
+ (wl-summary-jump-to-msg number))
+ (wl-summary-update-persistent-mark number)))))))
(defun wl-summary-buffer-attach ()
(when wl-summary-buffer-elmo-folder
@@ -829,6 +829,7 @@ you."
wl-summary-highlight
temp persistent)
(with-temp-buffer
+ (set-buffer-multibyte t)
(setq wl-summary-buffer-number-column column
wl-summary-buffer-line-formatter formatter
wl-summary-buffer-weekday-name-lang lang)
@@ -933,13 +934,13 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'."
(setq major-mode 'wl-summary-mode)
(setq mode-name "Summary")
(use-local-map wl-summary-mode-map)
-;;;(setq default-directory (or wl-tmp-dir (expand-file-name "~/")))
+;;; (setq default-directory (or wl-tmp-dir (expand-file-name "~/")))
(setq buffer-read-only t)
(setq truncate-lines t)
(when (boundp 'show-trailing-whitespace)
(setq show-trailing-whitespace nil))
-;;;(make-local-variable 'tab-width)
-;;;(setq tab-width 1)
+;;; (make-local-variable 'tab-width)
+;;; (setq tab-width 1)
(buffer-disable-undo (current-buffer))
(setq selective-display t
selective-display-ellipses nil)
@@ -1431,16 +1432,16 @@ This function is defined by `wl-summary-define-sort-command'." sort-by)
(setq fields (cdr fields)))
(setq candidates (elmo-uniq-list candidates))
(elmo-with-enable-multibyte
- (mapcar (function
- (lambda (x)
- (setq components (std11-extract-address-components x))
- (cons (nth 1 components)
- (and (car components)
- (eword-decode-string
- (decode-mime-charset-string
- (car components)
- mime-charset))))))
- candidates))))
+ (mapcar
+ (lambda (x)
+ (setq components (std11-extract-address-components x))
+ (cons (nth 1 components)
+ (and (car components)
+ (eword-decode-string
+ (decode-mime-charset-string
+ (car components)
+ mime-charset)))))
+ candidates))))
(defun wl-summary-edit-addresses-subr (the-email name-in-addr)
;; returns nil if there's no change.
@@ -1450,7 +1451,7 @@ This function is defined by `wl-summary-define-sort-command'." sort-by)
the-email)
(while (not (or (eq (setq char (read-char)) ?\r)
(eq char ?\n)
- (eq char ? )
+ (eq char (string-to-char " "))
(eq char ?e)
(eq char ?c)
(eq char ?d)))
@@ -1460,7 +1461,7 @@ This function is defined by `wl-summary-define-sort-command'." sort-by)
((or (eq char ?e)
(eq char ?\n)
(eq char ?\r)
- (eq char ? ))
+ (eq char (string-to-char " ")))
;; Change Addresses
(wl-address-add-or-change
the-email
@@ -1509,7 +1510,7 @@ Optional argument ADDR-STR is used as a target address if specified."
(completing-read
(format "Target address (%s): " address)
(mapcar
- (function (lambda (x) (cons (car x) (car x))))
+ (lambda (x) (cons (car x) (car x)))
candidates)
nil nil nil nil address))))
(when address
@@ -1527,7 +1528,7 @@ Optional argument ADDR-STR is used as a target address if specified."
(nth 0 address)
result)))
;;; i'd like to update summary-buffer, but...
-;;; (wl-summary-rescan)
+;;; (wl-summary-rescan)
(run-hooks 'wl-summary-edit-addresses-hook))))))
(defun wl-summary-incorporate (&optional arg)
@@ -1627,12 +1628,12 @@ If ARG is non-nil, checking is omitted."
(narrow-to-region
(save-excursion
(goto-char beg)
- (beginning-of-line)
- (point))
+ (point-at-bol))
(save-excursion
(goto-char end)
- (if (eq (current-column) 0) (beginning-of-line) (end-of-line))
- (point))))
+ (if (= (current-column) 0)
+ (point-at-bol)
+ (point-at-eol)))))
(defun wl-summary-prefetch-region-no-mark (beg end &optional prefetch-marks)
(interactive "r")
@@ -1962,8 +1963,8 @@ This function is defined for `window-scroll-functions'"
(error "(Internal error) Folder is not set:%s" (buffer-name
(current-buffer))))
;; Flush pending append operations (disconnected operation).
- ;;(setq seen-list
- ;;(wl-summary-flush-pending-append-operations seen-list))
+;;; (setq seen-list
+;;; (wl-summary-flush-pending-append-operations seen-list))
(goto-char (point-max))
(wl-folder-confirm-existence folder (elmo-folder-plugged-p folder))
(setq crossed (elmo-folder-synchronize folder
@@ -2127,7 +2128,7 @@ This function is defined for `window-scroll-functions'"
(when number
(let ((pos (point))
regexp)
- (setq regexp (concat "\r" (int-to-string number) "[^0-9]"))
+ (setq regexp (concat "\r" (number-to-string number) "[^0-9]"))
(if (and beg end (or (< pos beg) (< end pos)))
(progn
(goto-char beg)
@@ -2260,7 +2261,7 @@ If ARG, without confirm."
(wl-summary-sticky-buffer-name
(wl-summary-buffer-folder-name)))
;;; ???hang up
-;;; (rename-buffer (wl-summary-sticky-buffer-name
+;;; (rename-buffer (wl-summary-sticky-buffer-name
;;; (wl-summary-buffer-folder-name))))
(message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name)))))
@@ -2305,8 +2306,7 @@ If ARG, without confirm."
(set-buffer-modified-p nil)
(while copy-variables
(set (car copy-variables)
- (save-excursion
- (set-buffer cur-buf)
+ (with-current-buffer cur-buf
(symbol-value (car copy-variables))))
(setq copy-variables (cdr copy-variables)))
(switch-to-buffer buf)
@@ -2394,8 +2394,7 @@ If ARG, without confirm."
(setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder)
sticky))
(setq reuse-buf
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(string= (elmo-folder-name-internal folder)
(wl-summary-buffer-folder-name))))
(unwind-protect
@@ -2588,8 +2587,7 @@ If ARG, without confirm."
(if wl-use-highlight-mouse-line
;; remove 'mouse-face of current line.
(put-text-property
- (save-excursion (beginning-of-line)(point))
- (save-excursion (end-of-line)(point))
+ (point-at-bol) (point-at-eol)
'mouse-face nil))
(insert line "\n")
(save-excursion
@@ -2601,8 +2599,7 @@ If ARG, without confirm."
(if wl-use-highlight-mouse-line
;; remove 'mouse-face of current line.
(put-text-property
- (save-excursion (beginning-of-line)(point))
- (save-excursion (end-of-line)(point))
+ (point-at-bol) (point-at-eol)
'mouse-face nil))
(elmo-progress-notify 'wl-summary-insert-line)
(ignore-errors
@@ -2636,9 +2633,9 @@ If ARG, without confirm."
,alike
wl-summary-alike-hashtb))
-(defmacro wl-summary-get-alike ()
- `(elmo-get-hash-val (format "#%d" (wl-count-lines))
- wl-summary-alike-hashtb))
+(defsubst wl-summary-get-alike ()
+ (elmo-get-hash-val (format "#%d" (wl-count-lines))
+ wl-summary-alike-hashtb))
(defun wl-summary-insert-headers (folder func &optional mime-decode)
(let ((numbers (elmo-folder-list-messages folder 'visible t))
@@ -2681,10 +2678,9 @@ If ARG, without confirm."
(message "Creating subject cache...")
(wl-summary-insert-headers
folder
- (function
- (lambda (x)
- (funcall wl-summary-subject-filter-function
- (elmo-message-entity-field x 'subject)))))
+ (lambda (x)
+ (funcall wl-summary-subject-filter-function
+ (elmo-message-entity-field x 'subject))))
(message "Creating subject cache...done"))
(setq match (funcall wl-summary-subject-filter-function
(elmo-message-entity-field entity 'subject)))
@@ -3541,11 +3537,11 @@ Return non-nil if the mark is updated"
"")))
;;; For future use.
-;;(defun wl-summary-line-cached ()
-;; (if (elmo-message-cached-p wl-summary-buffer-elmo-folder
-;; (elmo-message-entity-number wl-message-entity))
-;; " "
-;; "u"))
+;;;(defun wl-summary-line-cached ()
+;;; (if (elmo-message-cached-p wl-summary-buffer-elmo-folder
+;;; (elmo-message-entity-number wl-message-entity))
+;;; " "
+;;; "u"))
(defun wl-summary-create-line (wl-message-entity
wl-parent-message-entity
@@ -3753,7 +3749,7 @@ Return non-nil if the mark is updated"
(setq range
(completing-read (format "Range (%s): " default)
(mapcar
- (function (lambda (x) (cons x x)))
+ (lambda (x) (cons x x))
input-range-list)))
(if (string= range "")
default
@@ -3993,8 +3989,7 @@ Return t if message exists."
(wl-draft-body-goto-top)
(wl-draft-enclose-digest-region (point) (point-max)))
(goto-char start-point)
- (save-excursion
- (set-buffer summary-buf)
+ (with-current-buffer summary-buf
(wl-summary-delete-all-target-marks)))
(run-hooks 'wl-mail-setup-hook)))
@@ -4022,8 +4017,7 @@ Return t if message exists."
(wl-draft-yank-original)
(setq mlist (cdr mlist)))
(goto-char start-point)
- (save-excursion
- (set-buffer summary-buf)
+ (with-current-buffer summary-buf
(wl-summary-delete-all-target-marks)))
(wl-draft-reply-position wl-draft-reply-default-position)
(run-hooks 'wl-mail-setup-hook))))
@@ -4769,6 +4763,81 @@ If ARG is numeric number, decode message as following:
(message "No message to display."))
number))
+(defun wl-summary-display-raw (&optional arg)
+ "Display current message in raw format."
+ (interactive)
+ (let ((number (wl-summary-message-number))
+ (folder wl-summary-buffer-elmo-folder))
+ (if number
+ (let ((raw (elmo-message-fetch-string
+ folder number
+ (elmo-find-fetch-strategy folder number)))
+ (raw-buffer (get-buffer-create "*wl:raw message*"))
+ (raw-mode-map (make-sparse-keymap)))
+ (with-current-buffer raw-buffer
+ (toggle-read-only -1)
+ (erase-buffer)
+ (princ raw raw-buffer)
+ (toggle-read-only t)
+ (goto-char (point-min))
+ (switch-to-buffer-other-window raw-buffer)
+ (define-key raw-mode-map "l" 'toggle-truncate-lines)
+ (define-key raw-mode-map "q" 'kill-buffer-and-window)
+ (define-key raw-mode-map "," 'kill-buffer-and-window)
+ (use-local-map raw-mode-map)))
+ (message "No message to display."))
+ number))
+
+(defun wl-summary-display-raw (&optional arg)
+ "Display current message in raw format."
+ (interactive)
+ (let ((number (wl-summary-message-number))
+ (folder wl-summary-buffer-elmo-folder))
+ (if number
+ (let ((raw (elmo-message-fetch-string
+ folder number
+ (elmo-find-fetch-strategy folder number)))
+ (raw-buffer (get-buffer-create "*wl:raw message*"))
+ (raw-mode-map (make-sparse-keymap)))
+ (with-current-buffer raw-buffer
+ (toggle-read-only -1)
+ (erase-buffer)
+ (princ raw raw-buffer)
+ (toggle-read-only t)
+ (goto-char (point-min))
+ (switch-to-buffer-other-window raw-buffer)
+ (define-key raw-mode-map "l" 'toggle-truncate-lines)
+ (define-key raw-mode-map "q" 'kill-buffer-and-window)
+ (define-key raw-mode-map "," 'kill-buffer-and-window)
+ (use-local-map raw-mode-map)))
+ (message "No message to display."))
+ number))
+
+(defun wl-summary-display-raw (&optional arg)
+ "Display current message in raw format."
+ (interactive)
+ (let ((number (wl-summary-message-number))
+ (folder wl-summary-buffer-elmo-folder))
+ (if number
+ (let ((raw (elmo-message-fetch-string
+ folder number
+ (elmo-find-fetch-strategy folder number)))
+ (raw-buffer (get-buffer-create "*wl:raw message*"))
+ (raw-mode-map (make-sparse-keymap)))
+ (with-current-buffer raw-buffer
+ (toggle-read-only -1)
+ (erase-buffer)
+ (princ raw raw-buffer)
+ (toggle-read-only t)
+ (goto-char (point-min))
+ (switch-to-buffer-other-window raw-buffer)
+ (define-key raw-mode-map "l" 'toggle-truncate-lines)
+ (define-key raw-mode-map "q" 'kill-buffer-and-window)
+ (define-key raw-mode-map "," 'kill-buffer-and-window)
+ (use-local-map raw-mode-map)))
+ (message "No message to display."))
+ number))
+
(defun wl-summary-save (&optional arg wl-save-dir)
"Save current message to disk."
(interactive)
@@ -4779,7 +4848,7 @@ If ARG is numeric number, decode message as following:
(if num
(save-excursion
(setq filename (expand-file-name
- (concat (int-to-string num)
+ (concat (number-to-string num)
wl-summary-save-file-suffix)
wl-save-dir))
(when (or (null arg)
@@ -5011,48 +5080,47 @@ If ARG is numeric number, decode message as following:
(as-binary-output-file
(write-region (point-min) (point-max)
filename nil 'no-msg))))
- (save-excursion
- (set-buffer summary-buf)
+ (with-current-buffer summary-buf
(wl-summary-delete-all-target-marks))
(if (file-exists-p filename)
(message "Saved as %s" filename)))
(kill-buffer tmp-buf)))))
-;; Someday
-;; (defun wl-summary-drop-unsync ()
-;; "Drop all unsync messages."
-;; (interactive)
-;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
-;; (error "You cannot drop unsync messages in this folder"))
-;; (if (or (not (interactive-p))
-;; (y-or-n-p "Drop all unsync messages? "))
-;; (let* ((folder-list (elmo-folder-get-primitive-folder-list
-;; (wl-summary-buffer-folder-name)))
-;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
-;; (sum 0)
-;; (multi-num 0)
-;; pair)
-;; (message "Dropping...")
-;; (while folder-list
-;; (setq pair (elmo-folder-message-numbers (car folder-list)))
-;; (when is-multi ;; dirty hack...
-;; (incf multi-num)
-;; (setcar pair (+ (* multi-num elmo-multi-divide-number)
-;; (car pair))))
-;; (elmo-msgdb-set-number-alist
-;; (wl-summary-buffer-msgdb)
-;; (nconc
-;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
-;; (list (cons (car pair) nil))))
-;; (setq sum (+ sum (cdr pair)))
-;; (setq folder-list (cdr folder-list)))
-;; (wl-summary-set-message-modified)
-;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
-;; (list 0
-;; (+ wl-summary-buffer-unread-count
-;; wl-summary-buffer-new-count)
-;; sum))
-;; (message "Dropping...done"))))
+;;; Someday
+;;;(defun wl-summary-drop-unsync ()
+;;; "Drop all unsync messages."
+;;; (interactive)
+;;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
+;;; (error "You cannot drop unsync messages in this folder"))
+;;; (if (or (not (interactive-p))
+;;; (y-or-n-p "Drop all unsync messages? "))
+;;; (let* ((folder-list (elmo-folder-get-primitive-folder-list
+;;; (wl-summary-buffer-folder-name)))
+;;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
+;;; (sum 0)
+;;; (multi-num 0)
+;;; pair)
+;;; (message "Dropping...")
+;;; (while folder-list
+;;; (setq pair (elmo-folder-message-numbers (car folder-list)))
+;;; (when is-multi ;; dirty hack...
+;;; (incf multi-num)
+;;; (setcar pair (+ (* multi-num elmo-multi-divide-number)
+;;; (car pair))))
+;;; (elmo-msgdb-set-number-alist
+;;; (wl-summary-buffer-msgdb)
+;;; (nconc
+;;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
+;;; (list (cons (car pair) nil))))
+;;; (setq sum (+ sum (cdr pair)))
+;;; (setq folder-list (cdr folder-list)))
+;;; (wl-summary-set-message-modified)
+;;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
+;;; (list 0
+;;; (+ wl-summary-buffer-unread-count
+;;; wl-summary-buffer-new-count)
+;;; sum))
+;;; (message "Dropping...done"))))
(defun wl-summary-previous-message-number (msg)
"Return a message number previous to the message specified by MSG."
@@ -5065,7 +5133,7 @@ If ARG is numeric number, decode message as following:
(defun wl-summary-next-message-number (msg)
"Return a message number next to the message specified by MSG."
- (cadr (memq msg wl-summary-buffer-number-list)))
+ (cadr (memq msg wl-summary-buffer-number-list)))
(defun wl-summary-default-get-next-msg (msg)
(or (wl-summary-next-message msg
Modified wl/wl-template.el
diff --git a/wl/wl-template.el b/wl/wl-template.el
index cac3404..a17c4a7 100644
--- a/wl/wl-template.el
+++ b/wl/wl-template.el
@@ -135,8 +135,7 @@ Entering WL-Template mode calls the value of `wl-template-mode-hook'."
(defun wl-template-show (&optional arg)
"Show reference INDEX in `wl-template-alist'.
ARG is ignored." ; ARG ignored this version (?)
- (save-excursion
- (set-buffer wl-template-buffer-name)
+ (with-current-buffer wl-template-buffer-name
(let ((buffer-read-only nil)
(wl-template-preview t)
(mail-header-separator "--header separater--"))
Modified wl/wl-thread.el
diff --git a/wl/wl-thread.el b/wl/wl-thread.el
index 82a0c83..7818c1d 100644
--- a/wl/wl-thread.el
+++ b/wl/wl-thread.el
@@ -488,9 +488,8 @@ ENTITY is returned."
(apply (function nconc)
update-msgs
(mapcar
- (function
- (lambda (message)
- (wl-thread-get-children-msgs message t)))
+ (lambda (message)
+ (wl-thread-get-children-msgs message t))
children))))
(wl-thread-entity-set-children
parent (append older-brothers children younger-brothers))
@@ -596,8 +595,8 @@ Message is inserted to the summary buffer."
(let ((parent (wl-thread-get-entity parent-msg))
child-entity invisible-top)
;;; Update the thread view...not implemented yet.
-;;; (when force-insert
-;;; (if parent
+;;; (when force-insert
+;;; (if parent
;;; (wl-thread-entity-force-open parent))
(when (and wl-summary-max-thread-depth parent)
(let ((cur parent)
@@ -630,8 +629,8 @@ Message is inserted to the summary buffer."
parent-msg))
(when parent
;; use thread structure.
- ;;(wl-thread-entity-get-nearly-older-brother
- ;; child-entity parent))) ; return value
+;;; (wl-thread-entity-get-nearly-older-brother
+;;; child-entity parent))) ; return value
(wl-thread-entity-get-number parent))) ; return value
;;; (setq beg (point))
;;; (wl-thread-goto-bottom-of-sub-thread)
@@ -640,19 +639,19 @@ Message is inserted to the summary buffer."
(wl-thread-update-children-number invisible-top)
nil))))
-;(defun wl-thread-get-parent-list (msgs)
-; ;; return ancestors
-; (let* ((msgs2 msgs)
-; myself)
-; (while msgs2
-; (setq myself (car msgs2)
-; msgs2 (cdr msgs2))
-; (while (not (eq myself (car msgs2)))
-; (if (wl-thread-descendant-p myself (car msgs2))
-; (setq msgs (delq (car msgs2) msgs)))
-; (setq msgs2 (or (cdr msgs2) msgs)))
-; (setq msgs2 (cdr msgs2)))
-; msgs))
+;;;(defun wl-thread-get-parent-list (msgs)
+;;; ;; return ancestors
+;;; (let* ((msgs2 msgs)
+;;; myself)
+;;; (while msgs2
+;;; (setq myself (car msgs2)
+;;; msgs2 (cdr msgs2))
+;;; (while (not (eq myself (car msgs2)))
+;;; (if (wl-thread-descendant-p myself (car msgs2))
+;;; (setq msgs (delq (car msgs2) msgs)))
+;;; (setq msgs2 (or (cdr msgs2) msgs)))
+;;; (setq msgs2 (cdr msgs2)))
+;;; msgs))
(defun wl-thread-get-parent-list (msgs)
;; return connected ancestors
@@ -787,7 +786,7 @@ Message is inserted to the summary buffer."
(setq message-entity
(elmo-message-entity wl-summary-buffer-elmo-folder
msg-num))
-;;; (wl-delete-all-overlays)
+;;; (wl-delete-all-overlays)
(when message-entity
(wl-summary-insert-line
(wl-summary-create-line
@@ -841,15 +840,15 @@ Message is inserted to the summary buffer."
(throw 'done t)))
nil)))
-;; (defun wl-thread-goto-bottom-of-sub-thread ()
-;; (interactive)
-;; (let ((depth (wl-thread-get-depth-of-current-line)))
-;; (forward-line 1)
-;; (while (and (not (eobp))
-;; (> (wl-thread-get-depth-of-current-line)
-;; depth))
-;; (forward-line 1))
-;; (beginning-of-line)))
+;;;(defun wl-thread-goto-bottom-of-sub-thread ()
+;;; (interactive)
+;;; (let ((depth (wl-thread-get-depth-of-current-line)))
+;;; (forward-line 1)
+;;; (while (and (not (eobp))
+;;; (> (wl-thread-get-depth-of-current-line)
+;;; depth))
+;;; (forward-line 1))
+;;; (beginning-of-line)))
(defun wl-thread-goto-bottom-of-sub-thread (&optional msg)
(interactive)
@@ -944,8 +943,7 @@ Message is inserted to the summary buffer."
(let (depth beg)
(wl-thread-entity-set-opened entity nil)
(setq depth (wl-thread-get-depth-of-current-line))
- (beginning-of-line)
- (setq beg (point))
+ (setq beg (point-at-bol))
(wl-thread-goto-bottom-of-sub-thread)
(wl-thread-remove-argument-region beg
(point))
@@ -971,11 +969,9 @@ Message is inserted to the summary buffer."
(defun wl-thread-open (entity)
(let (depth beg)
- (beginning-of-line)
- (setq beg (point))
+ (setq beg (point-at-bol))
(setq depth (wl-thread-get-depth-of-current-line))
- (end-of-line)
- (delete-region beg (point))
+ (delete-region (point-at-bol) (point-at-eol))
(wl-thread-entity-set-opened entity t)
(wl-thread-insert-entity depth ;(- depth 1)
entity
@@ -998,7 +994,7 @@ Message is inserted to the summary buffer."
(defun wl-thread-open-close (&optional force-open)
(interactive "P")
(when (eq wl-summary-buffer-view 'thread)
-;;; (if (equal wl-thread-top-entity '(nil t nil nil))
+;;; (if (equal wl-thread-top-entity '(nil t nil nil))
;;; (error "There's no thread structure"))
(save-excursion
(let ((inhibit-read-only t)
Modified wl/wl-util.el
diff --git a/wl/wl-util.el b/wl/wl-util.el
index 3fdf251..1613ea1 100644
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -118,7 +118,7 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
(string-to-char (format "%s" (this-command-keys))))))
(message "%s" mes-string)
(setq key (car (setq keve (wl-read-event-char))))
- (if (or (equal key ?\ )
+ (if (or (equal key (string-to-char " "))
(and cmd
(equal key cmd)))
(progn
@@ -131,14 +131,14 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
(or (string= name wl-draft-folder)
(string= name wl-queue-folder)))
-;(defalias 'wl-make-hash 'elmo-make-hash)
-;;(make-obsolete 'wl-make-hash 'elmo-make-hash)
+;;;(defalias 'wl-make-hash 'elmo-make-hash)
+;;;(make-obsolete 'wl-make-hash 'elmo-make-hash)
-;;(defalias 'wl-get-hash-val 'elmo-get-hash-val)
-;;(make-obsolete 'wl-get-hash-val 'elmo-get-hash-val)
+;;;(defalias 'wl-get-hash-val 'elmo-get-hash-val)
+;;;(make-obsolete 'wl-get-hash-val 'elmo-get-hash-val)
-;;(defalias 'wl-set-hash-val 'elmo-set-hash-val)
-;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
+;;;(defalias 'wl-set-hash-val 'elmo-set-hash-val)
+;;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
(defsubst wl-set-string-width (width string &optional padding ignore-invalid)
"Make a new string which have specified WIDTH and content of STRING.
@@ -163,7 +163,7 @@ even when invalid character is contained."
(abs width))))
(let ((paddings (make-string
(max 0 (- (abs width) (string-width string)))
- (or padding ?\ ))))
+ (or padding (string-to-char " ")))))
(if (< width 0)
(concat paddings string)
(concat string paddings)))))
@@ -180,7 +180,7 @@ even when invalid character is contained."
(if (= (current-column) (abs width))
string
(let ((paddings (make-string (- (abs width) (current-column))
- (or padding ?\ ))))
+ (or padding (string-to-char " ")))))
(if (< width 0)
(concat paddings string)
(concat string paddings))))))))
@@ -241,14 +241,14 @@ even when invalid character is contained."
(setq alist (cdr alist)))
value)))
-(defmacro wl-match-string (pos string)
+(defun wl-match-string (pos string)
"Substring POSth matched STRING."
- `(substring ,string (match-beginning ,pos) (match-end ,pos)))
+ (substring string (match-beginning pos) (match-end pos)))
-(defmacro wl-match-buffer (pos)
+(defun wl-match-buffer (pos)
"Substring POSth matched from the current buffer."
- `(buffer-substring-no-properties
- (match-beginning ,pos) (match-end ,pos)))
+ (buffer-substring-no-properties
+ (match-beginning pos) (match-end pos)))
(put 'wl-as-coding-system 'lisp-indent-function 1)
(put 'wl-as-mime-charset 'lisp-indent-function 1)
@@ -475,7 +475,7 @@ that `read' can handle, whenever this is possible."
(setq fld-name nil))
(if (eq (length (setq port
(elmo-match-string 2 url))) 0)
- (setq port (int-to-string elmo-nntp-default-port)))
+ (setq port (number-to-string elmo-nntp-default-port)))
(if (eq (length (setq server
(elmo-match-string 1 url))) 0)
(setq server elmo-nntp-default-server))
@@ -504,25 +504,24 @@ that `read' can handle, whenever this is possible."
wl-summary-buffer-display-mime-mode
nil nil))))))
-(defmacro wl-kill-buffers (regexp)
- `(mapcar (function
- (lambda (x)
- (if (and (buffer-name x)
- (string-match ,regexp (buffer-name x)))
- (and (get-buffer x)
- (kill-buffer x)))))
- (buffer-list)))
+(defun wl-kill-buffers (regexp)
+ (mapc
+ (lambda (x)
+ (if (and (buffer-name x)
+ (string-match regexp (buffer-name x)))
+ (and (get-buffer x)
+ (kill-buffer x))))
+ (buffer-list)))
(defun wl-collect-summary ()
(let (result)
- (mapcar
- (function (lambda (x)
- (if (and (string-match "^Summary"
- (buffer-name x))
- (save-excursion
- (set-buffer x)
- (equal major-mode 'wl-summary-mode)))
- (setq result (nconc result (list x))))))
+ (mapc
+ (lambda (x)
+ (if (and (string-match "^Summary"
+ (buffer-name x))
+ (with-current-buffer x
+ (eq major-mode 'wl-summary-mode)))
+ (setq result (nconc result (list x)))))
(buffer-list))
result))
@@ -654,10 +653,8 @@ that `read' can handle, whenever this is possible."
;;;
-(defmacro wl-count-lines ()
- '(save-excursion
- (beginning-of-line)
- (count-lines 1 (point))))
+(defsubst wl-count-lines ()
+ (count-lines 1 (point-at-bol)))
(defun wl-horizontal-recenter ()
"Recenter the current buffer horizontally."
@@ -1075,10 +1072,10 @@ is enclosed by at least one regexp grouping construct."
(let ((default (format-time-string "%Y-%m-%d")))
(setq value (completing-read
(format "Value for '%s' [%s]: " field default)
- (mapcar (function
- (lambda (x)
- (list (format "%s" (car x)))))
- elmo-date-descriptions)))
+ (mapcar
+ (lambda (x)
+ (list (format "%s" (car x))))
+ elmo-date-descriptions)))
(concat (downcase field) ":"
(if (equal value "") default value))))
((string-match "!?Flag" field)
@@ -1118,7 +1115,7 @@ is enclosed by at least one regexp grouping construct."
(cdr (wl-read-event-char prompt)))
((?y ?Y)
(throw 'done t))
- (?\
+ ((string-to-char " ")
(if scroll-by-SPC
(ignore-errors (scroll-up))
(throw 'done t)))
Modified wl/wl-xmas.el
diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el
index baa55e2..3e62300 100644
--- a/wl/wl-xmas.el
+++ b/wl/wl-xmas.el
@@ -538,7 +538,7 @@ Special commands:
(define-key wl-draft-mode-map "\C-c\C-e" 'wl-draft-config-exec)
(define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select)
(define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message)
-;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save)
+;;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save)
(define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr)
(define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)
(define-key wl-draft-mode-map "\C-c\C-d" 'wl-draft-elide-region)
@@ -548,7 +548,7 @@ Special commands:
(defun wl-draft-overload-functions ()
(wl-mode-line-buffer-identification)
- ;; (local-set-key "\C-c\C-s" 'wl-draft-send);; override
+;;; (local-set-key "\C-c\C-s" 'wl-draft-send) ; override
(wl-xmas-setup-draft-toolbar)
(wl-draft-overload-menubar))
Modified wl/wl.el
diff --git a/wl/wl.el b/wl/wl.el
index ccc8269..300e144 100644
--- a/wl/wl.el
+++ b/wl/wl.el
@@ -119,14 +119,14 @@
(if (and wl-draft-enable-queuing
wl-auto-flush-queue)
(wl-draft-queue-flush))
-;; (when (and (eq major-mode 'wl-summary-mode)
-;; (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
-;; (let* ((msgdb-dir (elmo-folder-msgdb-path
-;; wl-summary-buffer-elmo-folder))
-;; (seen-list (elmo-msgdb-seen-load msgdb-dir)))
-;; (setq seen-list
-;; (wl-summary-flush-pending-append-operations seen-list))
-;; (elmo-msgdb-seen-save msgdb-dir seen-list)))
+;;; (when (and (eq major-mode 'wl-summary-mode)
+;;; (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
+;;; (let* ((msgdb-dir (elmo-folder-msgdb-path
+;;; wl-summary-buffer-elmo-folder))
+;;; (seen-list (elmo-msgdb-seen-load msgdb-dir)))
+;;; (setq seen-list
+;;; (wl-summary-flush-pending-append-operations seen-list))
+;;; (elmo-msgdb-seen-save msgdb-dir seen-list)))
(run-hooks 'wl-plugged-hook))
(wl-biff-stop)
(run-hooks 'wl-unplugged-hook))
@@ -215,14 +215,15 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(setq buffer-read-only t)
(run-hooks 'wl-plugged-mode-hook))
-(defmacro wl-plugged-string (plugged &optional time)
- `(if ,time wl-plugged-auto-off
- (if ,plugged
- wl-plugged-plug-on
- wl-plugged-plug-off)))
+(defun wl-plugged-string (plugged &optional time)
+ (if time
+ wl-plugged-auto-off
+ (if plugged
+ wl-plugged-plug-on
+ wl-plugged-plug-off)))
-(defmacro wl-plugged-server-indent ()
- '(make-string wl-plugged-server-indent ? ))
+(defun wl-plugged-server-indent ()
+ (make-string wl-plugged-server-indent (string-to-char " ")))
(defun wl-plugged-set-variables ()
(setq wl-plugged-sending-queue-alist
@@ -231,8 +232,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(wl-plugged-dop-queue-info))
(setq wl-plugged-alist
(sort (copy-sequence elmo-plugged-alist)
- '(lambda (a b)
- (string< (caar a) (caar b))))))
+ (lambda (a b)
+ (string< (caar a) (caar b))))))
(defun wl-plugged-sending-queue-info ()
;; sending queue status
@@ -264,7 +265,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(if (> len 1)
(format ": %d msgs (" len)
(format ": %d msg (" len))
- (mapconcat (function int-to-string) (cdr qinfo) ",")
+ (mapconcat (function number-to-string) (cdr qinfo) ",")
")")))
(defun wl-plugged-dop-queue-info ()
@@ -273,11 +274,11 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(elmo-dop-queue (copy-sequence elmo-dop-queue))
dop-queue last alist server-info
ope operation)
- ;(elmo-dop-queue-load)
+;;; (elmo-dop-queue-load)
(elmo-dop-queue-merge)
- (setq dop-queue (sort elmo-dop-queue '(lambda (a b)
- (string< (elmo-dop-queue-fname a)
- (elmo-dop-queue-fname b)))))
+ (setq dop-queue (sort elmo-dop-queue (lambda (a b)
+ (string< (elmo-dop-queue-fname a)
+ (elmo-dop-queue-fname b)))))
(wl-append dop-queue (list nil)) ;; terminate(dummy)
(when (car dop-queue)
(setq last (elmo-dop-queue-fname (car dop-queue)))) ;; first
@@ -293,7 +294,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(if (and (car dop-queue)
(string= last (elmo-dop-queue-fname (car dop-queue))))
(wl-append operation (list ope))
- ;;(setq count (1+ count))
+;;; (setq count (1+ count))
(when (and last (setq server-info (elmo-net-port-info
(wl-folder-get-elmo-folder last))))
(setq alist
@@ -312,29 +313,29 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(let ((operations (cdr qinfo))
(column (or column wl-plugged-queue-status-column)))
(mapconcat
- '(lambda (folder-ope)
- (concat (wl-plugged-set-folder-icon
- (car folder-ope)
- (wl-folder-get-petname (car folder-ope)))
- "("
- (let ((opes (cdr folder-ope))
- pair shrinked)
- (while opes
- (if (setq pair (assoc (car (car opes)) shrinked))
- (setcdr pair (+ (cdr pair)
- (max (cdr (car opes)) 1)))
- (setq shrinked (cons
- (cons (car (car opes))
- (max (cdr (car opes)) 1))
- shrinked)))
- (setq opes (cdr opes)))
- (mapconcat
- '(lambda (ope)
- (if (> (cdr ope) 0)
- (format "%s:%d" (car ope) (cdr ope))
- (format "%s" (car ope))))
- (nreverse shrinked) ","))
- ")"))
+ (lambda (folder-ope)
+ (concat (wl-plugged-set-folder-icon
+ (car folder-ope)
+ (wl-folder-get-petname (car folder-ope)))
+ "("
+ (let ((opes (cdr folder-ope))
+ pair shrinked)
+ (while opes
+ (if (setq pair (assoc (car (car opes)) shrinked))
+ (setcdr pair (+ (cdr pair)
+ (max (cdr (car opes)) 1)))
+ (setq shrinked (cons
+ (cons (car (car opes))
+ (max (cdr (car opes)) 1))
+ shrinked)))
+ (setq opes (cdr opes)))
+ (mapconcat
+ (lambda (ope)
+ (if (> (cdr ope) 0)
+ (format "%s:%d" (car ope) (cdr ope))
+ (format "%s" (car ope))))
+ (nreverse shrinked) ","))
+ ")"))
operations
(concat "\n" (wl-set-string-width column "")))))
@@ -379,7 +380,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
;; port plug
(setq line
(format "%s[%s]%s"
- (make-string wl-plugged-port-indent ? )
+ (make-string wl-plugged-port-indent (string-to-char " "))
(wl-plugged-string plugged time)
(cond
((stringp port)
@@ -419,7 +420,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(defun wl-plugged-redrawing-switch (indent switch &optional time)
(beginning-of-line)
(when (re-search-forward
- (format "^%s\\[\\([^]]+\\)\\]" (make-string indent ? )))
+ (format "^%s\\[\\([^]]+\\)\\]"
+ (make-string indent (string-to-char " "))))
(goto-char (match-beginning 1))
(delete-region (match-beginning 1) (match-end 1))
(insert (wl-plugged-string switch time))
@@ -460,8 +462,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(/ (frame-height) 2)
(window-height)))
window-lines lines)
- (save-excursion
- (set-buffer (get-buffer-create wl-plugged-buf-name))
+ (with-current-buffer (get-buffer-create wl-plugged-buf-name)
(wl-plugged-mode)
(buffer-disable-undo (current-buffer))
(delete-windows-on (current-buffer))
@@ -505,7 +506,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(let (variable switch name)
(goto-char cur-point)
(when (and (not (bobp))
- (not (eq (char-before) ? )))
+ (not (eq (char-before) (string-to-char " "))))
(if (re-search-backward " [^ ]+" nil t)
(forward-char 1)
(re-search-backward "^[^ ]+" nil t)))
@@ -572,8 +573,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
(defun wl-plugged-exit ()
(interactive)
- (setq ;;elmo-plugged-alist wl-plugged-alist
- wl-plugged wl-plugged-switch
+ (setq wl-plugged wl-plugged-switch
+;;; elmo-plugged-alist wl-plugged-alist
wl-plugged-alist nil
wl-plugged-sending-queue-alist nil
wl-plugged-dop-queue-alist nil)
@@ -688,9 +689,9 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
"\\|")))
(when wl-delete-startup-frame-function
(funcall wl-delete-startup-frame-function))
-;; (if (and wl-folder-use-frame
-;; (> (length (visible-frame-list)) 1))
-;; (delete-frame))
+;;; (if (and wl-folder-use-frame
+;;; (> (length (visible-frame-list)) 1))
+;;; (delete-frame))
(setq wl-init nil)
(remove-hook 'kill-emacs-hook 'wl-save-status)
(elmo-passwd-alist-clear)
@@ -905,23 +906,21 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
;; Define some autoload functions WL might use.
(eval-and-compile
- ;; This little mapcar goes through the list below and marks the
+ ;; This little mapc goes through the list below and marks the
;; symbols in question as autoloaded functions.
- (mapcar
- (function
- (lambda (package)
- (let ((interactive (nth 1 (memq ':interactive package))))
- (mapcar
- (function
- (lambda (function)
- (let (keymap)
- (when (consp function)
- (setq keymap (car (memq 'keymap function)))
- (setq function (car function)))
- (autoload function (car package) nil interactive keymap))))
- (if (eq (nth 1 package) ':interactive)
- (cdddr package)
- (cdr package))))))
+ (mapc
+ (lambda (package)
+ (let ((interactive (nth 1 (memq ':interactive package))))
+ (mapc
+ (lambda (function)
+ (let (keymap)
+ (when (consp function)
+ (setq keymap (car (memq 'keymap function)))
+ (setq function (car function)))
+ (autoload function (car package) nil interactive keymap)))
+ (if (eq (nth 1 package) ':interactive)
+ (cdddr package)
+ (cdr package)))))
'(("wl-fldmgr" :interactive t
wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment