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 &optional mode)
 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     (set-file-modes path (or mode
 720                              (+ (* 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   `(and (stringp ,string)
 943         (let ((sym (intern-soft ,string ,hashtable)))
 944           (if (boundp sym)
 945               (symbol-value sym)))))
 946
 947 (defmacro elmo-set-hash-val (string value hashtable)
 948   (list 'set (list 'intern string hashtable) value))
 949
 950 (defmacro elmo-clear-hash-val (string hashtable)
 951   (static-if (fboundp 'unintern)
 952       (list 'unintern string hashtable)
 953     (list 'makunbound (list 'intern string hashtable))))
 954
 955 (defmacro elmo-unintern (string)
 956   "`unintern' symbol named STRING,  When can use `unintern'.
 957 Emacs 19.28 or earlier does not have `unintern'."
 958   (static-if (fboundp 'unintern)
 959       (list 'unintern string)))
 960
 961 (defun elmo-make-hash (&optional hashsize)
 962   "Make a new hash table which have HASHSIZE size."
 963   (make-vector
 964    (if hashsize
 965        (max
 966         ;; Prime numbers as lengths tend to result in good
 967         ;; hashing; lengths one less than a power of two are
 968         ;; also good.
 969         (min
 970          (let ((i 1))
 971            (while (< (- i 1) hashsize)
 972              (setq i (* 2 i)))
 973            (- i 1))
 974          elmo-hash-maximum-size)
 975         elmo-hash-minimum-size)
 976      elmo-hash-minimum-size)
 977    0))
 978
 979 (defsubst elmo-mime-string (string)
 980   "Normalize MIME encoded STRING."
 981     (and string
 982          (let (str)
 983            (elmo-set-work-buf
 984             (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 985             (setq str (eword-decode-string
 986                        (decode-mime-charset-string string elmo-mime-charset)))
 987             (setq str (encode-mime-charset-string str elmo-mime-charset))
 988             (elmo-set-buffer-multibyte nil)
 989             str))))
 990
 991 (defsubst elmo-collect-field (beg end downcase-field-name)
 992   (save-excursion
 993     (save-restriction
 994       (narrow-to-region beg end)
 995       (goto-char (point-min))
 996       (let ((regexp (concat "\\(" std11-field-head-regexp "\\)[ \t]*"))
 997             dest name body)
 998         (while (re-search-forward regexp nil t)
 999           (setq name (buffer-substring-no-properties
1000                       (match-beginning 1)(1- (match-end 1))))
1001           (if downcase-field-name
1002               (setq name (downcase name)))
1003           (setq body (buffer-substring-no-properties
1004                       (match-end 0) (std11-field-end)))
1005           (or (assoc name dest)
1006               (setq dest (cons (cons name body) dest))))
1007         dest))))
1008
1009 (defsubst elmo-collect-field-from-string (string downcase-field-name)
1010   (with-temp-buffer
1011     (insert string)
1012     (goto-char (point-min))
1013     (let ((regexp (concat "\\(" std11-field-head-regexp "\\)[ \t]*"))
1014           dest name body)
1015       (while (re-search-forward regexp nil t)
1016         (setq name (buffer-substring-no-properties
1017                     (match-beginning 1)(1- (match-end 1))))
1018         (if downcase-field-name
1019             (setq name (downcase name)))
1020         (setq body (buffer-substring-no-properties
1021                     (match-end 0) (std11-field-end)))
1022         (or (assoc name dest)
1023             (setq dest (cons (cons name body) dest))))
1024       dest)))
1025
1026 (defun elmo-safe-filename (folder)
1027   (elmo-replace-in-string
1028    (elmo-replace-in-string
1029     (elmo-replace-in-string folder "/" " ")
1030     ":" "__")
1031    "|" "_or_"))
1032
1033 (defvar elmo-filename-replace-chars nil)
1034
1035 (defsubst elmo-replace-string-as-filename (msgid)
1036   "Replace string as filename."
1037   (setq msgid (elmo-replace-in-string msgid " " "  "))
1038   (if (null elmo-filename-replace-chars)
1039       (setq elmo-filename-replace-chars
1040             (regexp-quote (mapconcat
1041                            'car elmo-filename-replace-string-alist ""))))
1042   (while (string-match (concat "[" elmo-filename-replace-chars "]")
1043                        msgid)
1044     (setq msgid (concat
1045                  (substring msgid 0 (match-beginning 0))
1046                  (cdr (assoc
1047                        (substring msgid
1048                                   (match-beginning 0) (match-end 0))
1049                        elmo-filename-replace-string-alist))
1050                  (substring msgid (match-end 0)))))
1051   msgid)
1052
1053 (defsubst elmo-recover-string-from-filename (filename)
1054   "Recover string from FILENAME."
1055   (let (tmp result)
1056     (while (string-match " " filename)
1057       (setq tmp (substring filename
1058                            (match-beginning 0)
1059                            (+ (match-end 0) 1)))
1060       (if (string= tmp "  ")
1061           (setq tmp " ")
1062         (setq tmp (car (rassoc tmp
1063                                elmo-filename-replace-string-alist))))
1064       (setq result
1065             (concat result
1066                     (substring filename 0 (match-beginning 0))
1067                     tmp))
1068       (setq filename (substring filename (+ (match-end 0) 1))))
1069     (concat result filename)))
1070
1071 (defsubst elmo-copy-file (src dst &optional ok-if-already-exists)
1072   (condition-case err
1073       (elmo-add-name-to-file src dst ok-if-already-exists)
1074     (error (copy-file src dst ok-if-already-exists t))))
1075
1076 (defsubst elmo-buffer-exists-p (buffer)
1077   (if (bufferp buffer)
1078       (buffer-live-p buffer)
1079     (get-buffer buffer)))
1080
1081 (defsubst elmo-kill-buffer (buffer)
1082   (when (elmo-buffer-exists-p buffer)
1083     (kill-buffer buffer)))
1084
1085 (defun elmo-delete-if (pred lst)
1086   "Return new list contain items which don't satisfy PRED in LST."
1087   (let (result)
1088     (while lst
1089       (unless (funcall pred (car lst))
1090         (setq result (nconc result (list (car lst)))))
1091       (setq lst (cdr lst)))
1092     result))
1093
1094 (defun elmo-list-delete (list1 list2)
1095   "Delete by side effect any occurrences equal to elements of LIST1 from LIST2.
1096 Return the modified LIST2.  Deletion is done with `delete'.
1097 Write `(setq foo (elmo-list-delete bar foo))' to be sure of changing
1098 the value of `foo'."
1099   (while list1
1100     (setq list2 (delete (car list1) list2))
1101     (setq list1 (cdr list1)))
1102   list2)
1103
1104 (defun elmo-list-member (list1 list2)
1105   "If any element of LIST1 is member of LIST2, return t."
1106   (catch 'done
1107     (while list1
1108       (if (member (car list1) list2)
1109           (throw 'done t))
1110       (setq list1 (cdr list1)))))
1111
1112 (defun elmo-count-matches (regexp beg end)
1113   (let ((count 0))
1114     (save-excursion
1115       (goto-char beg)
1116       (while (re-search-forward regexp end t)
1117         (setq count (1+ count)))
1118       count)))
1119
1120 (if (fboundp 'display-error)
1121     (defalias 'elmo-display-error 'display-error)
1122   (defun elmo-display-error (error-object stream)
1123     "A tiny function to display ERROR-OBJECT to the STREAM."
1124     (let ((first t)
1125           (errobj error-object)
1126           err-mes)
1127       (while errobj
1128         (setq err-mes (concat err-mes (format
1129                                        (if (stringp (car errobj))
1130                                            "%s"
1131                                          "%S")
1132                                        (car errobj))))
1133         (setq errobj (cdr errobj))
1134         (if errobj (setq err-mes (concat err-mes (if first ": " ", "))))
1135         (setq first nil))
1136       (princ err-mes stream))))
1137
1138 (if (fboundp 'define-error)
1139     (defalias 'elmo-define-error 'define-error)
1140   (defun elmo-define-error (error doc &optional parents)
1141     (or parents
1142         (setq parents 'error))
1143     (let ((conds (get parents 'error-conditions)))
1144       (or conds
1145           (error "Not an error symbol: %s" error))
1146       (setplist error
1147                 (list 'error-message doc
1148                       'error-conditions (cons error conds))))))
1149
1150 (cond ((fboundp 'progress-feedback-with-label)
1151        (defalias 'elmo-display-progress 'progress-feedback-with-label))
1152       ((fboundp 'lprogress-display)
1153        (defalias 'elmo-display-progress 'lprogress-display))
1154       (t
1155        (defun elmo-display-progress (label format &optional value &rest args)
1156          "Print a progress message."
1157          (if (and (null format) (null args))
1158              (message nil)
1159            (apply (function message) (concat format " %d%%")
1160                   (nconc args (list value)))))))
1161
1162 (defvar elmo-progress-counter-alist nil)
1163
1164 (defmacro elmo-progress-counter-value (counter)
1165   (` (aref (cdr (, counter)) 0)))
1166
1167 (defmacro elmo-progress-counter-all-value (counter)
1168   (` (aref (cdr (, counter)) 1)))
1169
1170 (defmacro elmo-progress-counter-format (counter)
1171   (` (aref (cdr (, counter)) 2)))
1172
1173 (defmacro elmo-progress-counter-set-value (counter value)
1174   (` (aset (cdr (, counter)) 0 (, value))))
1175
1176 (defun elmo-progress-set (label all-value &optional format)
1177   (unless (assq label elmo-progress-counter-alist)
1178     (setq elmo-progress-counter-alist
1179           (cons (cons label (vector 0 all-value (or format "")))
1180                 elmo-progress-counter-alist))))
1181
1182 (defun elmo-progress-clear (label)
1183   (let ((counter (assq label elmo-progress-counter-alist)))
1184     (when counter
1185       (elmo-display-progress label
1186                              (elmo-progress-counter-format counter)
1187                              100)
1188       (setq elmo-progress-counter-alist
1189             (delq counter elmo-progress-counter-alist)))))
1190
1191 (defun elmo-progress-notify (label &optional value op &rest args)
1192   (let ((counter (assq label elmo-progress-counter-alist)))
1193     (when counter
1194       (let* ((value (or value 1))
1195              (cur-value (elmo-progress-counter-value counter))
1196              (all-value (elmo-progress-counter-all-value counter))
1197              (new-value (if (eq op 'set) value (+ cur-value value)))
1198              (cur-rate (/ (* cur-value 100) all-value))
1199              (new-rate (/ (* new-value 100) all-value)))
1200         (elmo-progress-counter-set-value counter new-value)
1201         (unless (= cur-rate new-rate)
1202           (apply 'elmo-display-progress
1203                  label
1204                  (elmo-progress-counter-format counter)
1205                  new-rate
1206                  args))
1207         (when (>= new-rate 100)
1208           (elmo-progress-clear label))))))
1209
1210 (defun elmo-time-expire (before-time diff-time)
1211   (let* ((current (current-time))
1212          (rest (when (< (nth 1 current) (nth 1 before-time))
1213                  (expt 2 16)))
1214          diff)
1215     (setq diff
1216           (list (- (+ (car current) (if rest -1 0)) (car before-time))
1217                 (- (+ (or rest 0) (nth 1 current)) (nth 1 before-time))))
1218     (and (eq (car diff) 0)
1219          (< diff-time (nth 1 diff)))))
1220
1221 (if (fboundp 'std11-fetch-field)
1222     (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
1223   (defalias 'elmo-field-body 'std11-field-body))
1224
1225 (defun elmo-address-quote-specials (word)
1226   "Make quoted string of WORD if needed."
1227   (let ((lal (std11-lexical-analyze word)))
1228     (if (or (assq 'specials lal)
1229             (assq 'domain-literal lal))
1230         (prin1-to-string word)
1231       word)))
1232
1233 (defmacro elmo-string (string)
1234   "STRING without text property."
1235   (` (let ((obj (copy-sequence (, string))))
1236        (and obj (set-text-properties 0 (length obj) nil obj))
1237        obj)))
1238
1239 (defun elmo-flatten (list-of-list)
1240   "Flatten LIST-OF-LIST."
1241   (unless (null list-of-list)
1242     (append (if (and (car list-of-list)
1243                      (listp (car list-of-list)))
1244                 (car list-of-list)
1245               (list (car list-of-list)))
1246             (elmo-flatten (cdr list-of-list)))))
1247
1248 (defun elmo-y-or-n-p (prompt &optional auto default)
1249   "Same as `y-or-n-p'.
1250 But if optional argument AUTO is non-nil, DEFAULT is returned."
1251   (if auto
1252       default
1253     (y-or-n-p prompt)))
1254
1255 (defun elmo-string-member (string slist)
1256   "Return t if STRING is a member of the SLIST."
1257   (catch 'found
1258     (while slist
1259       (if (and (stringp (car slist))
1260                (string= string (car slist)))
1261           (throw 'found t))
1262       (setq slist (cdr slist)))))
1263
1264 (defun elmo-string-match-member (str list &optional case-ignore)
1265   (let ((case-fold-search case-ignore))
1266     (catch 'member
1267       (while list
1268         (if (string-match (car list) str)
1269             (throw 'member (car list)))
1270         (setq list (cdr list))))))
1271
1272 (defun elmo-string-matched-member (str list &optional case-ignore)
1273   (let ((case-fold-search case-ignore))
1274     (catch 'member
1275       (while list
1276         (if (string-match str (car list))
1277             (throw 'member (car list)))
1278         (setq list (cdr list))))))
1279
1280 (defsubst elmo-string-delete-match (string pos)
1281   (concat (substring string
1282                      0 (match-beginning pos))
1283           (substring string
1284                      (match-end pos)
1285                      (length string))))
1286
1287 (defun elmo-string-match-assoc (key alist &optional case-ignore)
1288   (let ((case-fold-search case-ignore)
1289         a)
1290     (catch 'loop
1291       (while alist
1292         (setq a (car alist))
1293         (if (and (consp a)
1294                  (stringp (car a))
1295                  (string-match key (car a)))
1296             (throw 'loop a))
1297         (setq alist (cdr alist))))))
1298
1299 (defun elmo-string-matched-assoc (key alist &optional case-ignore)
1300   (let ((case-fold-search case-ignore)
1301         a)
1302     (catch 'loop
1303       (while alist
1304         (setq a (car alist))
1305         (if (and (consp a)
1306                  (stringp (car a))
1307                  (string-match (car a) key))
1308             (throw 'loop a))
1309         (setq alist (cdr alist))))))
1310
1311 (defun elmo-string-assoc (key alist)
1312   (let (a)
1313     (catch 'loop
1314       (while alist
1315         (setq a (car alist))
1316         (if (and (consp a)
1317                  (stringp (car a))
1318                  (string= key (car a)))
1319             (throw 'loop a))
1320         (setq alist (cdr alist))))))
1321
1322 (defun elmo-string-assoc-all (key alist)
1323   (let (matches)
1324     (while alist
1325       (if (string= key (car (car alist)))
1326           (setq matches
1327                 (cons (car alist)
1328                       matches)))
1329       (setq alist (cdr alist)))
1330     matches))
1331
1332 (defun elmo-string-rassoc (key alist)
1333   (let (a)
1334     (catch 'loop
1335       (while alist
1336         (setq a (car alist))
1337         (if (and (consp a)
1338                  (stringp (cdr a))
1339                  (string= key (cdr a)))
1340             (throw 'loop a))
1341         (setq alist (cdr alist))))))
1342
1343 (defun elmo-string-rassoc-all (key alist)
1344   (let (matches)
1345     (while alist
1346       (if (string= key (cdr (car alist)))
1347           (setq matches
1348                 (cons (car alist)
1349                       matches)))
1350       (setq alist (cdr alist)))
1351     matches))
1352
1353 ;;; Folder parser utils.
1354 (defun elmo-parse-token (string &optional seps)
1355   "Parse atom from STRING using SEPS as a string of separator char list."
1356   (let ((len (length string))
1357         (seps (and seps (string-to-char-list seps)))
1358         (i 0)
1359         (sep nil)
1360         content c in)
1361     (if (eq len 0)
1362         (cons "" "")
1363       (while (and (< i len) (or in (null sep)))
1364         (setq c (aref string i))
1365         (cond
1366          ((and in (eq c ?\\))
1367           (setq i (1+ i)
1368                 content (cons (aref string i) content)
1369                 i (1+ i)))
1370          ((eq c ?\")
1371           (setq in (not in)
1372                 i (1+ i)))
1373          (in (setq content (cons c content)
1374                    i (1+ i)))
1375          ((memq c seps)
1376           (setq sep c))
1377          (t (setq content (cons c content)
1378                   i (1+ i)))))
1379       (if in (error "Parse error in quoted"))
1380       (cons (if (null content) "" (char-list-to-string (nreverse content)))
1381             (substring string i)))))
1382
1383 (defun elmo-parse-prefixed-element (prefix string &optional seps)
1384   (if (and (not (eq (length string) 0))
1385            (eq (aref string 0) prefix))
1386       (elmo-parse-token (substring string 1) seps)
1387     (cons "" string)))
1388
1389 ;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
1390 ;;
1391 ;; number          ::= [0-9]+
1392 ;; beg             ::= number
1393 ;; end             ::= number
1394 ;; number-range    ::= "(" beg " . " end ")"      ;; cons cell
1395 ;; number-set-elem ::= number / number-range
1396 ;; number-set      ::= "(" *number-set-elem ")"   ;; list
1397
1398 (defun elmo-number-set-member (number number-set)
1399   "Return non-nil if NUMBER is an element of NUMBER-SET.
1400 The value is actually the tail of NUMBER-RANGE whose car contains NUMBER."
1401   (or (memq number number-set)
1402       (let (found)
1403         (while (and number-set (not found))
1404           (if (and (consp (car number-set))
1405                    (and (<= (car (car number-set)) number)
1406                         (<= number (cdr (car number-set)))))
1407               (setq found t)
1408             (setq number-set (cdr number-set))))
1409         number-set)))
1410
1411 (defun elmo-number-set-append-list (number-set list)
1412   "Append LIST of numbers to the NUMBER-SET.
1413 NUMBER-SET is altered."
1414   (let ((appended number-set))
1415     (while list
1416       (setq appended (elmo-number-set-append appended (car list)))
1417       (setq list (cdr list)))
1418     appended))
1419
1420 (defun elmo-number-set-append (number-set number)
1421   "Append NUMBER to the NUMBER-SET.
1422 NUMBER-SET is altered."
1423   (let ((number-set-1 number-set)
1424         found elem)
1425     (while (and number-set (not found))
1426       (setq elem (car number-set))
1427       (cond
1428        ((and (consp elem)
1429              (eq (+ 1 (cdr elem)) number))
1430         (setcdr elem number)
1431         (setq found t))
1432        ((and (integerp elem)
1433              (eq (+ 1 elem) number))
1434         (setcar number-set (cons elem number))
1435         (setq found t))
1436        ((or (and (integerp elem) (eq elem number))
1437             (and (consp elem)
1438                  (<= (car elem) number)
1439                  (<= number (cdr elem))))
1440         (setq found t)))
1441       (setq number-set (cdr number-set)))
1442     (if (not found)
1443         (setq number-set-1 (nconc number-set-1 (list number))))
1444     number-set-1))
1445
1446 (defun elmo-number-set-to-number-list (number-set)
1447   "Return a number list which corresponds to NUMBER-SET."
1448   (let (number-list elem i)
1449     (while number-set
1450       (setq elem (car number-set))
1451       (cond
1452        ((consp elem)
1453         (setq i (car elem))
1454         (while (<= i (cdr elem))
1455           (setq number-list (cons i number-list))
1456           (incf i)))
1457        ((integerp elem)
1458         (setq number-list (cons elem number-list))))
1459       (setq number-set (cdr number-set)))
1460     (nreverse number-list)))
1461
1462 (defcustom elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|[0-9]+\\)$"
1463   "*Regexp to filter subfolders."
1464   :type 'regexp
1465   :group 'elmo)
1466
1467 (defun elmo-list-subdirectories-1 (basedir curdir one-level)
1468   (let ((root (zerop (length curdir)))
1469         (w32-get-true-file-link-count t) ; for Meadow
1470         attr dirs dir)
1471     (catch 'done
1472       (dolist (file (directory-files (setq dir (expand-file-name curdir basedir))))
1473         (when (and (not (string-match
1474                          elmo-list-subdirectories-ignore-regexp
1475                          file))
1476                    (car (setq attr (file-attributes
1477                                     (expand-file-name file dir)))))
1478           (when (eq one-level 'check) (throw 'done t))
1479           (let ((relpath
1480                  (concat curdir (and (not root) elmo-path-sep) file))
1481                 subdirs)
1482             (setq dirs (nconc dirs
1483                               (if (if elmo-have-link-count (< 2 (nth 1 attr))
1484                                     (setq subdirs
1485                                           (elmo-list-subdirectories-1
1486                                            basedir
1487                                            relpath
1488                                            (if one-level 'check))))
1489                                   (if one-level
1490                                       (list (list relpath))
1491                                     (cons relpath
1492                                           (or subdirs
1493                                               (elmo-list-subdirectories-1
1494                                                basedir
1495                                                relpath
1496                                                nil))))
1497                                 (list relpath)))))))
1498       dirs)))
1499
1500 (defun elmo-list-subdirectories (directory file one-level)
1501   (let ((subdirs (elmo-list-subdirectories-1 directory file one-level)))
1502     (if (zerop (length file))
1503         subdirs
1504       (cons file subdirs))))
1505
1506 (defun elmo-mapcar-list-of-list (func list-of-list)
1507   (mapcar
1508    (lambda (x)
1509      (cond ((listp x) (elmo-mapcar-list-of-list func x))
1510            (t (funcall func x))))
1511    list-of-list))
1512
1513 (defun elmo-parse (string regexp &optional matchn)
1514   (or matchn (setq matchn 1))
1515   (let (list)
1516     (store-match-data nil)
1517     (while (string-match regexp string (match-end 0))
1518       (setq list (cons (substring string (match-beginning matchn)
1519                                   (match-end matchn)) list)))
1520     (nreverse list)))
1521
1522 ;;; File cache.
1523 (defmacro elmo-make-file-cache (path status)
1524   "PATH is the cache file name.
1525 STATUS is one of 'section, 'entire or nil.
1526  nil means no cache exists.
1527 'section means partial section cache exists.
1528 'entire means entire cache exists.
1529 If the cache is partial file-cache, TYPE is 'partial."
1530   (` (cons (, path) (, status))))
1531
1532 (defmacro elmo-file-cache-path (file-cache)
1533   "Returns the file path of the FILE-CACHE."
1534   (` (car (, file-cache))))
1535
1536 (defmacro elmo-file-cache-status (file-cache)
1537   "Returns the status of the FILE-CACHE."
1538   (` (cdr (, file-cache))))
1539
1540 (defsubst elmo-cache-to-msgid (filename)
1541   (concat "<" (elmo-recover-string-from-filename filename) ">"))
1542
1543 (defsubst elmo-cache-get-path-subr (msgid)
1544   (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
1545         (clist (string-to-char-list msgid))
1546         (sum 0))
1547     (while clist
1548       (setq sum (+ sum (car clist)))
1549       (setq clist (cdr clist)))
1550     (format "%c%c"
1551             (nth (% (/ sum 16) 2) chars)
1552             (nth (% sum 16) chars))))
1553
1554 (defun elmo-file-cache-get-path (msgid &optional section)
1555   "Get cache path for MSGID.
1556 If optional argument SECTION is specified, partial cache path is returned."
1557   (if (setq msgid (elmo-msgid-to-cache msgid))
1558       (expand-file-name
1559        (if section
1560            (format "%s/%s/%s/%s"
1561                    elmo-cache-directory
1562                    (elmo-cache-get-path-subr msgid)
1563                    msgid
1564                    section)
1565          (format "%s/%s/%s"
1566                  elmo-cache-directory
1567                  (elmo-cache-get-path-subr msgid)
1568                  msgid)))))
1569
1570 (defmacro elmo-file-cache-expand-path (path section)
1571   "Return file name for the file-cache corresponds to the section.
1572 PATH is the file-cache path.
1573 SECTION is the section string."
1574   (` (expand-file-name (or (, section) "") (, path))))
1575
1576 (defun elmo-file-cache-delete (path)
1577   "Delete a cache on PATH."
1578   (when (file-exists-p path)
1579     (if (file-directory-p path)
1580         (progn
1581           (dolist (file (directory-files path t "^[^\\.]"))
1582             (delete-file file))
1583           (delete-directory path))
1584       (delete-file path))
1585     t))
1586
1587 (defun elmo-file-cache-exists-p (msgid)
1588   "Returns 'section or 'entire if a cache which corresponds to MSGID exists."
1589   (elmo-file-cache-status (elmo-file-cache-get msgid)))
1590
1591 (defun elmo-file-cache-save (cache-path section)
1592   "Save current buffer as cache on PATH.
1593 Return t if cache is saved successfully."
1594   (condition-case nil
1595       (let ((path (if section (expand-file-name section cache-path)
1596                     cache-path))
1597             files dir)
1598         (if (and (null section)
1599                  (file-directory-p path))
1600             (progn
1601               (setq files (directory-files path t "^[^\\.]"))
1602               (while files
1603                 (delete-file (car files))
1604                 (setq files (cdr files)))
1605               (delete-directory path))
1606           (if (and section
1607                    (not (file-directory-p cache-path)))
1608               (delete-file cache-path)))
1609         (when path
1610           (setq dir (directory-file-name (file-name-directory path)))
1611           (if (not (file-exists-p dir))
1612               (elmo-make-directory dir))
1613           (write-region-as-binary (point-min) (point-max)
1614                                   path nil 'no-msg)
1615           t))
1616     ;; ignore error
1617     (error)))
1618
1619 (defun elmo-file-cache-load (cache-path section)
1620   "Load cache on PATH into the current buffer.
1621 Return t if cache is loaded successfully."
1622   (condition-case nil
1623       (let (cache-file)
1624         (when (and cache-path
1625                    (if (elmo-cache-path-section-p cache-path)
1626                        section
1627                      (null section))
1628                    (setq cache-file (elmo-file-cache-expand-path
1629                                      cache-path
1630                                      section))
1631                    (file-exists-p cache-file))
1632           (insert-file-contents-as-binary cache-file)
1633           t))
1634     ;; igore error
1635     (error)))
1636
1637 (defun elmo-cache-path-section-p (path)
1638   "Return non-nil when PATH is `section' cache path."
1639   (file-directory-p path))
1640
1641 (defun elmo-file-cache-get (msgid &optional section)
1642   "Returns the current file-cache object associated with MSGID.
1643 MSGID is the message-id of the message.
1644 If optional argument SECTION is specified, get partial file-cache object
1645 associated with SECTION."
1646   (if msgid
1647       (let ((path (elmo-cache-get-path msgid)))
1648         (if (and path (file-exists-p path))
1649             (if (elmo-cache-path-section-p path)
1650                 (if section
1651                     (if (file-exists-p (setq path (expand-file-name
1652                                                    section path)))
1653                         (cons path 'section))
1654                   ;; section is not specified but sectional.
1655                   (cons path 'section))
1656               ;; not directory.
1657               (unless section
1658                 (cons path 'entire)))
1659           ;; no cache.
1660           (cons path nil)))))
1661
1662 ;;;
1663 ;; Expire cache.
1664
1665 (defun elmo-cache-expire ()
1666   (interactive)
1667   (let* ((completion-ignore-case t)
1668          (method (completing-read (format "Expire by (%s): "
1669                                           elmo-cache-expire-default-method)
1670                                   '(("size" . "size")
1671                                     ("age" . "age")))))
1672     (if (string= method "")
1673         (setq method elmo-cache-expire-default-method))
1674     (funcall (intern (concat "elmo-cache-expire-by-" method)))))
1675
1676 (defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
1677   (let ((str (read-from-minibuffer prompt initial)))
1678     (cond
1679      ((string-match "[0-9]*\\.[0-9]+" str)
1680       (string-to-number str))
1681      ((string-match "[0-9]+" str)
1682       (string-to-number (concat str ".0")))
1683      (t (error "%s is not number" str)))))
1684
1685 (defun elmo-cache-expire-by-size (&optional kbytes)
1686   "Expire cache file by size.
1687 If KBYTES is kilo bytes (This value must be float)."
1688   (interactive)
1689   (let ((size (or kbytes
1690                   (and (interactive-p)
1691                        (elmo-read-float-value-from-minibuffer
1692                         "Enter cache disk size (Kbytes): "
1693                         (number-to-string
1694                          (if (integerp elmo-cache-expire-default-size)
1695                              (float elmo-cache-expire-default-size)
1696                            elmo-cache-expire-default-size))))
1697                   (if (integerp elmo-cache-expire-default-size)
1698                       (float elmo-cache-expire-default-size))))
1699         (count 0)
1700         (Kbytes 1024)
1701         total beginning)
1702     (message "Checking disk usage...")
1703     (setq total (/ (elmo-disk-usage
1704                     elmo-cache-directory) Kbytes))
1705     (setq beginning total)
1706     (message "Checking disk usage...done")
1707     (let ((cfl (elmo-cache-get-sorted-cache-file-list))
1708           (deleted 0)
1709           oldest
1710           cur-size cur-file)
1711       (while (and (<= size total)
1712                   (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl)))
1713         (setq cur-file (expand-file-name (car (cdr oldest)) (car oldest)))
1714         (setq cur-size (/ (elmo-disk-usage cur-file) Kbytes))
1715         (when (elmo-file-cache-delete cur-file)
1716           (setq count (+ count 1))
1717           (message "%d cache(s) are expired." count))
1718         (setq deleted (+ deleted cur-size))
1719         (setq total (- total cur-size)))
1720       (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
1721                count deleted beginning))))
1722
1723 (defun elmo-cache-make-file-entity (filename path)
1724   (cons filename (elmo-get-last-accessed-time filename path)))
1725
1726 (defun elmo-cache-get-oldest-cache-file-entity (cache-file-list)
1727   (let ((cfl cache-file-list)
1728         flist firsts oldest-entity wonlist)
1729     (while cfl
1730       (setq flist (cdr (car cfl)))
1731       (setq firsts (append firsts (list
1732                                    (cons (car (car cfl))
1733                                          (car flist)))))
1734       (setq cfl (cdr cfl)))
1735 ;;; (prin1 firsts)
1736     (while firsts
1737       (if (and (not oldest-entity)
1738                (cdr (cdr (car firsts))))
1739           (setq oldest-entity (car firsts)))
1740       (if (and (cdr (cdr (car firsts)))
1741                (cdr (cdr oldest-entity))
1742                (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts)))))
1743           (setq oldest-entity (car firsts)))
1744       (setq firsts (cdr firsts)))
1745     (setq wonlist (assoc (car oldest-entity) cache-file-list))
1746     (and wonlist
1747          (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist))))
1748     oldest-entity))
1749
1750 (defun elmo-cache-get-sorted-cache-file-list ()
1751   (let ((dirs (directory-files
1752                elmo-cache-directory
1753                t "^[^\\.]"))
1754         (i 0) num
1755         elist
1756         ret-val)
1757     (setq num (length dirs))
1758     (message "Collecting cache info...")
1759     (while dirs
1760       (setq elist (mapcar (lambda (x)
1761                             (elmo-cache-make-file-entity x (car dirs)))
1762                           (directory-files (car dirs) nil "^[^\\.]")))
1763       (setq ret-val (append ret-val
1764                             (list (cons
1765                                    (car dirs)
1766                                    (sort
1767                                     elist
1768                                     (lambda (x y)
1769                                       (< (cdr x)
1770                                          (cdr y))))))))
1771       (when (> num elmo-display-progress-threshold)
1772         (setq i (+ i 1))
1773         (elmo-display-progress
1774          'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
1775          (/ (* i 100) num)))
1776       (setq dirs (cdr dirs)))
1777     (message "Collecting cache info...done")
1778     ret-val))
1779
1780 (defun elmo-cache-expire-by-age (&optional days)
1781   (let ((age (or (and days (int-to-string days))
1782                  (and (interactive-p)
1783                       (read-from-minibuffer
1784                        (format "Enter days (%s): "
1785                                elmo-cache-expire-default-age)))
1786                  (int-to-string elmo-cache-expire-default-age)))
1787         (dirs (directory-files
1788                elmo-cache-directory
1789                t "^[^\\.]"))
1790         (count 0)
1791         curtime)
1792     (if (string= age "")
1793         (setq age elmo-cache-expire-default-age)
1794       (setq age (string-to-int age)))
1795     (setq curtime (current-time))
1796     (setq curtime (+ (* (nth 0 curtime)
1797                         (float 65536)) (nth 1 curtime)))
1798     (while dirs
1799       (let ((files (directory-files (car dirs) t "^[^\\.]"))
1800             (limit-age (* age 86400)))
1801         (while files
1802           (when (> (- curtime (elmo-get-last-accessed-time (car files)))
1803                    limit-age)
1804             (when (elmo-file-cache-delete (car files))
1805               (setq count (+ 1 count))
1806               (message "%d cache file(s) are expired." count)))
1807           (setq files (cdr files))))
1808       (setq dirs (cdr dirs)))))
1809
1810 ;;;
1811 ;; msgid to path.
1812 (defun elmo-msgid-to-cache (msgid)
1813   (save-match-data
1814     (when (and msgid
1815                (string-match "<\\(.+\\)>$" msgid))
1816       (elmo-replace-string-as-filename (elmo-match-string 1 msgid)))))
1817
1818 (defun elmo-cache-get-path (msgid &optional folder number)
1819   "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
1820   (if (setq msgid (elmo-msgid-to-cache msgid))
1821       (expand-file-name
1822        (expand-file-name
1823         (if folder
1824             (format "%s/%s/%s@%s"
1825                     (elmo-cache-get-path-subr msgid)
1826                     msgid
1827                     (or number "")
1828                     (elmo-safe-filename folder))
1829           (format "%s/%s"
1830                   (elmo-cache-get-path-subr msgid)
1831                   msgid))
1832         elmo-cache-directory))))
1833
1834 ;;;
1835 ;; Warnings.
1836
1837 (defconst elmo-warning-buffer-name "*elmo warning*")
1838
1839 (defun elmo-warning (&rest args)
1840   "Display a warning, making warning message by passing all args to `insert'."
1841   (with-current-buffer (get-buffer-create elmo-warning-buffer-name)
1842     (goto-char (point-max))
1843     (apply 'insert (append args '("\n")))
1844     (recenter 1))
1845   (display-buffer elmo-warning-buffer-name))
1846
1847 (defvar elmo-obsolete-variable-alist nil)
1848
1849 (defcustom elmo-obsolete-variable-show-warnings t
1850   "Show warning window if obsolete variable is treated."
1851   :type 'boolean
1852   :group 'elmo)
1853
1854 (defun elmo-define-obsolete-variable (obsolete var)
1855   "Define obsolete variable.
1856 OBSOLETE is a symbol for obsolete variable.
1857 VAR is a symbol for new variable.
1858 Definition is stored in `elmo-obsolete-variable-alist'."
1859   (let ((pair (assq var elmo-obsolete-variable-alist)))
1860     (if pair
1861         (setcdr pair obsolete)
1862       (setq elmo-obsolete-variable-alist
1863             (cons (cons var obsolete)
1864                   elmo-obsolete-variable-alist)))))
1865
1866 (defun elmo-resque-obsolete-variable (obsolete var)
1867   "Resque obsolete variable OBSOLETE as VAR.
1868 If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message."
1869   (when (boundp obsolete)
1870     (static-if (and (fboundp 'defvaralias)
1871                     (subrp (symbol-function 'defvaralias)))
1872         (defvaralias var obsolete)
1873       (set var (symbol-value obsolete)))
1874     (if elmo-obsolete-variable-show-warnings
1875         (elmo-warning (format "%s is obsolete. Use %s instead."
1876                               (symbol-name obsolete)
1877                               (symbol-name var))))))
1878
1879 (defun elmo-resque-obsolete-variables (&optional alist)
1880   "Resque obsolete variables in ALIST.
1881 ALIST is a list of cons cell of
1882 \(OBSOLETE-VARIABLE-SYMBOL . NEW-VARIABLE-SYMBOL\).
1883 If ALIST is nil, `elmo-obsolete-variable-alist' is used."
1884   (dolist (pair elmo-obsolete-variable-alist)
1885     (elmo-resque-obsolete-variable (cdr pair)
1886                                    (car pair))))
1887
1888 ;;; Queue.
1889 (defvar elmo-dop-queue-filename "queue"
1890   "*Disconnected operation queue is saved in this file.")
1891
1892 (defun elmo-dop-queue-load ()
1893   (setq elmo-dop-queue
1894         (elmo-object-load
1895          (expand-file-name elmo-dop-queue-filename
1896                            elmo-msgdb-directory))))
1897
1898 (defun elmo-dop-queue-save ()
1899   (elmo-object-save
1900    (expand-file-name elmo-dop-queue-filename
1901                      elmo-msgdb-directory)
1902    elmo-dop-queue))
1903
1904 (require 'product)
1905 (product-provide (provide 'elmo-util) (require 'elmo-version))
1906
1907 ;;; elmo-util.el ends here