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