* test-dist.el (test-elmo-modules-trailing-whitespace)
[elisp/wanderlust.git] / elmo / elmo-util.el
index 87e9eaa..aff84f3 100644 (file)
@@ -29,7 +29,9 @@
 ;;; Code:
 ;;
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (require 'static))
 (require 'elmo-vars)
 (require 'elmo-date)
 (require 'mcharset)
 (fset 'elmo-base64-decode-string
       (mel-find-function 'mime-decode-string "base64"))
 
-(if elmo-use-hardlink
-    (defalias 'elmo-add-name-to-file 'add-name-to-file)
-  (defun elmo-add-name-to-file
-    (filename newname &optional ok-if-already-exists)
-    (copy-file filename newname ok-if-already-exists t)))
+(eval-and-compile
+  (if elmo-use-hardlink
+      (defalias 'elmo-add-name-to-file 'add-name-to-file)
+    (defun elmo-add-name-to-file
+      (filename newname &optional ok-if-already-exists)
+      (copy-file filename newname ok-if-already-exists t))))
 
 (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))
@@ -168,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
@@ -415,14 +417,14 @@ Return value is a cons cell of (STRUCTURE . REST)"
 (defsubst elmo-delete-char (char string &optional unibyte)
   (save-match-data
     (elmo-set-work-buf
-     (let ((coding-system-for-read 'no-conversion)
-          (coding-system-for-write 'no-conversion))
-       (if unibyte (set-buffer-multibyte nil))
-       (insert string)
-       (goto-char (point-min))
-       (while (search-forward (char-to-string char) nil t)
-        (replace-match ""))
-       (buffer-string)))))
+      (let ((coding-system-for-read 'no-conversion)
+           (coding-system-for-write 'no-conversion))
+       (if unibyte (set-buffer-multibyte nil))
+       (insert string)
+       (goto-char (point-min))
+       (while (search-forward (char-to-string char) nil t)
+         (replace-match ""))
+       (buffer-string)))))
 
 (defsubst elmo-delete-cr-buffer ()
   "Delete CR from buffer."
@@ -443,11 +445,11 @@ Return value is a cons cell of (STRUCTURE . REST)"
 (defun elmo-delete-cr (string)
   (save-match-data
     (elmo-set-work-buf
-     (insert string)
-     (goto-char (point-min))
-     (while (search-forward "\r\n" nil t)
-       (replace-match "\n"))
-     (buffer-string))))
+      (insert string)
+      (goto-char (point-min))
+      (while (search-forward "\r\n" nil t)
+       (replace-match "\n"))
+      (buffer-string))))
 
 (defun elmo-last (list)
   (and list (nth (1- (length list)) list)))
@@ -482,6 +484,10 @@ Return value is a cons cell of (STRUCTURE . REST)"
       (setq list (cdr list))))
   list)
 
+(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)))))
@@ -493,26 +499,26 @@ Return value is a cons cell of (STRUCTURE . REST)"
 
 (defun elmo-get-file-string (filename &optional remove-final-newline)
   (elmo-set-work-buf
-   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
-        insert-file-contents-post-hook)
-     (when (file-exists-p filename)
-       (if filename
-          (as-binary-input-file (insert-file-contents filename)))
-       (when (and remove-final-newline
-                 (> (buffer-size) 0)
-                 (= (char-after (1- (point-max))) ?\n))
-        (goto-char (point-max))
-        (delete-backward-char 1))
-       (buffer-string)))))
+    (let (insert-file-contents-pre-hook        ; To avoid autoconv-xmas...
+         insert-file-contents-post-hook)
+      (when (file-exists-p filename)
+       (if filename
+           (as-binary-input-file (insert-file-contents filename)))
+       (when (and remove-final-newline
+                  (> (buffer-size) 0)
+                  (= (char-after (1- (point-max))) ?\n))
+         (goto-char (point-max))
+         (delete-char -1))
+       (buffer-string)))))
 
 (defun elmo-save-string (string filename)
   (if string
       (elmo-set-work-buf
-       (as-binary-output-file
-       (insert string)
-       (write-region (point-min) (point-max)
-                     filename nil 'no-msg))
-       )))
+       (as-binary-output-file
+        (insert string)
+        (write-region (point-min) (point-max)
+                      filename nil 'no-msg))
+       )))
 
 (defun elmo-max-of-list (nlist)
   (let ((l nlist)
@@ -565,7 +571,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)
@@ -658,13 +664,13 @@ Return value is a cons cell of (STRUCTURE . REST)"
 
 (defun elmo-string-to-list (string)
   (elmo-set-work-buf
-   (insert string)
-   (goto-char (point-min))
-   (insert "(")
-   (goto-char (point-max))
-   (insert ")")
-   (goto-char (point-min))
-   (read (current-buffer))))
+    (insert string)
+    (goto-char (point-min))
+    (insert "(")
+    (goto-char (point-max))
+    (insert ")")
+    (goto-char (point-min))
+    (read (current-buffer))))
 
 (defun elmo-list-to-string (list)
   (let ((tlist list)
@@ -819,7 +825,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)))
@@ -1276,9 +1282,10 @@ MESSAGE is a doing part of progress message."
     (and (eq (car diff) 0)
         (< diff-time (nth 1 diff)))))
 
-(if (fboundp 'std11-fetch-field)
-    (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
-  (defalias 'elmo-field-body 'std11-field-body))
+(eval-and-compile
+  (if (fboundp 'std11-fetch-field)
+      (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
+    (defalias 'elmo-field-body 'std11-field-body)))
 
 (defun elmo-unfold-field-body (name)
   (let ((value (elmo-field-body name)))
@@ -1706,12 +1713,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)
@@ -2066,7 +2073,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))))
@@ -2104,12 +2111,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 "^[^\\.]"))
@@ -2117,7 +2124,7 @@ Optional argument DAYS specifies the days to expire caches."
        curtime)
     (if (string= age "")
        (setq age elmo-cache-expire-default-age)
-      (setq age (string-to-int age)))
+      (setq age (string-to-number age)))
     (setq curtime (current-time))
     (setq curtime (+ (* (nth 0 curtime)
                        (float 65536)) (nth 1 curtime)))
@@ -2219,13 +2226,13 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used."
       (save-match-data
        (let (beg)
          (elmo-set-work-buf
-          (insert string)
-          (goto-char (point-max))
-          (when (search-backward "<" nil t)
-            (setq beg (point))
-            (if (search-forward ">" nil t)
-                (elmo-replace-in-string
-                 (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
+           (insert string)
+           (goto-char (point-max))
+           (when (search-backward "<" nil t)
+             (setq beg (point))
+             (if (search-forward ">" nil t)
+                 (elmo-replace-in-string
+                  (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
 
 (defun elmo-msgdb-get-message-id-from-buffer ()
   (let ((msgid (elmo-field-body "message-id")))