elmo/elmo-util.el

   1 ;;; elmo-util.el --- Utilities for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31
  32 (eval-when-compile (require 'cl))
  33 (require 'elmo-vars)
  34 (require 'elmo-date)
  35 (require 'mcharset)
  36 (require 'pces)
  37 (require 'std11)
  38 (require 'eword-decode)
  39 (require 'utf7)
  40 (require 'poem)
  41
  42 (defmacro elmo-set-buffer-multibyte (flag)
  43   "Set the multibyte flag of the current buffer to FLAG."
  44   (cond ((boundp 'MULE)
  45          (list 'setq 'mc-flag flag))
  46         ((featurep 'xemacs)
  47          flag)
  48         ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
  49          (list 'set-buffer-multibyte flag))
  50         (t
  51          flag)))
  52
  53 (defvar elmo-work-buf-name " *elmo work*")
  54 (defvar elmo-temp-buf-name " *elmo temp*")
  55
  56 (or (boundp 'default-enable-multibyte-characters)
  57     (defvar default-enable-multibyte-characters (featurep 'mule)
  58       "The mock variable except for Emacs 20."))
  59
  60 (defun elmo-base64-encode-string (string &optional no-line-break))
  61 (defun elmo-base64-decode-string (string))
  62
  63 ;; base64 encoding/decoding
  64 (require 'mel)
  65 (fset 'elmo-base64-encode-string
  66       (mel-find-function 'mime-encode-string "base64"))
  67 (fset 'elmo-base64-decode-string
  68       (mel-find-function 'mime-decode-string "base64"))
  69
  70 ;; Any Emacsen may have add-name-to-file(), because loadup.el requires it. :-p
  71 ;; Check make-symbolic-link() instead.  -- 981002 by Fuji
  72 (if (fboundp 'make-symbolic-link)  ;; xxx
  73     (defalias 'elmo-add-name-to-file 'add-name-to-file)
  74   (defun elmo-add-name-to-file
  75     (filename newname &optional ok-if-already-exists)
  76     (copy-file filename newname ok-if-already-exists t)))
  77
  78 (defalias 'elmo-read 'read)
  79
  80 (defmacro elmo-set-work-buf (&rest body)
  81   "Execute BODY on work buffer.  Work buffer remains."
  82   (` (save-excursion
  83        (set-buffer (get-buffer-create elmo-work-buf-name))
  84        (elmo-set-buffer-multibyte default-enable-multibyte-characters)
  85        (erase-buffer)
  86        (,@ body))))
  87
  88 (defmacro elmo-bind-directory (dir &rest body)
  89   "Set current directory DIR and execute BODY."
  90   (` (let ((default-directory (file-name-as-directory (, dir))))
  91        (,@ body))))
  92
  93 (defun elmo-object-load (filename &optional mime-charset no-err)
  94   "Load OBJECT from the file specified by FILENAME.
  95 File content is decoded with MIME-CHARSET."
  96     (if (not (file-readable-p filename))
  97         nil
  98       (elmo-set-work-buf
  99        (as-binary-input-file
 100         (insert-file-contents filename))
 101        (when mime-charset
 102          (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 103          (decode-mime-charset-region (point-min) (point-max) mime-charset))
 104        (condition-case nil
 105            (read (current-buffer))
 106          (error (unless no-err
 107                   (message "Warning: Loading object from %s failed."
 108                            filename)
 109                   (elmo-object-save filename nil))
 110                 nil)))))
 111
 112 (defsubst elmo-save-buffer (filename &optional mime-charset)
 113   "Save current buffer to the file specified by FILENAME.
 114 Directory of the file is created if it doesn't exist.
 115 File content is encoded with MIME-CHARSET."
 116   (let ((dir (directory-file-name (file-name-directory filename))))
 117     (if (file-directory-p dir)
 118         () ; ok.
 119       (unless (file-exists-p dir)
 120         (elmo-make-directory dir)))
 121     (if (file-writable-p filename)
 122         (progn
 123           (when mime-charset
 124 ;;;         (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 125             (encode-mime-charset-region (point-min) (point-max) mime-charset))
 126           (as-binary-output-file
 127            (write-region (point-min) (point-max) filename nil 'no-msg)))
 128       (message "%s is not writable." filename))))
 129
 130 (defun elmo-object-save (filename object &optional mime-charset)
 131   "Save OBJECT to the file specified by FILENAME.
 132 Directory of the file is created if it doesn't exist.
 133 File content is encoded with MIME-CHARSET."
 134   (elmo-set-work-buf
 135    (prin1 object (current-buffer))
 136 ;;;(princ "\n" (current-buffer))
 137    (elmo-save-buffer filename mime-charset)))
 138
 139 ;;; Search Condition
 140
 141 (defconst elmo-condition-atom-regexp "[^/ \")|&]*")
 142
 143 (defun elmo-read-search-condition (default)
 144   "Read search condition string interactively."
 145   (elmo-read-search-condition-internal "Search by" default))
 146
 147 (defun elmo-read-search-condition-internal (prompt default)
 148   (let* ((completion-ignore-case t)
 149          (field (completing-read
 150                  (format "%s (%s): " prompt default)
 151                  (mapcar 'list
 152                          (append '("AND" "OR"
 153                                    "Last" "First"
 154                                    "From" "Subject" "To" "Cc" "Body"
 155                                    "Since" "Before" "ToCc"
 156                                    "!From" "!Subject" "!To" "!Cc" "!Body"
 157                                    "!Since" "!Before" "!ToCc")
 158                                  elmo-msgdb-extra-fields))))
 159          value)
 160     (setq field (if (string= field "")
 161                     (setq field default)
 162                   field))
 163     (cond
 164      ((or (string= field "AND") (string= field "OR"))
 165       (concat "("
 166               (elmo-read-search-condition-internal
 167                (concat field "(1) Search by") default)
 168               (if (string= field "AND") "&" "|")
 169               (elmo-read-search-condition-internal
 170                (concat field "(2) Search by") default)
 171               ")"))
 172      ((string-match "Since\\|Before" field)
 173       (let ((default (format-time-string "%Y-%m-%d")))
 174         (setq value (completing-read
 175                      (format "Value for '%s' [%s]: " field default)
 176                      (mapcar (function
 177                               (lambda (x)
 178                                 (list (format "%s" (car x)))))
 179                              elmo-date-descriptions)))
 180         (concat (downcase field) ":"
 181                 (if (equal value "") default value))))
 182      (t
 183       (setq value (read-from-minibuffer (format "Value for '%s': " field)))
 184       (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
 185                             value)
 186         (setq value (prin1-to-string value)))
 187       (concat (downcase field) ":" value)))))
 188
 189 (defsubst elmo-condition-parse-error ()
 190   (error "Syntax error in '%s'" (buffer-string)))
 191
 192 (defun elmo-parse-search-condition (condition)
 193   "Parse CONDITION.
 194 Return value is a cons cell of (STRUCTURE . REST)"
 195   (with-temp-buffer
 196     (insert condition)
 197     (goto-char (point-min))
 198     (cons (elmo-condition-parse) (buffer-substring (point) (point-max)))))
 199
 200 ;; condition    ::= or-expr
 201 (defun elmo-condition-parse ()
 202   (or (elmo-condition-parse-or-expr)
 203       (elmo-condition-parse-error)))
 204
 205 ;; or-expr      ::= and-expr /
 206 ;;                  and-expr "|" or-expr
 207 (defun elmo-condition-parse-or-expr ()
 208   (let ((left (elmo-condition-parse-and-expr)))
 209     (if (looking-at "| *")
 210         (progn
 211           (goto-char (match-end 0))
 212           (list 'or left (elmo-condition-parse-or-expr)))
 213       left)))
 214
 215 ;; and-expr     ::= primitive /
 216 ;;                  primitive "&" and-expr
 217 (defun elmo-condition-parse-and-expr ()
 218   (let ((left (elmo-condition-parse-primitive)))
 219     (if (looking-at "& *")
 220         (progn
 221           (goto-char (match-end 0))
 222           (list 'and left (elmo-condition-parse-and-expr)))
 223       left)))
 224
 225 ;; primitive    ::= "(" expr ")" /
 226 ;;                  ["!"] search-key SPACE* ":" SPACE* search-value
 227 (defun elmo-condition-parse-primitive ()
 228   (cond
 229    ((looking-at "( *")
 230     (goto-char (match-end 0))
 231     (prog1 (elmo-condition-parse)
 232       (unless (looking-at ") *")
 233         (elmo-condition-parse-error))
 234       (goto-char (match-end 0))))
 235 ;; search-key   ::= [A-Za-z-]+
 236 ;;                 ;; "since" / "before" / "last" / "first" /
 237 ;;                 ;; "body" / field-name
 238    ((looking-at "\\(!\\)? *\\([A-Za-z-]+\\) *: *")
 239     (goto-char (match-end 0))
 240     (let ((search-key (vector
 241                        (if (match-beginning 1) 'unmatch 'match)
 242                        (elmo-match-buffer 2)
 243                        (elmo-condition-parse-search-value))))
 244       ;; syntax sugar.
 245       (if (string= (aref search-key 1) "tocc")
 246           (if (eq (aref search-key 0) 'match)
 247               (list 'or
 248                     (vector 'match "to" (aref search-key 2))
 249                     (vector 'match "cc" (aref search-key 2)))
 250             (list 'and
 251                   (vector 'unmatch "to" (aref search-key 2))
 252                   (vector 'unmatch "cc" (aref search-key 2))))
 253         search-key)))))
 254
 255 ;; search-value ::= quoted / time / number / atom
 256 ;; quoted       ::= <elisp string expression>
 257 ;; time         ::= "yesterday" / "lastweek" / "lastmonth" / "lastyear" /
 258 ;;                   number SPACE* "daysago" /
 259 ;;                   number "-" month "-" number  ; ex. 10-May-2000
 260 ;;                   number "-" number "-" number  ; ex. 2000-05-10
 261 ;; number       ::= [0-9]+
 262 ;; month        ::= "Jan" / "Feb" / "Mar" / "Apr" / "May" / "Jun" /
 263 ;;                  "Jul" / "Aug" / "Sep" / "Oct" / "Nov" / "Dec"
 264 ;; atom         ::= ATOM_CHARS*
 265 ;; SPACE        ::= <ascii space character, 0x20>
 266 ;; ATOM_CHARS   ::= <any character except specials>
 267 ;; specials     ::= SPACE / <"> / </> / <)> / <|> / <&>
 268 ;;                  ;; These characters should be quoted.
 269 (defun elmo-condition-parse-search-value ()
 270   (cond
 271    ((looking-at "\"")
 272     (elmo-read (current-buffer)))
 273    ((or (looking-at "yesterday") (looking-at "lastweek")
 274         (looking-at "lastmonth") (looking-at "lastyear")
 275         (looking-at "[0-9]+ *daysago")
 276         (looking-at "[0-9]+-[A-Za-z]+-[0-9]+")
 277         (looking-at "[0-9]+-[0-9]+-[0-9]+")
 278         (looking-at "[0-9]+")
 279         (looking-at elmo-condition-atom-regexp))
 280     (prog1 (elmo-match-buffer 0)
 281       (goto-char (match-end 0))))
 282    (t (error "Syntax error '%s'" (buffer-string)))))
 283
 284 ;;;
 285 (defsubst elmo-buffer-replace (regexp &optional newtext)
 286   (goto-char (point-min))
 287   (while (re-search-forward regexp nil t)
 288     (replace-match (or newtext ""))))
 289
 290 (defsubst elmo-delete-char (char string &optional unibyte)
 291   (save-match-data
 292     (elmo-set-work-buf
 293      (let ((coding-system-for-read 'no-conversion)
 294            (coding-system-for-write 'no-conversion))
 295        (if unibyte (elmo-set-buffer-multibyte nil))
 296        (insert string)
 297        (goto-char (point-min))
 298        (while (search-forward (char-to-string char) nil t)
 299          (replace-match ""))
 300        (buffer-string)))))
 301
 302 (defsubst elmo-delete-cr-buffer ()
 303   "Delete CR from buffer."
 304   (save-excursion
 305     (goto-char (point-min))
 306     (while (search-forward "\r\n" nil t)
 307       (replace-match "\n")) ))
 308
 309 (defsubst elmo-delete-cr-get-content-type ()
 310   (save-excursion
 311     (goto-char (point-min))
 312     (while (search-forward "\r\n" nil t)
 313       (replace-match "\n"))
 314     (goto-char (point-min))
 315     (or (std11-field-body "content-type")
 316         t)))
 317
 318 (defun elmo-delete-cr (string)
 319   (save-match-data
 320     (elmo-set-work-buf
 321      (insert string)
 322      (goto-char (point-min))
 323      (while (search-forward "\r\n" nil t)
 324        (replace-match "\n"))
 325      (buffer-string))))
 326
 327 (defun elmo-uniq-list (lst)
 328   "Distractively uniqfy elements of LST."
 329   (let ((tmp lst))
 330     (while tmp (setq tmp
 331                      (setcdr tmp
 332                              (and (cdr tmp)
 333                                   (delete (car tmp)
 334                                           (cdr tmp)))))))
 335   lst)
 336
 337 (defun elmo-list-insert (list element after)
 338   "Insert an ELEMENT to the LIST, just after AFTER."
 339   (let ((li list)
 340         (curn 0)
 341         p pn)
 342     (while li
 343       (if (eq (car li) after)
 344           (setq p li pn curn li nil)
 345         (incf curn))
 346       (setq li (cdr li)))
 347     (if pn
 348         (setcdr (nthcdr pn list) (cons element (cdr p)))
 349       (nconc list (list element)))))
 350
 351 (defun elmo-string-partial-p (string)
 352   (and (stringp string) (string-match "message/partial" string)))
 353
 354 (defun elmo-get-file-string (filename &optional remove-final-newline)
 355   (elmo-set-work-buf
 356    (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 357          insert-file-contents-post-hook)
 358      (when (file-exists-p filename)
 359        (if filename
 360            (as-binary-input-file (insert-file-contents filename)))
 361        (when (and remove-final-newline
 362                   (> (buffer-size) 0)
 363                   (= (char-after (1- (point-max))) ?\n))
 364          (goto-char (point-max))
 365          (delete-backward-char 1))
 366        (buffer-string)))))
 367
 368 (defun elmo-save-string (string filename)
 369   (if string
 370       (elmo-set-work-buf
 371        (as-binary-output-file
 372         (insert string)
 373         (write-region (point-min) (point-max)
 374                       filename nil 'no-msg))
 375        )))
 376
 377 (defun elmo-max-of-list (nlist)
 378   (let ((l nlist)
 379         (max-num 0))
 380     (while l
 381       (if (< max-num (car l))
 382           (setq max-num (car l)))
 383       (setq l (cdr l)))
 384     max-num))
 385
 386 (defun elmo-concat-path (path filename)
 387   (if (not (string= path ""))
 388       (if (string= elmo-path-sep (substring path (- (length path) 1)))
 389           (concat path filename)
 390         (concat path elmo-path-sep filename))
 391     filename))
 392
 393 (defvar elmo-passwd-alist nil)
 394
 395 (defun elmo-passwd-alist-load ()
 396   (save-excursion
 397     (let ((filename (expand-file-name elmo-passwd-alist-file-name
 398                                       elmo-msgdb-directory))
 399           (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
 400           insert-file-contents-pre-hook ; To avoid autoconv-xmas...
 401           insert-file-contents-post-hook
 402           ret-val)
 403       (if (not (file-readable-p filename))
 404           ()
 405         (set-buffer tmp-buffer)
 406         (insert-file-contents filename)
 407         (setq ret-val
 408               (condition-case nil
 409                   (read (current-buffer))
 410                 (error nil nil))))
 411       (kill-buffer tmp-buffer)
 412       ret-val)))
 413
 414 (defun elmo-passwd-alist-clear ()
 415   "Clear password cache."
 416   (interactive)
 417   (setq elmo-passwd-alist nil))
 418
 419 (defun elmo-passwd-alist-save ()
 420   "Save password into file."
 421   (interactive)
 422   (save-excursion
 423     (let ((filename (expand-file-name elmo-passwd-alist-file-name
 424                                       elmo-msgdb-directory))
 425           (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*")))
 426       (set-buffer tmp-buffer)
 427       (erase-buffer)
 428       (prin1 elmo-passwd-alist tmp-buffer)
 429       (princ "\n" tmp-buffer)
 430 ;;;   (if (and (file-exists-p filename)
 431 ;;;            (not (equal 384 (file-modes filename))))
 432 ;;;       (error "%s is not safe.chmod 600 %s!" filename filename))
 433       (if (file-writable-p filename)
 434           (progn
 435             (write-region (point-min) (point-max)
 436                           filename nil 'no-msg)
 437             (set-file-modes filename 384))
 438         (message "%s is not writable." filename))
 439       (kill-buffer tmp-buffer))))
 440
 441 (defun elmo-get-passwd (key)
 442   "Get password from password pool."
 443   (let (pair pass)
 444     (if (not elmo-passwd-alist)
 445         (setq elmo-passwd-alist (elmo-passwd-alist-load)))
 446     (setq pair (assoc key elmo-passwd-alist))
 447     (if pair
 448         (elmo-base64-decode-string (cdr pair))
 449       (setq pass (elmo-read-passwd (format "Password for %s: "
 450                                            key) t))
 451       (setq elmo-passwd-alist
 452             (append elmo-passwd-alist
 453                     (list (cons key
 454                                 (elmo-base64-encode-string pass)))))
 455       (if elmo-passwd-life-time
 456           (run-with-timer elmo-passwd-life-time nil
 457                           (` (lambda () (elmo-remove-passwd (, key))))))
 458       pass)))
 459
 460 (defun elmo-remove-passwd (key)
 461   "Remove password from password pool (for failure)."
 462   (let (pass-cons)
 463     (if (setq pass-cons (assoc key elmo-passwd-alist))
 464         (progn
 465           (unwind-protect
 466               (fillarray (cdr pass-cons) 0))
 467           (setq elmo-passwd-alist
 468                 (delete pass-cons elmo-passwd-alist))))))
 469
 470 (defmacro elmo-read-char-exclusive ()
 471   (cond ((featurep 'xemacs)
 472          '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
 473                                (left . ?\C-h))))
 474                 event key)
 475             (while (not
 476                     (and
 477                      (key-press-event-p (setq event (next-command-event)))
 478                      (setq key (or (event-to-character event)
 479                                    (cdr (assq (event-key event) table)))))))
 480             key))
 481         ((fboundp 'read-char-exclusive)
 482          '(read-char-exclusive))
 483         (t
 484          '(read-char))))
 485
 486 (defun elmo-read-passwd (prompt &optional stars)
 487   "Read a single line of text from user without echoing, and return it."
 488   (let ((ans "")
 489         (c 0)
 490         (echo-keystrokes 0)
 491         (cursor-in-echo-area t)
 492         (log-message-max-size 0)
 493         message-log-max done msg truncate)
 494     (while (not done)
 495       (if (or (not stars) (string= "" ans))
 496           (setq msg prompt)
 497         (setq msg (concat prompt (make-string (length ans) ?.)))
 498         (setq truncate
 499               (1+ (- (length msg) (window-width (minibuffer-window)))))
 500         (and (> truncate 0)
 501              (setq msg (concat "$" (substring msg (1+ truncate))))))
 502       (message "%s" msg)
 503       (setq c (elmo-read-char-exclusive))
 504       (cond ((= c ?\C-g)
 505              (setq quit-flag t
 506                    done t))
 507             ((or (= c ?\r) (= c ?\n) (= c ?\e))
 508              (setq done t))
 509             ((= c ?\C-u)
 510              (setq ans ""))
 511             ((and (/= c ?\b) (/= c ?\177))
 512              (setq ans (concat ans (char-to-string c))))
 513             ((> (length ans) 0)
 514              (setq ans (substring ans 0 -1)))))
 515     (if quit-flag
 516         (prog1
 517             (setq quit-flag nil)
 518           (message "Quit")
 519           (beep t))
 520       (message "")
 521       ans)))
 522
 523 (defun elmo-string-to-list (string)
 524   (elmo-set-work-buf
 525    (insert string)
 526    (goto-char (point-min))
 527    (insert "(")
 528    (goto-char (point-max))
 529    (insert ")")
 530    (goto-char (point-min))
 531    (read (current-buffer))))
 532
 533 (defun elmo-list-to-string (list)
 534   (let ((tlist list)
 535         str)
 536     (if (listp tlist)
 537         (progn
 538           (setq str "(")
 539           (while (car tlist)
 540             (setq str
 541                   (concat str
 542                           (if (symbolp (car tlist))
 543                               (symbol-name (car tlist))
 544                             (car tlist))))
 545             (if (cdr tlist)
 546                 (setq str
 547                       (concat str " ")))
 548             (setq tlist (cdr tlist)))
 549           (setq str
 550                 (concat str ")")))
 551       (setq str
 552             (if (symbolp tlist)
 553                 (symbol-name tlist)
 554               tlist)))
 555     str))
 556
 557
 558 (defun elmo-plug-on-by-servers (alist &optional servers)
 559   (let ((server-list (or servers elmo-plug-on-servers)))
 560     (catch 'plugged
 561       (while server-list
 562         (if (elmo-plugged-p (car server-list))
 563             (throw 'plugged t))
 564         (setq server-list (cdr server-list))))))
 565
 566 (defun elmo-plug-on-by-exclude-servers (alist &optional servers)
 567   (let ((server-list (or servers elmo-plug-on-exclude-servers))
 568         server other-servers)
 569     (while alist
 570       (when (and (not (member (setq server (caaar alist)) server-list))
 571                  (not (member server other-servers)))
 572         (push server other-servers))
 573       (setq alist (cdr alist)))
 574     (elmo-plug-on-by-servers alist other-servers)))
 575
 576 (defun elmo-plugged-p (&optional server port stream-type alist label-exp)
 577   (let ((alist (or alist elmo-plugged-alist))
 578         plugged-info)
 579     (cond ((and (not port) (not server))
 580            (cond ((eq elmo-plugged-condition 'one)
 581                   (if alist
 582                       (catch 'plugged
 583                         (while alist
 584                           (if (nth 2 (car alist))
 585                               (throw 'plugged t))
 586                           (setq alist (cdr alist))))
 587                     elmo-plugged))
 588                  ((eq elmo-plugged-condition 'all)
 589                   (if alist
 590                       (catch 'plugged
 591                         (while alist
 592                           (if (not (nth 2 (car alist)))
 593                               (throw 'plugged nil))
 594                           (setq alist (cdr alist)))
 595                         t)
 596                     elmo-plugged))
 597                  ((functionp elmo-plugged-condition)
 598                   (funcall elmo-plugged-condition alist))
 599                  (t ;; independent
 600                   elmo-plugged)))
 601           ((not port) ;; server
 602            (catch 'plugged
 603              (while alist
 604                (when (string= server (caaar alist))
 605                  (if (nth 2 (car alist))
 606                      (throw 'plugged t)))
 607                (setq alist (cdr alist)))))
 608           (t
 609            (setq plugged-info (assoc (list server port stream-type) alist))
 610            (if (not plugged-info)
 611                ;; add elmo-plugged-alist automatically
 612                (progn
 613                  (elmo-set-plugged elmo-plugged server port stream-type
 614                                    nil nil nil label-exp)
 615                  elmo-plugged)
 616              (if (and elmo-auto-change-plugged
 617                       (> elmo-auto-change-plugged 0)
 618                       (nth 3 plugged-info)  ;; time
 619                       (elmo-time-expire (nth 3 plugged-info)
 620                                         elmo-auto-change-plugged))
 621                  t
 622                (nth 2 plugged-info)))))))
 623
 624 (defun elmo-set-plugged (plugged &optional server port stream-type time
 625                                  alist label-exp add)
 626   (let ((alist (or alist elmo-plugged-alist))
 627         label plugged-info)
 628     (cond ((and (not port) (not server))
 629            (setq elmo-plugged plugged)
 630            ;; set plugged all element of elmo-plugged-alist.
 631            (while alist
 632              (setcdr (cdar alist) (list plugged time))
 633              (setq alist (cdr alist))))
 634           ((not port)
 635            ;; set plugged all port of server
 636            (while alist
 637              (when (string= server (caaar alist))
 638                (setcdr (cdar alist) (list plugged time)))
 639              (setq alist (cdr alist))))
 640           (t
 641            ;; set plugged one port of server
 642            (setq plugged-info (assoc (list server port stream-type) alist))
 643            (setq label (if label-exp
 644                            (eval label-exp)
 645                          (nth 1 plugged-info)))
 646            (if plugged-info
 647                ;; if add is non-nil, don't reset plug state.
 648                (unless add
 649                  (setcdr plugged-info (list label plugged time)))
 650              (setq alist
 651                    (setq elmo-plugged-alist
 652                          (nconc
 653                           elmo-plugged-alist
 654                           (list
 655                            (list (list server port stream-type)
 656                                  label plugged time))))))))
 657     alist))
 658
 659 (defun elmo-delete-plugged (&optional server port alist)
 660   (let* ((alist (or alist elmo-plugged-alist))
 661          (alist2 alist))
 662     (cond ((and (not port) (not server))
 663            (setq alist nil))
 664           ((not port)
 665            ;; delete plugged all port of server
 666            (while alist2
 667              (when (string= server (caaar alist2))
 668                (setq alist (delete (car alist2) alist)))
 669              (setq alist2 (cdr alist2))))
 670           (t
 671            ;; delete plugged one port of server
 672            (setq alist
 673                  (delete (assoc (cons server port) alist) alist))))
 674     alist))
 675
 676 (defun elmo-disk-usage (path)
 677   "Get disk usage (bytes) in PATH."
 678   (let ((file-attr
 679          (condition-case () (file-attributes path) (error nil))))
 680     (if file-attr
 681         (if (nth 0 file-attr) ; directory
 682             (let ((files (condition-case ()
 683                              (directory-files path t "^[^\\.]")
 684                            (error nil)))
 685                   (result 0.0))
 686               ;; (result (nth 7 file-attr))) ... directory size
 687               (while files
 688                 (setq result (+ result (or (elmo-disk-usage (car files)) 0)))
 689                 (setq files (cdr files)))
 690               result)
 691           (float (nth 7 file-attr))))))
 692
 693 (defun elmo-get-last-accessed-time (path &optional dir)
 694   "Return the last accessed time of PATH."
 695   (let ((last-accessed (nth 4 (file-attributes (or (and dir
 696                                                         (expand-file-name
 697                                                          path dir))
 698                                                    path)))))
 699     (if last-accessed
 700         (setq last-accessed (+ (* (nth 0 last-accessed)
 701                                   (float 65536)) (nth 1 last-accessed)))
 702       0)))
 703
 704 (defun elmo-get-last-modification-time (path &optional dir)
 705   "Return the last accessed time of PATH."
 706   (let ((last-modified (nth 5 (file-attributes (or (and dir
 707                                                         (expand-file-name
 708                                                          path dir))
 709                                                    path)))))
 710     (setq last-modified (+ (* (nth 0 last-modified)
 711                               (float 65536)) (nth 1 last-modified)))))
 712
 713 (defun elmo-make-directory (path)
 714   "Create directory recursively."
 715   (let ((parent (directory-file-name (file-name-directory path))))
 716     (if (null (file-directory-p parent))
 717         (elmo-make-directory parent))
 718     (make-directory path)
 719     (if (string= path (expand-file-name elmo-msgdb-directory))
 720         (set-file-modes path (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
 721
 722 (defun elmo-delete-directory (path &optional no-hierarchy)
 723   "Delete directory recursively."
 724   (if (stringp path) ; nil is not permitted.
 725   (let ((dirent (directory-files path))
 726         relpath abspath hierarchy)
 727     (while dirent
 728       (setq relpath (car dirent)
 729             dirent (cdr dirent)
 730             abspath (expand-file-name relpath path))
 731       (when (not (string-match "^\\.\\.?$" relpath))
 732         (if (eq (nth 0 (file-attributes abspath)) t)
 733             (if no-hierarchy
 734                 (setq hierarchy t)
 735               (elmo-delete-directory abspath no-hierarchy))
 736           (delete-file abspath))))
 737     (unless hierarchy
 738       (delete-directory path)))))
 739
 740 (defun elmo-list-filter (l1 l2)
 741   "L1 is filter."
 742   (if (eq l1 t)
 743       ;; t means filter all.
 744       nil
 745     (if l1
 746         (elmo-delete-if (lambda (x) (not (memq x l1))) l2)
 747       ;; filter is nil
 748       l2)))
 749
 750 (defsubst elmo-list-delete-if-smaller (list number)
 751   (let ((ret-val (copy-sequence list)))
 752     (while list
 753       (if (< (car list) number)
 754           (setq ret-val (delq (car list) ret-val)))
 755       (setq list (cdr list)))
 756     ret-val))
 757
 758 (defun elmo-list-diff (list1 list2 &optional mes)
 759   (if mes
 760       (message mes))
 761   (let ((clist1 (copy-sequence list1))
 762         (clist2 (copy-sequence list2)))
 763     (while list2
 764       (setq clist1 (delq (car list2) clist1))
 765       (setq list2 (cdr list2)))
 766     (while list1
 767       (setq clist2 (delq (car list1) clist2))
 768       (setq list1 (cdr list1)))
 769     (if mes
 770         (message (concat mes "done.")))
 771     (list clist1 clist2)))
 772
 773 (defun elmo-list-bigger-diff (list1 list2 &optional mes)
 774   "Returns a list (- +). + is bigger than max of LIST1, in LIST2."
 775   (if (null list2)
 776       (cons list1  nil)
 777     (let* ((l1 list1)
 778            (l2 list2)
 779            (max-of-l2 (or (nth (max 0 (1- (length l2))) l2) 0))
 780            diff1 num i percent
 781            )
 782       (setq i 0)
 783       (setq num (+ (length l1)))
 784       (while l1
 785         (if (memq (car l1) l2)
 786             (if (eq (car l1) (car l2))
 787                 (setq l2 (cdr l2))
 788               (delq (car l1) l2))
 789           (if (> (car l1) max-of-l2)
 790               (setq diff1 (nconc diff1 (list (car l1))))))
 791         (if mes
 792             (progn
 793               (setq i (+ i 1))
 794               (setq percent (/ (* i 100) num))
 795               (if (eq (% percent 5) 0)
 796                   (elmo-display-progress
 797                    'elmo-list-bigger-diff "%s%d%%" percent mes))))
 798         (setq l1 (cdr l1)))
 799       (cons diff1 (list l2)))))
 800
 801 (defmacro elmo-filter-condition-p (filter)
 802   `(or (vectorp ,filter) (consp ,filter)))
 803
 804 (defmacro elmo-filter-type (filter)
 805   (` (aref (, filter) 0)))
 806
 807 (defmacro elmo-filter-key (filter)
 808   (` (aref (, filter) 1)))
 809
 810 (defmacro elmo-filter-value (filter)
 811   (` (aref (, filter) 2)))
 812
 813 (defsubst elmo-buffer-field-primitive-condition-match (condition
 814                                                        number
 815                                                        number-list)
 816   (let (result)
 817     (goto-char (point-min))
 818     (cond
 819      ((string= (elmo-filter-key condition) "last")
 820       (setq result (<= (length (memq number number-list))
 821                        (string-to-int (elmo-filter-value condition)))))
 822      ((string= (elmo-filter-key condition) "first")
 823       (setq result (< (- (length number-list)
 824                          (length (memq number number-list)))
 825                       (string-to-int (elmo-filter-value condition)))))
 826      ((string= (elmo-filter-key condition) "since")
 827       (let ((field-date (elmo-date-make-sortable-string
 828                          (timezone-fix-time
 829                           (std11-field-body "date")
 830                           (current-time-zone) nil)))
 831             (specified-date (elmo-date-make-sortable-string
 832                              (elmo-date-get-datevec
 833                               (elmo-filter-value condition)))))
 834         (setq result
 835               (or (string= field-date specified-date)
 836                   (string< specified-date field-date)))))
 837      ((string= (elmo-filter-key condition) "before")
 838       (setq result
 839             (string<
 840              (elmo-date-make-sortable-string
 841               (timezone-fix-time
 842                (std11-field-body "date")
 843                (current-time-zone) nil))
 844              (elmo-date-make-sortable-string
 845               (elmo-date-get-datevec
 846                (elmo-filter-value condition))))))
 847      ((string= (elmo-filter-key condition) "body")
 848       (and (re-search-forward "^$" nil t)          ; goto body
 849            (setq result (search-forward (elmo-filter-value condition)
 850                                         nil t))))
 851      (t
 852       (let ((fval (std11-field-body (elmo-filter-key condition))))
 853         (if (eq (length fval) 0) (setq fval nil))
 854         (if fval (setq fval (eword-decode-string fval)))
 855         (setq result (and fval (string-match
 856                                 (elmo-filter-value condition) fval))))))
 857     (if (eq (elmo-filter-type condition) 'unmatch)
 858         (setq result (not result)))
 859     result))
 860
 861 (defun elmo-condition-in-msgdb-p-internal (condition fields)
 862   (cond
 863    ((vectorp condition)
 864     (if (not (member (elmo-filter-key condition) fields))
 865         (throw 'found t)))
 866    ((or (eq (car condition) 'and)
 867         (eq (car condition) 'or))
 868     (elmo-condition-in-msgdb-p-internal (nth 1 condition) fields)
 869     (elmo-condition-in-msgdb-p-internal (nth 2 condition) fields))))
 870
 871 (defun elmo-condition-in-msgdb-p (condition)
 872   (not (catch 'found
 873          (elmo-condition-in-msgdb-p-internal condition
 874                                              (append
 875                                               elmo-msgdb-extra-fields
 876                                               '("last" "first" "from"
 877                                                 "subject" "to" "cc" "since"
 878                                                 "before"))))))
 879
 880 (defun elmo-buffer-field-condition-match (condition number number-list)
 881   (cond
 882    ((vectorp condition)
 883     (elmo-buffer-field-primitive-condition-match
 884      condition number number-list))
 885    ((eq (car condition) 'and)
 886     (and (elmo-buffer-field-condition-match
 887           (nth 1 condition) number number-list)
 888          (elmo-buffer-field-condition-match
 889           (nth 2 condition) number number-list)))
 890    ((eq (car condition) 'or)
 891     (or (elmo-buffer-field-condition-match
 892          (nth 1 condition) number number-list)
 893         (elmo-buffer-field-condition-match
 894          (nth 2 condition) number number-list)))))
 895
 896 (defsubst elmo-file-field-primitive-condition-match (file
 897                                                      condition
 898                                                      number
 899                                                      number-list)
 900   (let (result)
 901     (goto-char (point-min))
 902     (cond
 903      ((string= (elmo-filter-key condition) "last")
 904       (setq result (<= (length (memq number number-list))
 905                        (string-to-int (elmo-filter-value condition))))
 906       (if (eq (elmo-filter-type condition) 'unmatch)
 907           (setq result (not result))))
 908      ((string= (elmo-filter-key condition) "first")
 909       (setq result (< (- (length number-list)
 910                          (length (memq number number-list)))
 911                       (string-to-int (elmo-filter-value condition))))
 912       (if (eq (elmo-filter-type condition) 'unmatch)
 913           (setq result (not result))))
 914      (t
 915       (elmo-set-work-buf
 916        (as-binary-input-file (insert-file-contents file))
 917        (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 918        ;; Should consider charset?
 919        (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
 920        (setq result
 921              (elmo-buffer-field-primitive-condition-match
 922               condition number number-list)))))
 923     result))
 924
 925 (defun elmo-file-field-condition-match (file condition number number-list)
 926   (cond
 927    ((vectorp condition)
 928     (elmo-file-field-primitive-condition-match
 929      file condition number number-list))
 930    ((eq (car condition) 'and)
 931     (and (elmo-file-field-condition-match
 932           file (nth 1 condition) number number-list)
 933          (elmo-file-field-condition-match
 934           file (nth 2 condition) number number-list)))
 935    ((eq (car condition) 'or)
 936     (or (elmo-file-field-condition-match
 937          file (nth 1 condition) number number-list)
 938         (elmo-file-field-condition-match
 939          file (nth 2 condition) number number-list)))))
 940
 941 (defmacro elmo-get-hash-val (string hashtable)
 942   (let ((sym (list 'intern-soft string hashtable)))
 943     (list 'if (list 'boundp sym)
 944        (list 'symbol-value sym))))
 945
 946 (defmacro elmo-set-hash-val (string value hashtable)
 947   (list 'set (list 'intern string hashtable) value))
 948
 949 (defmacro elmo-clear-hash-val (string hashtable)
 950   (static-if (fboundp 'unintern)
 951       (list 'unintern string hashtable)
 952     (list 'makunbound (list 'intern string hashtable))))
 953
 954 (defmacro elmo-unintern (string)
 955   "`unintern' symbol named STRING,  When can use `unintern'.
 956 Emacs 19.28 or earlier does not have `unintern'."
 957   (static-if (fboundp 'unintern)
 958       (list 'unintern string)))
 959
 960 (defun elmo-make-hash (&optional hashsize)
 961   "Make a new hash table which have HASHSIZE size."
 962   (make-vector
 963    (if hashsize
 964        (max
 965         ;; Prime numbers as lengths tend to result in good
 966         ;; hashing; lengths one less than a power of two are
 967         ;; also good.
 968         (min
 969          (let ((i 1))
 970            (while (< (- i 1) hashsize)
 971              (setq i (* 2 i)))
 972            (- i 1))
 973          elmo-hash-maximum-size)
 974         elmo-hash-minimum-size)
 975      elmo-hash-minimum-size)
 976    0))
 977
 978 (defsubst elmo-mime-string (string)
 979   "Normalize MIME encoded STRING."
 980     (and string
 981          (let (str)
 982            (elmo-set-work-buf
 983             (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 984             (setq str (eword-decode-string
 985                        (decode-mime-charset-string string elmo-mime-charset)))
 986             (setq str (encode-mime-charset-string str elmo-mime-charset))
 987             (elmo-set-buffer-multibyte nil)
 988             str))))
 989
 990 (defsubst elmo-collect-field (beg end downcase-field-name)
 991   (save-excursion
 992     (save-restriction
 993       (narrow-to-region beg end)
 994       (goto-char (point-min))
 995       (let ((regexp (concat "\\(" std11-field-head-regexp "\\)[ \t]*"))
 996             dest name body)
 997         (while (re-search-forward regexp nil t)
 998           (setq name (buffer-substring-no-properties
 999                       (match-beginning 1)(1- (match-end 1))))
1000           (if downcase-field-name
1001               (setq name (downcase name)))
1002           (setq body (buffer-substring-no-properties
1003                       (match-end 0) (std11-field-end)))
1004           (or (assoc name dest)
1005               (setq dest (cons (cons name body) dest))))
1006         dest))))
1007
1008 (defsubst elmo-collect-field-from-string (string downcase-field-name)
1009   (with-temp-buffer
1010     (insert string)
1011     (goto-char (point-min))
1012     (let ((regexp (concat "\\(" std11-field-head-regexp "\\)[ \t]*"))
1013           dest name body)
1014       (while (re-search-forward regexp nil t)
1015         (setq name (buffer-substring-no-properties
1016                     (match-beginning 1)(1- (match-end 1))))
1017         (if downcase-field-name
1018             (setq name (downcase name)))
1019         (setq body (buffer-substring-no-properties
1020                     (match-end 0) (std11-field-end)))
1021         (or (assoc name dest)
1022             (setq dest (cons (cons name body) dest))))
1023       dest)))
1024
1025 (defun elmo-safe-filename (folder)
1026   (elmo-replace-in-string
1027    (elmo-replace-in-string
1028     (elmo-replace-in-string folder "/" " ")
1029     ":" "__")
1030    "|" "_or_"))
1031
1032 (defvar elmo-filename-replace-chars nil)
1033
1034 (defsubst elmo-replace-string-as-filename (msgid)
1035   "Replace string as filename."
1036   (setq msgid (elmo-replace-in-string msgid " " "  "))
1037   (if (null elmo-filename-replace-chars)
1038       (setq elmo-filename-replace-chars
1039             (regexp-quote (mapconcat
1040                            'car elmo-filename-replace-string-alist ""))))
1041   (while (string-match (concat "[" elmo-filename-replace-chars "]")
1042                        msgid)
1043     (setq msgid (concat
1044                  (substring msgid 0 (match-beginning 0))
1045                  (cdr (assoc
1046                        (substring msgid
1047                                   (match-beginning 0) (match-end 0))
1048                        elmo-filename-replace-string-alist))
1049                  (substring msgid (match-end 0)))))
1050   msgid)
1051
1052 (defsubst elmo-recover-string-from-filename (filename)
1053   "Recover string from FILENAME."
1054   (let (tmp result)
1055     (while (string-match " " filename)
1056       (setq tmp (substring filename
1057                            (match-beginning 0)
1058                            (+ (match-end 0) 1)))
1059       (if (string= tmp "  ")
1060           (setq tmp " ")
1061         (setq tmp (car (rassoc tmp
1062                                elmo-filename-replace-string-alist))))
1063       (setq result
1064             (concat result
1065                     (substring filename 0 (match-beginning 0))
1066                     tmp))
1067       (setq filename (substring filename (+ (match-end 0) 1))))
1068     (concat result filename)))
1069
1070 (defsubst elmo-copy-file (src dst &optional ok-if-already-exists)
1071   (condition-case err
1072       (elmo-add-name-to-file src dst ok-if-already-exists)
1073     (error (copy-file src dst ok-if-already-exists t))))
1074
1075 (defsubst elmo-buffer-exists-p (buffer)
1076   (if (bufferp buffer)
1077       (buffer-live-p buffer)
1078     (get-buffer buffer)))
1079
1080 (defsubst elmo-kill-buffer (buffer)
1081   (when (elmo-buffer-exists-p buffer)
1082     (kill-buffer buffer)))
1083
1084 (defun elmo-delete-if (pred lst)
1085   "Return new list contain items which don't satisfy PRED in LST."
1086   (let (result)
1087     (while lst
1088       (unless (funcall pred (car lst))
1089         (setq result (nconc result (list (car lst)))))
1090       (setq lst (cdr lst)))
1091     result))
1092
1093 (defun elmo-list-delete (list1 list2)
1094   "Delete by side effect any occurrences equal to elements of LIST1 from LIST2.
1095 Return the modified LIST2.  Deletion is done with `delete'.
1096 Write `(setq foo (elmo-list-delete bar foo))' to be sure of changing
1097 the value of `foo'."
1098   (while list1
1099     (setq list2 (delete (car list1) list2))
1100     (setq list1 (cdr list1)))
1101   list2)
1102
1103 (defun elmo-list-member (list1 list2)
1104   "If any element of LIST1 is member of LIST2, return t."
1105   (catch 'done
1106     (while list1
1107       (if (member (car list1) list2)
1108           (throw 'done t))
1109       (setq list1 (cdr list1)))))
1110
1111 (defun elmo-count-matches (regexp beg end)
1112   (let ((count 0))
1113     (save-excursion
1114       (goto-char beg)
1115       (while (re-search-forward regexp end t)
1116         (setq count (1+ count)))
1117       count)))
1118
1119 (if (fboundp 'display-error)
1120     (defalias 'elmo-display-error 'display-error)
1121   (defun elmo-display-error (error-object stream)
1122     "A tiny function to display ERROR-OBJECT to the STREAM."
1123     (let ((first t)
1124           (errobj error-object)
1125           err-mes)
1126       (while errobj
1127         (setq err-mes (concat err-mes (format
1128                                        (if (stringp (car errobj))
1129                                            "%s"
1130                                          "%S")
1131                                        (car errobj))))
1132         (setq errobj (cdr errobj))
1133         (if errobj (setq err-mes (concat err-mes (if first ": " ", "))))
1134         (setq first nil))
1135       (princ err-mes stream))))
1136
1137 (if (fboundp 'define-error)
1138     (defalias 'elmo-define-error 'define-error)
1139   (defun elmo-define-error (error doc &optional parents)
1140     (or parents
1141         (setq parents 'error))
1142     (let ((conds (get parents 'error-conditions)))
1143       (or conds
1144           (error "Not an error symbol: %s" error))
1145       (setplist error
1146                 (list 'error-message doc
1147                       'error-conditions (cons error conds))))))
1148
1149 (cond ((fboundp 'progress-feedback-with-label)
1150        (defalias 'elmo-display-progress 'progress-feedback-with-label))
1151       ((fboundp 'lprogress-display)
1152        (defalias 'elmo-display-progress 'lprogress-display))
1153       (t
1154        (defun elmo-display-progress (label format &optional value &rest args)
1155          "Print a progress message."
1156          (if (and (null format) (null args))
1157              (message nil)
1158            (apply (function message) (concat format " %d%%")
1159                   (nconc args (list value)))))))
1160
1161 (defvar elmo-progress-counter-alist nil)
1162
1163 (defmacro elmo-progress-counter-value (counter)
1164   (` (aref (cdr (, counter)) 0)))
1165
1166 (defmacro elmo-progress-counter-all-value (counter)
1167   (` (aref (cdr (, counter)) 1)))
1168
1169 (defmacro elmo-progress-counter-format (counter)
1170   (` (aref (cdr (, counter)) 2)))
1171
1172 (defmacro elmo-progress-counter-set-value (counter value)
1173   (` (aset (cdr (, counter)) 0 (, value))))
1174
1175 (defun elmo-progress-set (label all-value &optional format)
1176   (unless (assq label elmo-progress-counter-alist)
1177     (setq elmo-progress-counter-alist
1178           (cons (cons label (vector 0 all-value (or format "")))
1179                 elmo-progress-counter-alist))))
1180
1181 (defun elmo-progress-clear (label)
1182   (let ((counter (assq label elmo-progress-counter-alist)))
1183     (when counter
1184       (elmo-display-progress label
1185                              (elmo-progress-counter-format counter)
1186                              100)
1187       (setq elmo-progress-counter-alist
1188             (delq counter elmo-progress-counter-alist)))))
1189
1190 (defun elmo-progress-notify (label &optional value op &rest args)
1191   (let ((counter (assq label elmo-progress-counter-alist)))
1192     (when counter
1193       (let* ((value (or value 1))
1194              (cur-value (elmo-progress-counter-value counter))
1195              (all-value (elmo-progress-counter-all-value counter))
1196              (new-value (if (eq op 'set) value (+ cur-value value)))
1197              (cur-rate (/ (* cur-value 100) all-value))
1198              (new-rate (/ (* new-value 100) all-value)))
1199         (elmo-progress-counter-set-value counter new-value)
1200         (unless (= cur-rate new-rate)
1201           (apply 'elmo-display-progress
1202                  label
1203                  (elmo-progress-counter-format counter)
1204                  new-rate
1205                  args))
1206         (when (>= new-rate 100)
1207           (elmo-progress-clear label))))))
1208
1209 (defun elmo-time-expire (before-time diff-time)
1210   (let* ((current (current-time))
1211          (rest (when (< (nth 1 current) (nth 1 before-time))
1212                  (expt 2 16)))
1213          diff)
1214     (setq diff
1215           (list (- (+ (car current) (if rest -1 0)) (car before-time))
1216                 (- (+ (or rest 0) (nth 1 current)) (nth 1 before-time))))
1217     (and (eq (car diff) 0)
1218          (< diff-time (nth 1 diff)))))
1219
1220 (if (fboundp 'std11-fetch-field)
1221     (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
1222   (defalias 'elmo-field-body 'std11-field-body))
1223
1224 (defun elmo-address-quote-specials (word)
1225   "Make quoted string of WORD if needed."
1226   (let ((lal (std11-lexical-analyze word)))
1227     (if (or (assq 'specials lal)
1228             (assq 'domain-literal lal))
1229         (prin1-to-string word)
1230       word)))
1231
1232 (defmacro elmo-string (string)
1233   "STRING without text property."
1234   (` (let ((obj (copy-sequence (, string))))
1235        (and obj (set-text-properties 0 (length obj) nil obj))
1236        obj)))
1237
1238 (defun elmo-flatten (list-of-list)
1239   "Flatten LIST-OF-LIST."
1240   (unless (null list-of-list)
1241     (append (if (and (car list-of-list)
1242                      (listp (car list-of-list)))
1243                 (car list-of-list)
1244               (list (car list-of-list)))
1245             (elmo-flatten (cdr list-of-list)))))
1246
1247 (defun elmo-y-or-n-p (prompt &optional auto default)
1248   "Same as `y-or-n-p'.
1249 But if optional argument AUTO is non-nil, DEFAULT is returned."
1250   (if auto
1251       default
1252     (y-or-n-p prompt)))
1253
1254 (defun elmo-string-member (string slist)
1255   "Return t if STRING is a member of the SLIST."
1256   (catch 'found
1257     (while slist
1258       (if (and (stringp (car slist))
1259                (string= string (car slist)))
1260           (throw 'found t))
1261       (setq slist (cdr slist)))))
1262
1263 (defun elmo-string-match-member (str list &optional case-ignore)
1264   (let ((case-fold-search case-ignore))
1265     (catch 'member
1266       (while list
1267         (if (string-match (car list) str)
1268             (throw 'member (car list)))
1269         (setq list (cdr list))))))
1270
1271 (defun elmo-string-matched-member (str list &optional case-ignore)
1272   (let ((case-fold-search case-ignore))
1273     (catch 'member
1274       (while list
1275         (if (string-match str (car list))
1276             (throw 'member (car list)))
1277         (setq list (cdr list))))))
1278
1279 (defsubst elmo-string-delete-match (string pos)
1280   (concat (substring string
1281                      0 (match-beginning pos))
1282           (substring string
1283                      (match-end pos)
1284                      (length string))))
1285
1286 (defun elmo-string-match-assoc (key alist &optional case-ignore)
1287   (let ((case-fold-search case-ignore)
1288         a)
1289     (catch 'loop
1290       (while alist
1291         (setq a (car alist))
1292         (if (and (consp a)
1293                  (stringp (car a))
1294                  (string-match key (car a)))
1295             (throw 'loop a))
1296         (setq alist (cdr alist))))))
1297
1298 (defun elmo-string-matched-assoc (key alist &optional case-ignore)
1299   (let ((case-fold-search case-ignore)
1300         a)
1301     (catch 'loop
1302       (while alist
1303         (setq a (car alist))
1304         (if (and (consp a)
1305                  (stringp (car a))
1306                  (string-match (car a) key))
1307             (throw 'loop a))
1308         (setq alist (cdr alist))))))
1309
1310 (defun elmo-string-assoc (key alist)
1311   (let (a)
1312     (catch 'loop
1313       (while alist
1314         (setq a (car alist))
1315         (if (and (consp a)
1316                  (stringp (car a))
1317                  (string= key (car a)))
1318             (throw 'loop a))
1319         (setq alist (cdr alist))))))
1320
1321 (defun elmo-string-assoc-all (key alist)
1322   (let (matches)
1323     (while alist
1324       (if (string= key (car (car alist)))
1325           (setq matches
1326                 (cons (car alist)
1327                       matches)))
1328       (setq alist (cdr alist)))
1329     matches))
1330
1331 (defun elmo-string-rassoc (key alist)
1332   (let (a)
1333     (catch 'loop
1334       (while alist
1335         (setq a (car alist))
1336         (if (and (consp a)
1337                  (stringp (cdr a))
1338                  (string= key (cdr a)))
1339             (throw 'loop a))
1340         (setq alist (cdr alist))))))
1341
1342 (defun elmo-string-rassoc-all (key alist)
1343   (let (matches)
1344     (while alist
1345       (if (string= key (cdr (car alist)))
1346           (setq matches
1347                 (cons (car alist)
1348                       matches)))
1349       (setq alist (cdr alist)))
1350     matches))
1351
1352 ;;; Folder parser utils.
1353 (defun elmo-parse-token (string &optional seps)
1354   "Parse atom from STRING using SEPS as a string of separator char list."
1355   (let ((len (length string))
1356         (seps (and seps (string-to-char-list seps)))
1357         (i 0)
1358         (sep nil)
1359         content c in)
1360     (if (eq len 0)
1361         (cons "" "")
1362       (while (and (< i len) (or in (null sep)))
1363         (setq c (aref string i))
1364         (cond
1365          ((and in (eq c ?\\))
1366           (setq i (1+ i)
1367                 content (cons (aref string i) content)
1368                 i (1+ i)))
1369          ((eq c ?\")
1370           (setq in (not in)
1371                 i (1+ i)))
1372          (in (setq content (cons c content)
1373                    i (1+ i)))
1374          ((memq c seps)
1375           (setq sep c))
1376          (t (setq content (cons c content)
1377                   i (1+ i)))))
1378       (if in (error "Parse error in quoted"))
1379       (cons (if (null content) "" (char-list-to-string (nreverse content)))
1380             (substring string i)))))
1381
1382 (defun elmo-parse-prefixed-element (prefix string &optional seps)
1383   (if (and (not (eq (length string) 0))
1384            (eq (aref string 0) prefix))
1385       (elmo-parse-token (substring string 1) seps)
1386     (cons "" string)))
1387
1388 ;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
1389 ;;
1390 ;; number          ::= [0-9]+
1391 ;; beg             ::= number
1392 ;; end             ::= number
1393 ;; number-range    ::= "(" beg " . " end ")"      ;; cons cell
1394 ;; number-set-elem ::= number / number-range
1395 ;; number-set      ::= "(" *number-set-elem ")"   ;; list
1396
1397 (defun elmo-number-set-member (number number-set)
1398   "Return non-nil if NUMBER is an element of NUMBER-SET.
1399 The value is actually the tail of NUMBER-RANGE whose car contains NUMBER."
1400   (or (memq number number-set)
1401       (let (found)
1402         (while (and number-set (not found))
1403           (if (and (consp (car number-set))
1404                    (and (<= (car (car number-set)) number)
1405                         (<= number (cdr (car number-set)))))
1406               (setq found t)
1407             (setq number-set (cdr number-set))))
1408         number-set)))
1409
1410 (defun elmo-number-set-append-list (number-set list)
1411   "Append LIST of numbers to the NUMBER-SET.
1412 NUMBER-SET is altered."
1413   (let ((appended number-set))
1414     (while list
1415       (setq appended (elmo-number-set-append appended (car list)))
1416       (setq list (cdr list)))
1417     appended))
1418
1419 (defun elmo-number-set-append (number-set number)
1420   "Append NUMBER to the NUMBER-SET.
1421 NUMBER-SET is altered."
1422   (let ((number-set-1 number-set)
1423         found elem)
1424     (while (and number-set (not found))
1425       (setq elem (car number-set))
1426       (cond
1427        ((and (consp elem)
1428              (eq (+ 1 (cdr elem)) number))
1429         (setcdr elem number)
1430         (setq found t))
1431        ((and (integerp elem)
1432              (eq (+ 1 elem) number))
1433         (setcar number-set (cons elem number))
1434         (setq found t))
1435        ((or (and (integerp elem) (eq elem number))
1436             (and (consp elem)
1437                  (<= (car elem) number)
1438                  (<= number (cdr elem))))
1439         (setq found t)))
1440       (setq number-set (cdr number-set)))
1441     (if (not found)
1442         (setq number-set-1 (nconc number-set-1 (list number))))
1443     number-set-1))
1444
1445 (defun elmo-number-set-to-number-list (number-set)
1446   "Return a number list which corresponds to NUMBER-SET."
1447   (let (number-list elem i)
1448     (while number-set
1449       (setq elem (car number-set))
1450       (cond
1451        ((consp elem)
1452         (setq i (car elem))
1453         (while (<= i (cdr elem))
1454           (setq number-list (cons i number-list))
1455           (incf i)))
1456        ((integerp elem)
1457         (setq number-list (cons elem number-list))))
1458       (setq number-set (cdr number-set)))
1459     (nreverse number-list)))
1460
1461 (defcustom elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|[0-9]+\\)$"
1462   "*Regexp to filter subfolders."
1463   :type 'regexp
1464   :group 'elmo)
1465
1466 (defun elmo-list-subdirectories-1 (basedir curdir one-level)
1467   (let ((root (zerop (length curdir)))
1468         (w32-get-true-file-link-count t) ; for Meadow
1469         attr dirs dir)
1470     (catch 'done
1471       (dolist (file (directory-files (setq dir (expand-file-name curdir basedir))))
1472         (when (and (not (string-match
1473                          elmo-list-subdirectories-ignore-regexp
1474                          file))
1475                    (car (setq attr (file-attributes
1476                                     (expand-file-name file dir)))))
1477           (when (eq one-level 'check) (throw 'done t))
1478           (let ((relpath
1479                  (concat curdir (and (not root) elmo-path-sep) file))
1480                 subdirs)
1481             (setq dirs (nconc dirs
1482                               (if (if elmo-have-link-count (< 2 (nth 1 attr))
1483                                     (setq subdirs
1484                                           (elmo-list-subdirectories-1
1485                                            basedir
1486                                            relpath
1487                                            (if one-level 'check))))
1488                                   (if one-level
1489                                       (list (list relpath))
1490                                     (cons relpath
1491                                           (or subdirs
1492                                               (elmo-list-subdirectories-1
1493                                                basedir
1494                                                relpath
1495                                                nil))))
1496                                 (list relpath)))))))
1497       dirs)))
1498
1499 (defun elmo-list-subdirectories (directory file one-level)
1500   (let ((subdirs (elmo-list-subdirectories-1 directory file one-level)))
1501     (if (zerop (length file))
1502         subdirs
1503       (cons file subdirs))))
1504
1505 (defun elmo-mapcar-list-of-list (func list-of-list)
1506   (mapcar
1507    (lambda (x)
1508      (cond ((listp x) (elmo-mapcar-list-of-list func x))
1509            (t (funcall func x))))
1510    list-of-list))
1511
1512 (defun elmo-parse (string regexp &optional matchn)
1513   (or matchn (setq matchn 1))
1514   (let (list)
1515     (store-match-data nil)
1516     (while (string-match regexp string (match-end 0))
1517       (setq list (cons (substring string (match-beginning matchn)
1518                                   (match-end matchn)) list)))
1519     (nreverse list)))
1520
1521 ;;; File cache.
1522 (defmacro elmo-make-file-cache (path status)
1523   "PATH is the cache file name.
1524 STATUS is one of 'section, 'entire or nil.
1525  nil means no cache exists.
1526 'section means partial section cache exists.
1527 'entire means entire cache exists.
1528 If the cache is partial file-cache, TYPE is 'partial."
1529   (` (cons (, path) (, status))))
1530
1531 (defmacro elmo-file-cache-path (file-cache)
1532   "Returns the file path of the FILE-CACHE."
1533   (` (car (, file-cache))))
1534
1535 (defmacro elmo-file-cache-status (file-cache)
1536   "Returns the status of the FILE-CACHE."
1537   (` (cdr (, file-cache))))
1538
1539 (defsubst elmo-cache-to-msgid (filename)
1540   (concat "<" (elmo-recover-string-from-filename filename) ">"))
1541
1542 (defsubst elmo-cache-get-path-subr (msgid)
1543   (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
1544         (clist (string-to-char-list msgid))
1545         (sum 0))
1546     (while clist
1547       (setq sum (+ sum (car clist)))
1548       (setq clist (cdr clist)))
1549     (format "%c%c"
1550             (nth (% (/ sum 16) 2) chars)
1551             (nth (% sum 16) chars))))
1552
1553 (defun elmo-file-cache-get-path (msgid &optional section)
1554   "Get cache path for MSGID.
1555 If optional argument SECTION is specified, partial cache path is returned."
1556   (if (setq msgid (elmo-msgid-to-cache msgid))
1557       (expand-file-name
1558        (if section
1559            (format "%s/%s/%s/%s"
1560                    elmo-cache-directory
1561                    (elmo-cache-get-path-subr msgid)
1562                    msgid
1563                    section)
1564          (format "%s/%s/%s"
1565                  elmo-cache-directory
1566                  (elmo-cache-get-path-subr msgid)
1567                  msgid)))))
1568
1569 (defmacro elmo-file-cache-expand-path (path section)
1570   "Return file name for the file-cache corresponds to the section.
1571 PATH is the file-cache path.
1572 SECTION is the section string."
1573   (` (expand-file-name (or (, section) "") (, path))))
1574
1575 (defun elmo-file-cache-delete (path)
1576   "Delete a cache on PATH."
1577   (when (file-exists-p path)
1578     (if (file-directory-p path)
1579         (progn
1580           (dolist (file (directory-files path t "^[^\\.]"))
1581             (delete-file file))
1582           (delete-directory path))
1583       (delete-file path))
1584     t))
1585
1586 (defun elmo-file-cache-exists-p (msgid)
1587   "Returns 'section or 'entire if a cache which corresponds to MSGID exists."
1588   (elmo-file-cache-status (elmo-file-cache-get msgid)))
1589
1590 (defun elmo-file-cache-save (cache-path section)
1591   "Save current buffer as cache on PATH.
1592 Return t if cache is saved successfully."
1593   (condition-case nil
1594       (let ((path (if section (expand-file-name section cache-path)
1595                     cache-path))
1596             files dir)
1597         (if (and (null section)
1598                  (file-directory-p path))
1599             (progn
1600               (setq files (directory-files path t "^[^\\.]"))
1601               (while files
1602                 (delete-file (car files))
1603                 (setq files (cdr files)))
1604               (delete-directory path))
1605           (if (and section
1606                    (not (file-directory-p cache-path)))
1607               (delete-file cache-path)))
1608         (when path
1609           (setq dir (directory-file-name (file-name-directory path)))
1610           (if (not (file-exists-p dir))
1611               (elmo-make-directory dir))
1612           (write-region-as-binary (point-min) (point-max)
1613                                   path nil 'no-msg)
1614           t))
1615     ;; ignore error
1616     (error)))
1617
1618 (defun elmo-file-cache-load (cache-path section)
1619   "Load cache on PATH into the current buffer.
1620 Return t if cache is loaded successfully."
1621   (condition-case nil
1622       (let (cache-file)
1623         (when (and cache-path
1624                    (if (elmo-cache-path-section-p cache-path)
1625                        section
1626                      (null section))
1627                    (setq cache-file (elmo-file-cache-expand-path
1628                                      cache-path
1629                                      section))
1630                    (file-exists-p cache-file))
1631           (insert-file-contents-as-binary cache-file)
1632           t))
1633     ;; igore error
1634     (error)))
1635
1636 (defun elmo-cache-path-section-p (path)
1637   "Return non-nil when PATH is `section' cache path."
1638   (file-directory-p path))
1639
1640 (defun elmo-file-cache-get (msgid &optional section)
1641   "Returns the current file-cache object associated with MSGID.
1642 MSGID is the message-id of the message.
1643 If optional argument SECTION is specified, get partial file-cache object
1644 associated with SECTION."
1645   (if msgid
1646       (let ((path (elmo-cache-get-path msgid)))
1647         (if (and path (file-exists-p path))
1648             (if (elmo-cache-path-section-p path)
1649                 (if section
1650                     (if (file-exists-p (setq path (expand-file-name
1651                                                    section path)))
1652                         (cons path 'section))
1653                   ;; section is not specified but sectional.
1654                   (cons path 'section))
1655               ;; not directory.
1656               (unless section
1657                 (cons path 'entire)))
1658           ;; no cache.
1659           (cons path nil)))))
1660
1661 ;;;
1662 ;; Expire cache.
1663
1664 (defun elmo-cache-expire ()
1665   (interactive)
1666   (let* ((completion-ignore-case t)
1667          (method (completing-read (format "Expire by (%s): "
1668                                           elmo-cache-expire-default-method)
1669                                   '(("size" . "size")
1670                                     ("age" . "age")))))
1671     (if (string= method "")
1672         (setq method elmo-cache-expire-default-method))
1673     (funcall (intern (concat "elmo-cache-expire-by-" method)))))
1674
1675 (defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
1676   (let ((str (read-from-minibuffer prompt initial)))
1677     (cond
1678      ((string-match "[0-9]*\\.[0-9]+" str)
1679       (string-to-number str))
1680      ((string-match "[0-9]+" str)
1681       (string-to-number (concat str ".0")))
1682      (t (error "%s is not number" str)))))
1683
1684 (defun elmo-cache-expire-by-size (&optional kbytes)
1685   "Expire cache file by size.
1686 If KBYTES is kilo bytes (This value must be float)."
1687   (interactive)
1688   (let ((size (or kbytes
1689                   (and (interactive-p)
1690                        (elmo-read-float-value-from-minibuffer
1691                         "Enter cache disk size (Kbytes): "
1692                         (number-to-string
1693                          (if (integerp elmo-cache-expire-default-size)
1694                              (float elmo-cache-expire-default-size)
1695                            elmo-cache-expire-default-size))))
1696                   (if (integerp elmo-cache-expire-default-size)
1697                       (float elmo-cache-expire-default-size))))
1698         (count 0)
1699         (Kbytes 1024)
1700         total beginning)
1701     (message "Checking disk usage...")
1702     (setq total (/ (elmo-disk-usage
1703                     elmo-cache-directory) Kbytes))
1704     (setq beginning total)
1705     (message "Checking disk usage...done")
1706     (let ((cfl (elmo-cache-get-sorted-cache-file-list))
1707           (deleted 0)
1708           oldest
1709           cur-size cur-file)
1710       (while (and (<= size total)
1711                   (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl)))
1712         (setq cur-file (expand-file-name (car (cdr oldest)) (car oldest)))
1713         (setq cur-size (/ (elmo-disk-usage cur-file) Kbytes))
1714         (when (elmo-file-cache-delete cur-file)
1715           (setq count (+ count 1))
1716           (message "%d cache(s) are expired." count))
1717         (setq deleted (+ deleted cur-size))
1718         (setq total (- total cur-size)))
1719       (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
1720                count deleted beginning))))
1721
1722 (defun elmo-cache-make-file-entity (filename path)
1723   (cons filename (elmo-get-last-accessed-time filename path)))
1724
1725 (defun elmo-cache-get-oldest-cache-file-entity (cache-file-list)
1726   (let ((cfl cache-file-list)
1727         flist firsts oldest-entity wonlist)
1728     (while cfl
1729       (setq flist (cdr (car cfl)))
1730       (setq firsts (append firsts (list
1731                                    (cons (car (car cfl))
1732                                          (car flist)))))
1733       (setq cfl (cdr cfl)))
1734 ;;; (prin1 firsts)
1735     (while firsts
1736       (if (and (not oldest-entity)
1737                (cdr (cdr (car firsts))))
1738           (setq oldest-entity (car firsts)))
1739       (if (and (cdr (cdr (car firsts)))
1740                (cdr (cdr oldest-entity))
1741                (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts)))))
1742           (setq oldest-entity (car firsts)))
1743       (setq firsts (cdr firsts)))
1744     (setq wonlist (assoc (car oldest-entity) cache-file-list))
1745     (and wonlist
1746          (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist))))
1747     oldest-entity))
1748
1749 (defun elmo-cache-get-sorted-cache-file-list ()
1750   (let ((dirs (directory-files
1751                elmo-cache-directory
1752                t "^[^\\.]"))
1753         (i 0) num
1754         elist
1755         ret-val)
1756     (setq num (length dirs))
1757     (message "Collecting cache info...")
1758     (while dirs
1759       (setq elist (mapcar (lambda (x)
1760                             (elmo-cache-make-file-entity x (car dirs)))
1761                           (directory-files (car dirs) nil "^[^\\.]")))
1762       (setq ret-val (append ret-val
1763                             (list (cons
1764                                    (car dirs)
1765                                    (sort
1766                                     elist
1767                                     (lambda (x y)
1768                                       (< (cdr x)
1769                                          (cdr y))))))))
1770       (when (> num elmo-display-progress-threshold)
1771         (setq i (+ i 1))
1772         (elmo-display-progress
1773          'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
1774          (/ (* i 100) num)))
1775       (setq dirs (cdr dirs)))
1776     (message "Collecting cache info...done")
1777     ret-val))
1778
1779 (defun elmo-cache-expire-by-age (&optional days)
1780   (let ((age (or (and days (int-to-string days))
1781                  (and (interactive-p)
1782                       (read-from-minibuffer
1783                        (format "Enter days (%s): "
1784                                elmo-cache-expire-default-age)))
1785                  (int-to-string elmo-cache-expire-default-age)))
1786         (dirs (directory-files
1787                elmo-cache-directory
1788                t "^[^\\.]"))
1789         (count 0)
1790         curtime)
1791     (if (string= age "")
1792         (setq age elmo-cache-expire-default-age)
1793       (setq age (string-to-int age)))
1794     (setq curtime (current-time))
1795     (setq curtime (+ (* (nth 0 curtime)
1796                         (float 65536)) (nth 1 curtime)))
1797     (while dirs
1798       (let ((files (directory-files (car dirs) t "^[^\\.]"))
1799             (limit-age (* age 86400)))
1800         (while files
1801           (when (> (- curtime (elmo-get-last-accessed-time (car files)))
1802                    limit-age)
1803             (when (elmo-file-cache-delete (car files))
1804               (setq count (+ 1 count))
1805               (message "%d cache file(s) are expired." count)))
1806           (setq files (cdr files))))
1807       (setq dirs (cdr dirs)))))
1808
1809 ;;;
1810 ;; msgid to path.
1811 (defun elmo-msgid-to-cache (msgid)
1812   (save-match-data
1813     (when (and msgid
1814                (string-match "<\\(.+\\)>$" msgid))
1815       (elmo-replace-string-as-filename (elmo-match-string 1 msgid)))))
1816
1817 (defun elmo-cache-get-path (msgid &optional folder number)
1818   "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
1819   (if (setq msgid (elmo-msgid-to-cache msgid))
1820       (expand-file-name
1821        (expand-file-name
1822         (if folder
1823             (format "%s/%s/%s@%s"
1824                     (elmo-cache-get-path-subr msgid)
1825                     msgid
1826                     (or number "")
1827                     (elmo-safe-filename folder))
1828           (format "%s/%s"
1829                   (elmo-cache-get-path-subr msgid)
1830                   msgid))
1831         elmo-cache-directory))))
1832
1833 ;;;
1834 ;; Warnings.
1835
1836 (defconst elmo-warning-buffer-name "*elmo warning*")
1837
1838 (defun elmo-warning (&rest args)
1839   "Display a warning, making warning message by passing all args to `insert'."
1840   (with-current-buffer (get-buffer-create elmo-warning-buffer-name)
1841     (goto-char (point-max))
1842     (apply 'insert (append args '("\n")))
1843     (recenter 1))
1844   (display-buffer elmo-warning-buffer-name))
1845
1846 (defvar elmo-obsolete-variable-alist nil)
1847
1848 (defcustom elmo-obsolete-variable-show-warnings t
1849   "Show warning window if obsolete variable is treated."
1850   :type 'boolean
1851   :group 'elmo)
1852
1853 (defun elmo-define-obsolete-variable (obsolete var)
1854   "Define obsolete variable.
1855 OBSOLETE is a symbol for obsolete variable.
1856 VAR is a symbol for new variable.
1857 Definition is stored in `elmo-obsolete-variable-alist'."
1858   (let ((pair (assq var elmo-obsolete-variable-alist)))
1859     (if pair
1860         (setcdr pair obsolete)
1861       (setq elmo-obsolete-variable-alist
1862             (cons (cons var obsolete)
1863                   elmo-obsolete-variable-alist)))))
1864
1865 (defun elmo-resque-obsolete-variable (obsolete var)
1866   "Resque obsolete variable OBSOLETE as VAR.
1867 If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message."
1868   (when (boundp obsolete)
1869     (static-if (and (fboundp 'defvaralias)
1870                     (subrp (symbol-function 'defvaralias)))
1871         (defvaralias var obsolete)
1872       (set var (symbol-value obsolete)))
1873     (if elmo-obsolete-variable-show-warnings
1874         (elmo-warning (format "%s is obsolete. Use %s instead."
1875                               (symbol-name obsolete)
1876                               (symbol-name var))))))
1877
1878 (defun elmo-resque-obsolete-variables (&optional alist)
1879   "Resque obsolete variables in ALIST.
1880 ALIST is a list of cons cell of
1881 \(OBSOLETE-VARIABLE-SYMBOL . NEW-VARIABLE-SYMBOL\).
1882 If ALIST is nil, `elmo-obsolete-variable-alist' is used."
1883   (dolist (pair elmo-obsolete-variable-alist)
1884     (elmo-resque-obsolete-variable (cdr pair)
1885                                    (car pair))))
1886
1887 ;;; Queue.
1888 (defvar elmo-dop-queue-filename "queue"
1889   "*Disconnected operation queue is saved in this file.")
1890
1891 (defun elmo-dop-queue-load ()
1892   (setq elmo-dop-queue
1893         (elmo-object-load
1894          (expand-file-name elmo-dop-queue-filename
1895                            elmo-msgdb-directory))))
1896
1897 (defun elmo-dop-queue-save ()
1898   (elmo-object-save
1899    (expand-file-name elmo-dop-queue-filename
1900                      elmo-msgdb-directory)
1901    elmo-dop-queue))
1902
1903 (require 'product)
1904 (product-provide (provide 'elmo-util) (require 'elmo-version))
1905
1906 ;;; elmo-util.el ends here