elmo/elmo-archive.el

   1 ;;; elmo-archive.el --- Archive folder of ELMO. -*- coding: euc-japan -*-
   2
   3 ;; Copyright (C) 1998,1999,2000 OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
   4 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   5
   6 ;; Author: OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
   7 ;;      Yuuichi Teranishi <teranisi@gohome.org>
   8 ;; Keywords: mail, net news
   9 ;; Created: Sep 13, 1998
  10
  11 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  12
  13 ;; This program is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17 ;;
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27 ;;
  28
  29 ;;; Commentary:
  30 ;;
  31 ;; TODO:
  32 ;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍÑ¤¤¤¿ÆüËÜ¸ì¸¡º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£
  33
  34 ;;; Code:
  35 ;;
  36 (eval-when-compile (require 'cl))
  37
  38 (require 'elmo)
  39 (require 'elmo-msgdb)
  40
  41 ;;; User vars.
  42 (defvar elmo-archive-lha-dos-compatible
  43   (memq system-type '(OS/2 emx windows-nt))
  44   "*If non-nil, regard your LHA as compatible to DOS version.")
  45
  46 (defvar elmo-archive-use-izip-agent (memq system-type '(OS/2 emx))
  47   "*If non-nil, use the special agent in fetching headers.")
  48
  49 (defvar elmo-archive-folder-path "~/Mail"
  50   "*Base directory for archive folders.")
  51
  52 (defvar elmo-archive-basename "elmo-archive"
  53   "*Common basename of archive folder file, w/o suffix.")
  54
  55 (defvar elmo-archive-cmdstr-max-length 8000 ; SASAKI Osamu's suggestion
  56   "*Command line string limitation under OS/2, exactly 8190 bytes.")
  57
  58 (defvar elmo-archive-fetch-headers-volume 50
  59   "*Quantity of article headers to fetch per once.")
  60
  61 (defvar elmo-archive-dummy-file ".elmo-archive"
  62   "*Name of dummy file that will be appended when the folder is null.")
  63
  64 (defvar elmo-archive-check-existance-strict t
  65   "*Check existance of archive contents if non-nil.")
  66
  67 (defvar elmo-archive-load-hook nil
  68   "*Hook called after loading elmo-archive.el.")
  69
  70 (defvar elmo-archive-treat-file nil
  71   "*Treat archive folder as a file if non-nil.")
  72
  73 ;;; User variables for elmo-archive.
  74 (defvar elmo-archive-default-type 'zip
  75   "*Default archiver type.  The value must be a symbol.")
  76
  77 (defvar elmo-archive-use-cache nil
  78   "Use cache in archive folder.")
  79
  80 ;;; ELMO Local directory folder
  81 (eval-and-compile
  82   (luna-define-class elmo-archive-folder (elmo-folder)
  83                      (archive-name archive-type archive-prefix dir-name))
  84   (luna-define-internal-accessors 'elmo-archive-folder))
  85
  86 (luna-define-generic elmo-archive-folder-path (folder)
  87   "Return local directory path of the FOLDER.")
  88
  89 (luna-define-method elmo-archive-folder-path ((folder elmo-archive-folder))
  90   elmo-archive-folder-path)
  91
  92 (luna-define-method elmo-folder-initialize ((folder
  93                                              elmo-archive-folder)
  94                                             name)
  95   (elmo-archive-folder-set-dir-name-internal folder name)
  96   (when (string-match
  97          "^\\([^;]*\\);?\\([^;]*\\);?\\([^;]*\\)$"
  98          name)
  99     ;; Drive letter is OK!
 100     (or (elmo-archive-folder-set-archive-name-internal
 101          folder (elmo-match-string 1 name))
 102         (elmo-archive-folder-set-archive-name-internal
 103          folder ""))
 104     (or (elmo-archive-folder-set-archive-type-internal
 105          folder (intern-soft (elmo-match-string 2 name)))
 106         (elmo-archive-folder-set-archive-type-internal
 107          folder elmo-archive-default-type))
 108     (or (elmo-archive-folder-set-archive-prefix-internal
 109          folder (elmo-match-string 3 name))
 110         (elmo-archive-folder-set-archive-prefix-internal
 111          folder "")))
 112   folder)
 113
 114 (luna-define-method elmo-folder-expand-msgdb-path ((folder
 115                                                     elmo-archive-folder))
 116   ;; For compatibility
 117   (expand-file-name
 118    (elmo-replace-string-as-filename
 119     (elmo-folder-name-internal folder))
 120    (expand-file-name (concat (symbol-name (elmo-folder-type-internal folder))
 121                              "/"
 122                              (symbol-name
 123                               (elmo-archive-folder-archive-type-internal
 124                                folder)))
 125                      elmo-msgdb-directory)))
 126
 127 ;;; MMDF parser -- info-zip agent w/ REXX
 128 (defvar elmo-mmdf-delimiter "^\01\01\01\01$"
 129   "*Regular expression of MMDF delimiter.")
 130
 131 (defvar elmo-unixmail-delimiter "^From \\([^ \t]+\\) \\(.+\\)"
 132   "*Regular expression of UNIX Mail delimiter.")
 133
 134 (defvar elmo-archive-header-regexp "^[ \t]*[-=][-=][-=][-=]"
 135   "*Common regexp of the delimiter in listing archive.") ; marche
 136
 137 (defvar elmo-archive-file-regexp-alist
 138   (append
 139    (if elmo-archive-lha-dos-compatible
 140        '((lha . "^%s\\([0-9]+\\)$"))    ; OS/2,DOS w/  "-x"
 141      '((lha . "^.*[ \t]%s\\([0-9]+\\)$")))
 142    '((zip . "^.*[ \t]%s\\([0-9]+\\)$")
 143      (zoo . "^.*[ \t]%s\\([0-9]+\\)$")
 144      (tar . "^%s\\([0-9]+\\)$")         ; ok
 145      (tgz . "^%s\\([0-9]+\\)$")         ; ok
 146      (rar . "^[ \t]%s\\([0-9]+\\)$"))))
 147
 148 (defvar elmo-archive-suffix-alist
 149    '((lha . ".lzh")  ; default
 150 ;;;  (lha . ".lzs")
 151      (zip . ".zip")
 152      (zoo . ".zoo")
 153 ;;;  (arc . ".arc")
 154 ;;;  (arj . ".arj")
 155      (rar . ".rar")
 156      (tar . ".tar")
 157      (tgz . ".tar.gz")))
 158
 159 ;;; lha
 160 (defvar elmo-archive-lha-method-alist
 161   (if elmo-archive-lha-dos-compatible
 162       ;; OS/2
 163       '((cp  . ("lha" "u" "-x"))
 164         (mv  . ("lha" "m" "-x"))
 165         (rm  . ("lha" "d"))
 166         (ls  . ("lha" "l" "-x"))
 167         (cat . ("lha" "p" "-n"))
 168         (ext . ("lha" "x"))             ; "-x"
 169         )
 170     ;; some UN|X
 171     '((cp  . ("lha" "u"))
 172       (mv  . ("lha" "m"))
 173       (rm  . ("lha" "d"))
 174       (ls  . ("lha" "l"))
 175       (cat . ("lha" "pq"))
 176       (ext . ("lha" "x")))))
 177
 178 ;;; info-zip/unzip
 179 (defvar elmo-archive-zip-method-alist
 180   '((cp       . ("zip" "-9q"))
 181     (cp-pipe  . ("zip" "-9q@"))
 182     (mv       . ("zip" "-mDq9"))
 183     (mv-pipe  . ("zip" "-mDq9@"))
 184     (rm       . ("zip" "-dq"))
 185     (rm-pipe  . ("zip" "-dq@"))
 186     (ls       . ("unzip" "-lq"))
 187     (cat      . ("unzip" "-pq"))
 188     (ext      . ("unzip"))
 189     (cat-headers . ("izwlagent" "--cat"))))
 190
 191 ;;; zoo
 192 (defvar elmo-archive-zoo-method-alist
 193   '((cp       . ("zoo" "aq"))
 194     (cp-pipe  . ("zoo" "aqI"))
 195     (mv       . ("zoo" "aMq"))
 196     (mv-pipe  . ("zoo" "aMqI"))
 197     (rm       . ("zoo" "Dq"))
 198     (ls       . ("zoo" "l"))            ; normal
 199     (cat      . ("zoo" "xpq"))
 200     (ext      . ("zoo" "xq"))))
 201
 202 ;;; rar
 203 (defvar elmo-archive-rar-method-alist
 204   '((cp       . ("rar" "u" "-m5"))
 205     (mv       . ("rar" "m" "-m5"))
 206     (rm       . ("rar" "d"))
 207     (ls       . ("rar" "v"))
 208     (cat      . ("rar" "p" "-inul"))
 209     (ext      . ("rar" "x"))))
 210
 211 ;;; GNU tar (*.tar)
 212 (defvar elmo-archive-tar-method-alist
 213   (if elmo-archive-lha-dos-compatible
 214       '((ls   . ("gtar" "-tf"))
 215         (cat  . ("gtar" "--posix Oxf"))
 216         (ext  . ("gtar" "-xf"))
 217 ;;;     (rm   . ("gtar" "--posix" "--delete" "-f")) ; well not work
 218         )
 219     '((ls    . ("gtar" "-tf"))
 220       (cat   . ("gtar" "-Oxf"))
 221       (ext   . ("gtar" "-xf"))
 222 ;;;     (rm    . ("gtar" "--delete" "-f")) ;; well not work
 223       )))
 224
 225 ;;; GNU tar (*.tar.gz, *.tar.Z, *.tar.bz2)
 226 (defvar elmo-archive-tgz-method-alist
 227   '((ls         . ("gtar" "-ztf"))
 228     (cat        . ("gtar" "-Ozxf"))
 229     (create     . ("gtar" "-zcf"))
 230 ;;; (rm         . elmo-archive-tgz-rm-func)
 231     (cp         . elmo-archive-tgz-cp-func)
 232     (mv         . elmo-archive-tgz-mv-func)
 233     (ext        . ("gtar" "-zxf"))
 234     ;; tgz special method
 235     (decompress . ("gzip" "-d"))
 236     (compress   . ("gzip"))
 237     (append     . ("gtar" "-uf"))
 238 ;;; (delete     . ("gtar" "--delete" "-f")) ; well not work
 239     ))
 240
 241 (defvar elmo-archive-method-list
 242   '(elmo-archive-lha-method-alist
 243     elmo-archive-zip-method-alist
 244     elmo-archive-zoo-method-alist
 245 ;;; elmo-archive-tar-method-alist
 246     elmo-archive-tgz-method-alist
 247 ;;; elmo-archive-arc-method-alist
 248 ;;; elmo-archive-arj-method-alist
 249     elmo-archive-rar-method-alist))
 250
 251 ;;; Internal vars.
 252 (defvar elmo-archive-method-alist nil)
 253 (defvar elmo-archive-suffixes nil)
 254
 255
 256 ;;; Macro
 257 (defmacro elmo-archive-get-method (type action)
 258   (` (cdr (assq (, action) (cdr (assq (, type)
 259                                       elmo-archive-method-alist))))))
 260
 261 (defmacro elmo-archive-get-suffix (type)
 262   (` (cdr (assq (, type)
 263                 elmo-archive-suffix-alist))))
 264
 265 (defmacro elmo-archive-get-regexp (type)
 266   (` (cdr (assq (, type)
 267                 elmo-archive-file-regexp-alist))))
 268
 269 (defsubst elmo-archive-call-process (prog args &optional output)
 270   (= (apply 'call-process prog nil output nil args) 0))
 271
 272 (defsubst elmo-archive-call-method (method args &optional output)
 273   (cond
 274    ((functionp method)
 275     (funcall method args output))
 276    (t
 277     (elmo-archive-call-process
 278      (car method) (append (cdr method) args) output))))
 279
 280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 281 ;;; Scan Folder
 282
 283 (defsubst elmo-archive-list-folder-subr (folder &optional nonsort)
 284   "*Returns list of number-file(int, not string) in archive FILE.
 285 TYPE specifies the archiver's symbol."
 286   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 287          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 288          (file (elmo-archive-get-archive-name folder))
 289          (method (elmo-archive-get-method type 'ls))
 290          (args (list file))
 291          (file-regexp (format (elmo-archive-get-regexp type)
 292                               (elmo-concat-path (regexp-quote prefix) "")))
 293          (killed (elmo-folder-killed-list-internal folder))
 294          numbers buf file-list header-end)
 295     (if (file-exists-p file)
 296         (with-temp-buffer
 297           (unless (elmo-archive-call-method method args t)
 298             (error "%s exited abnormally!" method))
 299           (goto-char (point-min))
 300           (when (re-search-forward elmo-archive-header-regexp nil t)
 301             (forward-line 1)
 302             (setq header-end (point))
 303             (when (re-search-forward elmo-archive-header-regexp nil t)
 304               (beginning-of-line)
 305               (narrow-to-region header-end (point))
 306               (goto-char (point-min))))
 307           (while (and (re-search-forward file-regexp nil t)
 308                       (not (eobp)))  ; for GNU tar 981010
 309             (setq file-list (nconc file-list (list (string-to-int
 310                                                     (match-string 1)))))))
 311       (error "%s does not exist" file))
 312     (if nonsort
 313         (cons (or (elmo-max-of-list file-list) 0)
 314               (if killed
 315                   (- (length file-list)
 316                      (elmo-msgdb-killed-list-length killed))
 317                 (length file-list)))
 318       (setq numbers (sort file-list '<))
 319       (elmo-living-messages numbers killed))))
 320
 321 (luna-define-method elmo-folder-list-messages-internal ((folder
 322                                                          elmo-archive-folder)
 323                                                         &optional nohide)
 324   (elmo-archive-list-folder-subr folder))
 325
 326 (luna-define-method elmo-folder-status ((folder elmo-archive-folder))
 327   (elmo-archive-list-folder-subr folder t))
 328
 329 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 330 ;;; Folder related functions
 331
 332 (defsubst elmo-archive-get-archive-directory (folder)
 333   ;; allow fullpath. return format is "/foo/bar/".
 334   (if (file-name-absolute-p (elmo-archive-folder-archive-name-internal folder))
 335       (if (find-file-name-handler
 336            (elmo-archive-folder-archive-name-internal folder)
 337            'copy-file)
 338           (elmo-archive-folder-archive-name-internal folder)
 339         (expand-file-name (elmo-archive-folder-archive-name-internal folder)))
 340     (expand-file-name (elmo-archive-folder-archive-name-internal folder)
 341                       elmo-archive-folder-path)))
 342
 343 (defun elmo-archive-get-archive-name (folder)
 344   (let ((dir (elmo-archive-get-archive-directory folder))
 345         (suffix (elmo-archive-get-suffix
 346                  (elmo-archive-folder-archive-type-internal
 347                   folder)))
 348         filename dbdir)
 349     (unless suffix
 350       (error "Unknown archiver type: %s"
 351              (elmo-archive-folder-archive-type-internal folder)))
 352     (if elmo-archive-treat-file
 353         (if (string-match (concat (regexp-quote suffix) "$")
 354                           (elmo-archive-folder-archive-name-internal folder))
 355             (expand-file-name (elmo-archive-folder-archive-name-internal
 356                                folder)
 357                               elmo-archive-folder-path)
 358           (expand-file-name (concat (elmo-archive-folder-archive-name-internal
 359                                      folder)
 360                                     suffix)
 361                             elmo-archive-folder-path))
 362       (if (string-match
 363            "^\\(ange-ftp\\|efs\\)-"
 364            (symbol-name (find-file-name-handler dir 'copy-file)))
 365           ;; ange-ftp, efs
 366           (progn
 367             (setq filename (expand-file-name
 368                             (concat elmo-archive-basename suffix)
 369                             (setq dbdir
 370                                   (elmo-folder-msgdb-path folder))))
 371             (if (file-directory-p dbdir)
 372                 (); ok.
 373               (if (file-exists-p dbdir)
 374                   (error "File %s already exists" dbdir)
 375                 (elmo-make-directory dbdir)))
 376             (if (not (file-exists-p filename))
 377                 (copy-file
 378                  (if (file-directory-p dir)
 379                      (expand-file-name
 380                       (concat elmo-archive-basename suffix)
 381                       dir)
 382                    dir)
 383                  filename))
 384             filename)
 385         (if (or (not (file-exists-p dir))
 386                 (file-directory-p dir))
 387             (expand-file-name
 388              (concat elmo-archive-basename suffix)
 389              dir)
 390           dir)))))
 391
 392 (luna-define-method elmo-folder-exists-p ((folder elmo-archive-folder))
 393   (file-exists-p (elmo-archive-get-archive-name folder)))
 394
 395 (luna-define-method elmo-folder-creatable-p ((folder elmo-archive-folder))
 396   t)
 397
 398 (luna-define-method elmo-folder-writable-p ((folder elmo-archive-folder))
 399   t)
 400
 401 (luna-define-method elmo-folder-create ((folder elmo-archive-folder))
 402   (let* ((dir (directory-file-name      ; remove tail slash.
 403                (elmo-archive-get-archive-directory folder)))
 404          (type (elmo-archive-folder-archive-type-internal folder))
 405          (arc (elmo-archive-get-archive-name folder)))
 406     (if elmo-archive-treat-file
 407         (setq dir (directory-file-name (file-name-directory dir))))
 408     (cond ((and (file-exists-p dir)
 409                 (not (file-directory-p dir)))
 410            ;; file exists
 411            (error "Create folder failed; File \"%s\" exists" dir))
 412           ((file-directory-p dir)
 413            (if (file-exists-p arc)
 414                t                        ; return value
 415              (elmo-archive-create-file arc type folder)))
 416           (t
 417            (elmo-make-directory dir)
 418            (elmo-archive-create-file arc type folder)
 419            t))))
 420
 421 (defun elmo-archive-create-file (archive type folder)
 422   (save-excursion
 423     (let* ((tmp-dir (directory-file-name
 424                      (elmo-folder-msgdb-path folder)))
 425            (dummy elmo-archive-dummy-file)
 426            (method (or (elmo-archive-get-method type 'create)
 427                        (elmo-archive-get-method type 'mv)))
 428            (args (list archive dummy)))
 429       (when (null method)
 430         (ding)
 431         (error "WARNING: read-only mode: %s (method undefined)" type))
 432       (cond
 433        ((file-directory-p tmp-dir)
 434         ()) ;nop
 435        ((file-exists-p tmp-dir)
 436         ;; file exists
 437         (error "Create directory failed; File \"%s\" exists" tmp-dir))
 438        (t
 439         (elmo-make-directory tmp-dir)))
 440       (elmo-bind-directory
 441        tmp-dir
 442        (write-region (point) (point) dummy nil 'no-msg)
 443        (prog1
 444            (elmo-archive-call-method method args)
 445          (if (file-exists-p dummy)
 446              (delete-file dummy)))
 447        ))))
 448
 449 (luna-define-method elmo-folder-delete ((folder elmo-archive-folder))
 450   (let ((msgs (and (elmo-folder-exists-p folder)
 451                    (elmo-folder-list-messages folder))))
 452     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
 453                                (if (> (length msgs) 0)
 454                                    (format "%d msg(s) exists. " (length msgs))
 455                                  "")
 456                                (elmo-folder-name-internal folder)))
 457       (let ((arc (elmo-archive-get-archive-name folder)))
 458         (if (not (file-exists-p arc))
 459             (error "No such file: %s" arc)
 460           (delete-file arc))
 461         (elmo-msgdb-delete-path folder)
 462         t))))
 463
 464 (luna-define-method elmo-folder-rename-internal ((folder elmo-archive-folder)
 465                                                  new-folder)
 466   (let* ((old-arc (elmo-archive-get-archive-name folder))
 467          (new-arc (elmo-archive-get-archive-name new-folder))
 468          (new-dir (directory-file-name
 469                    (elmo-archive-get-archive-directory new-folder))))
 470     (if elmo-archive-treat-file
 471         (setq new-dir (directory-file-name (file-name-directory new-dir))))
 472     (unless (and (eq (elmo-archive-folder-archive-type-internal folder)
 473                      (elmo-archive-folder-archive-type-internal new-folder))
 474                  (equal (elmo-archive-folder-archive-prefix-internal
 475                          folder)
 476                         (elmo-archive-folder-archive-prefix-internal
 477                          new-folder)))
 478       (error "Not same archive type and prefix"))
 479     (unless (file-exists-p old-arc)
 480       (error "No such file: %s" old-arc))
 481     (when (file-exists-p new-arc)
 482       (error "Already exists: %s" new-arc))
 483     (unless (file-directory-p new-dir)
 484       (elmo-make-directory new-dir))
 485     (rename-file old-arc new-arc)
 486     t))
 487
 488 (defun elmo-archive-folder-list-subfolders (folder one-level)
 489   (if elmo-archive-treat-file
 490       (let* ((path (elmo-archive-get-archive-directory folder))
 491              (base-folder (or (elmo-archive-folder-archive-name-internal
 492                                folder)
 493                               ""))
 494              (suffix (elmo-archive-folder-archive-type-internal folder))
 495              (prefix (if (string=
 496                           (elmo-archive-folder-archive-prefix-internal folder)
 497                           "")
 498                          ""
 499                        (concat ";"
 500                                (elmo-archive-folder-archive-prefix-internal
 501                                 folder))))
 502              (dir (if (file-directory-p path)
 503                       path (file-name-directory path)))
 504              (name (if (file-directory-p path)
 505                        "" (file-name-nondirectory path)))
 506              (flist (and (file-directory-p dir)
 507                          (directory-files dir nil
 508                                           (if (> (length name) 0)
 509                                               (concat "^" name "[^A-z][^A-z]")
 510                                             name)
 511                                           nil)))
 512              (regexp (format "^\\(.*\\)\\(%s\\)$"
 513                              (mapconcat
 514                               '(lambda (x) (regexp-quote (cdr x)))
 515                               elmo-archive-suffix-alist
 516                               "\\|"))))
 517         (if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'.
 518             (setq base-folder (elmo-match-string 1 base-folder))
 519           (unless (file-directory-p path)
 520             (setq base-folder (or (file-name-directory base-folder) ""))))
 521         (delq
 522          nil
 523          (mapcar
 524           '(lambda (x)
 525              (when (and (string-match regexp x)
 526                         (eq suffix
 527                             (car
 528                              (rassoc (elmo-match-string 2 x)
 529                                      elmo-archive-suffix-alist))))
 530                (format "%s%s;%s%s"
 531                        (elmo-folder-prefix-internal folder)
 532                        (elmo-concat-path base-folder (elmo-match-string 1 x))
 533                        suffix prefix)))
 534           flist)))
 535     (elmo-mapcar-list-of-list
 536      (function (lambda (x)
 537                  (if (file-exists-p
 538                       (expand-file-name
 539                        (concat elmo-archive-basename
 540                                (elmo-archive-get-suffix
 541                                 (elmo-archive-folder-archive-type-internal
 542                                  folder)))
 543                        (expand-file-name
 544                         x
 545                         (elmo-archive-folder-path folder))))
 546                      (concat (elmo-folder-prefix-internal folder) x))))
 547      (elmo-list-subdirectories
 548       (elmo-archive-folder-path folder)
 549       (or (elmo-archive-folder-dir-name-internal folder) "")
 550       one-level))))
 551
 552 (luna-define-method elmo-folder-list-subfolders ((folder elmo-archive-folder)
 553                                                  &optional one-level)
 554   (elmo-archive-folder-list-subfolders folder one-level))
 555
 556 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 557 ;;; Article file related functions
 558 ;;; read(extract) / append(move) / delete(delete) / query(list)
 559
 560 (defsubst elmo-archive-message-fetch-internal (folder number)
 561   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 562          (arc (elmo-archive-get-archive-name folder))
 563          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 564          (method (elmo-archive-get-method type 'cat))
 565          (args (list arc (elmo-concat-path
 566                           prefix (int-to-string number)))))
 567     (and (file-exists-p arc)
 568          (as-binary-process
 569           (elmo-archive-call-method method args t))
 570          (progn
 571            (elmo-delete-cr-buffer)
 572            t))))
 573
 574 (luna-define-method elmo-message-fetch-internal ((folder elmo-archive-folder)
 575                                                  number strategy
 576                                                  &optional section unseen)
 577   (elmo-archive-message-fetch-internal folder number))
 578
 579 (luna-define-method elmo-folder-append-buffer ((folder elmo-archive-folder)
 580                                                &optional flags number)
 581   (elmo-archive-folder-append-buffer folder flags number))
 582
 583 ;; verrrrrry slow!!
 584 (defun elmo-archive-folder-append-buffer (folder flags number)
 585   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 586          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 587          (arc (elmo-archive-get-archive-name folder))
 588          (method (elmo-archive-get-method type 'mv))
 589          (next-num (or number
 590                        (1+ (if (file-exists-p arc)
 591                                (car
 592                                 (elmo-folder-status folder)) 0))))
 593          (tmp-dir (elmo-folder-msgdb-path folder))
 594          (src-buffer (current-buffer))
 595          dst-buffer
 596          newfile)
 597     (when (null method)
 598       (ding)
 599       (error "WARNING: read-only mode: %s (method undefined)" type))
 600     (with-temp-buffer
 601       (let ((tmp-dir (expand-file-name prefix tmp-dir)))
 602         (when (not (file-directory-p tmp-dir))
 603           (elmo-make-directory (directory-file-name tmp-dir))))
 604       (setq newfile (elmo-concat-path
 605                      prefix
 606                      (int-to-string next-num)))
 607       (elmo-bind-directory
 608        tmp-dir
 609        (if (and (or (functionp method) (car method))
 610                 (file-writable-p newfile))
 611            (progn
 612              (setq dst-buffer (current-buffer))
 613              (with-current-buffer src-buffer
 614                (copy-to-buffer dst-buffer (point-min) (point-max)))
 615              (as-binary-output-file
 616                   (write-region (point-min) (point-max) newfile nil 'no-msg))
 617              (when (elmo-archive-call-method method (list arc newfile))
 618                (elmo-folder-preserve-flags
 619                 folder
 620                 (with-current-buffer src-buffer
 621                   (elmo-msgdb-get-message-id-from-buffer))
 622                 flags)
 623                t))
 624          nil)))))
 625
 626 (luna-define-method elmo-folder-append-messages :around
 627   ((folder elmo-archive-folder) src-folder numbers &optional same-number)
 628   (let ((prefix (elmo-archive-folder-archive-prefix-internal folder)))
 629     (cond
 630      ((and same-number
 631            (null prefix)
 632            (elmo-folder-message-file-p src-folder)
 633            (elmo-folder-message-file-number-p src-folder))
 634       ;; same-number(localdir, localnews) -> archive
 635       (unless (elmo-archive-append-files folder
 636                                          (elmo-folder-message-file-directory src-folder)
 637                                          numbers)
 638         (setq numbers nil))
 639       (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
 640       numbers)
 641      ((elmo-folder-message-make-temp-file-p src-folder)
 642       ;; not-same-number (localdir, localnews), (archive maildir) -> archive
 643       (let ((temp-dir (elmo-folder-message-make-temp-files
 644                        src-folder
 645                        numbers
 646                        (unless same-number
 647                          (1+ (if (file-exists-p (elmo-archive-get-archive-name
 648                                                  folder))
 649                                  (car (elmo-folder-status folder)) 0)))))
 650             new-dir base-dir files)
 651         (setq base-dir temp-dir)
 652         (when (> (length prefix) 0)
 653           (when (file-name-directory prefix)
 654             (elmo-make-directory (file-name-directory prefix)))
 655           (rename-file
 656            temp-dir
 657            (setq new-dir
 658                  (expand-file-name
 659                   prefix
 660                   ;; parent of temp-dir..(works in windows?)
 661                   (expand-file-name ".." temp-dir))))
 662           ;; now temp-dir has name prefix.
 663           (setq temp-dir new-dir)
 664           ;; parent of prefix becomes base-dir.
 665           (setq base-dir (expand-file-name ".." temp-dir)))
 666         (setq files
 667               (mapcar
 668                '(lambda (x) (elmo-concat-path prefix x))
 669                (directory-files temp-dir nil "^[^\\.]")))
 670         (if (elmo-archive-append-files folder
 671                                        base-dir
 672                                        files)
 673             (elmo-delete-directory temp-dir)
 674           (setq numbers nil)))
 675       (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
 676       numbers)
 677      (t (luna-call-next-method)))))
 678
 679 (luna-define-method elmo-folder-message-make-temp-file-p
 680   ((folder elmo-archive-folder))
 681   (let ((type (elmo-archive-folder-archive-type-internal folder)))
 682     (or (elmo-archive-get-method type 'ext-pipe)
 683         (elmo-archive-get-method type 'ext))))
 684
 685 (luna-define-method elmo-folder-message-make-temp-files
 686   ((folder elmo-archive-folder) numbers
 687    &optional start-number)
 688   (elmo-archive-folder-message-make-temp-files folder numbers start-number))
 689
 690 (defun elmo-archive-folder-message-make-temp-files (folder
 691                                                     numbers
 692                                                     start-number)
 693   (let* ((tmp-dir-src (elmo-folder-make-temporary-directory folder))
 694          (tmp-dir-dst (elmo-folder-make-temporary-directory folder))
 695          (arc     (elmo-archive-get-archive-name folder))
 696          (type    (elmo-archive-folder-archive-type-internal folder))
 697          (prefix  (elmo-archive-folder-archive-prefix-internal folder))
 698          (p-method (elmo-archive-get-method type 'ext-pipe))
 699          (n-method (elmo-archive-get-method type 'ext))
 700          (tmp-msgs (mapcar (lambda (x) (elmo-concat-path
 701                                         prefix
 702                                         (int-to-string x))) numbers))
 703          number)
 704     ;; Expand files in the tmp-dir-src.
 705     (elmo-bind-directory
 706      tmp-dir-src
 707      (cond
 708       ((functionp n-method)
 709        (funcall n-method (cons arc tmp-msgs)))
 710       (p-method
 711        (let ((p-prog (car p-method))
 712              (p-prog-arg (cdr p-method)))
 713          (elmo-archive-exec-msgs-subr1
 714           p-prog (append p-prog-arg (list arc)) tmp-msgs)))
 715       (t
 716        (let ((n-prog (car n-method))
 717              (n-prog-arg (cdr n-method)))
 718          (elmo-archive-exec-msgs-subr2
 719           n-prog (append n-prog-arg (list arc)) tmp-msgs
 720           (length arc))))))
 721     ;; Move files to the tmp-dir-dst.
 722     (setq number start-number)
 723     (dolist (tmp-file tmp-msgs)
 724       (rename-file (expand-file-name
 725                     tmp-file
 726                     tmp-dir-src)
 727                    (expand-file-name
 728                     (if start-number
 729                         (int-to-string number)
 730                       (file-name-nondirectory tmp-file))
 731                     tmp-dir-dst))
 732       (if start-number (incf number)))
 733     ;; Remove tmp-dir-src.
 734     (elmo-delete-directory tmp-dir-src)
 735     ;; tmp-dir-dst is the return directory.
 736     tmp-dir-dst))
 737
 738 (defun elmo-archive-append-files (folder dir &optional files)
 739   (let* ((dst-type (elmo-archive-folder-archive-type-internal folder))
 740          (arc (elmo-archive-get-archive-name folder))
 741          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 742          (p-method (elmo-archive-get-method dst-type 'cp-pipe))
 743          (n-method (elmo-archive-get-method dst-type 'cp))
 744          src tmp newfile)
 745     (unless (elmo-folder-exists-p folder) (elmo-folder-create folder))
 746     (unless files (setq files (directory-files dir nil "^[^\\.]")))
 747     (when (null (or p-method n-method))
 748       (ding)
 749       (error "WARNING: read-only mode: %s (method undefined)" dst-type))
 750     (save-excursion
 751       (elmo-bind-directory
 752        dir
 753        (cond
 754         ((functionp n-method)
 755          (funcall n-method (cons arc files)))
 756         (p-method
 757          (let ((p-prog (car p-method))
 758                (p-prog-arg (cdr p-method)))
 759            (elmo-archive-exec-msgs-subr1
 760             p-prog (append p-prog-arg (list arc)) files)))
 761         (t
 762          (let ((n-prog (car n-method))
 763                (n-prog-arg (cdr n-method)))
 764            (elmo-archive-exec-msgs-subr2
 765             n-prog (append n-prog-arg (list arc)) files (length arc)))))))))
 766
 767 (luna-define-method elmo-folder-delete-messages-internal ((folder
 768                                                            elmo-archive-folder)
 769                                                           numbers)
 770   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 771          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 772          (arc (elmo-archive-get-archive-name folder))
 773          (p-method (elmo-archive-get-method type 'rm-pipe))
 774          (n-method (elmo-archive-get-method type 'rm))
 775          (numbers (mapcar '(lambda (x) (elmo-concat-path
 776                                         prefix
 777                                         (int-to-string x)))
 778                           numbers)))
 779     (cond ((functionp n-method)
 780            (funcall n-method (cons arc numbers)))
 781           (p-method
 782            (let ((p-prog (car p-method))
 783                  (p-prog-arg (cdr p-method)))
 784              (elmo-archive-exec-msgs-subr1
 785               p-prog (append p-prog-arg (list arc)) numbers)))
 786           (n-method
 787            (let ((n-prog (car n-method))
 788                  (n-prog-arg (cdr n-method)))
 789              (elmo-archive-exec-msgs-subr2
 790               n-prog (append n-prog-arg (list arc)) numbers (length arc))))
 791           (t
 792            (ding)
 793            (error "WARNING: not delete: %s (method undefined)" type)))))
 794
 795 (defun elmo-archive-exec-msgs-subr1 (prog args msgs)
 796   (with-temp-buffer
 797     (insert (mapconcat 'concat msgs "\n")) ;string
 798     (= 0 (apply 'call-process-region (point-min) (point-max)
 799                 prog nil nil nil args))))
 800
 801 (defun elmo-archive-exec-msgs-subr2 (prog args msgs arc-length)
 802   (let ((max-len (- elmo-archive-cmdstr-max-length arc-length))
 803         (n (length msgs))
 804         rest i sum)
 805     (setq rest msgs) ;string
 806     (setq i 1)
 807     (setq sum 0)
 808     (catch 'done
 809       (while (and rest (<= i n))
 810         (mapcar '(lambda (x)
 811                    (let* ((len (length x))
 812                           (files (member x (reverse rest))))
 813                      ;; total(previous) + current + white space
 814                      (if (<= max-len (+ sum len 1))
 815                          (progn
 816                            (unless
 817                                (elmo-archive-call-process
 818                                 prog (append args files))
 819                              (throw 'done nil))
 820                            (setq sum 0) ;; reset
 821                            (setq rest (nthcdr i rest)))
 822                        (setq sum (+ sum len 1)))
 823                      (setq i (1+ i)))) msgs))
 824       (throw 'done
 825              (or (not rest)
 826                  (elmo-archive-call-process prog (append args rest))))
 827       )))
 828
 829 (defsubst elmo-archive-article-exists-p (arc msg type)
 830   (if (not elmo-archive-check-existance-strict)
 831       t ; nop
 832     (save-excursion ; added 980915
 833       (let* ((method (elmo-archive-get-method type 'ls))
 834              (args (list arc msg))
 835              (buf (get-buffer-create " *ELMO ARCHIVE query*"))
 836              (error-msg "\\(no file\\|0 files\\)")
 837              ret-val)
 838         (set-buffer buf)
 839         (erase-buffer)
 840         (elmo-archive-call-method method args t)
 841         ;; pointer: point-max
 842         (setq ret-val (not (re-search-backward error-msg nil t)))
 843         (kill-buffer buf)
 844         ret-val))))
 845
 846 (defun elmo-archive-tgz-common-func (args exec-type &optional copy)
 847   (let* ((arc (car args))
 848          (tmp-msgs (cdr args))
 849          (decompress (elmo-archive-get-method 'tgz 'decompress))
 850          (compress (elmo-archive-get-method 'tgz 'compress))
 851          (exec (elmo-archive-get-method 'tgz exec-type))
 852          (suffix (elmo-archive-get-suffix 'tgz))
 853          (tar-suffix (elmo-archive-get-suffix 'tar))
 854          arc-tar ret-val
 855          )
 856     (when (null (and decompress compress exec))
 857       (ding)
 858       (error "WARNING: special method undefined: %s of %s"
 859              (or (if (null decompress) 'decompress)
 860                  (if (null compress) 'compress)
 861                  (if (null exec) exec-type))
 862              'tgz))
 863     (unless tar-suffix
 864       (ding)
 865       (error "WARNING: `tar' suffix undefined"))
 866     (if (string-match (concat (regexp-quote suffix) "$") arc)
 867         (setq arc-tar
 868               (concat (substring arc 0 (match-beginning 0)) tar-suffix))
 869       (error "%s: not match suffix [%s]" arc suffix))
 870     (and
 871      ;; decompress
 872      (elmo-archive-call-process
 873       (car decompress) (append (cdr decompress) (list arc)))
 874      ;; append (or delete)
 875      (elmo-archive-exec-msgs-subr2
 876       (car exec) (append (cdr exec) (list arc-tar)) tmp-msgs (length arc-tar))
 877      ;; compress
 878      (setq ret-val
 879            (elmo-archive-call-process
 880             (car compress) (append (cdr compress) (list arc-tar)))))
 881     ;; delete temporary messages
 882     (if (and (not copy)
 883              (eq exec-type 'append))
 884         (while tmp-msgs
 885           (if (file-exists-p (car tmp-msgs))
 886               (delete-file (car tmp-msgs)))
 887           (setq tmp-msgs (cdr tmp-msgs))))
 888     ret-val))
 889
 890 (defun elmo-archive-tgz-cp-func (args &optional output)
 891   (elmo-archive-tgz-common-func args 'append t))
 892
 893 (defun elmo-archive-tgz-mv-func (args &optional output)
 894   (elmo-archive-tgz-common-func args 'append))
 895
 896 (defun elmo-archive-tgz-rm-func (args &optional output)
 897   (elmo-archive-tgz-common-func args 'delete))
 898
 899 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 900 ;;; MessageDB functions (from elmo-localdir.el)
 901
 902 (defsubst elmo-archive-msgdb-create-entity-subr (msgdb number)
 903   (let (header-end)
 904     (set-buffer-multibyte default-enable-multibyte-characters)
 905     (goto-char (point-min))
 906     (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 907         (setq header-end (point))
 908       (setq header-end (point-max)))
 909     (narrow-to-region (point-min) header-end)
 910     (elmo-msgdb-create-message-entity-from-buffer
 911      (elmo-msgdb-message-entity-handler msgdb) number)))
 912
 913 ;; verrrry slow!!
 914 (defsubst elmo-archive-msgdb-create-entity (msgdb
 915                                             method
 916                                             archive number type
 917                                             &optional prefix)
 918   (let* ((msg (elmo-concat-path prefix (int-to-string number)))
 919          (arg-list (list archive msg)))
 920     (when (elmo-archive-article-exists-p archive msg type)
 921       ;; insert article.
 922       (as-binary-process
 923        (elmo-archive-call-method method arg-list t))
 924       (elmo-archive-msgdb-create-entity-subr msgdb number))))
 925
 926 (luna-define-method elmo-folder-msgdb-create ((folder elmo-archive-folder)
 927                                               numbers flag-table)
 928   (when numbers
 929     (save-excursion ;; 981005
 930       (if (and elmo-archive-use-izip-agent
 931                (elmo-archive-get-method
 932                 (elmo-archive-folder-archive-type-internal folder)
 933                 'cat-headers))
 934           (elmo-archive-msgdb-create-as-numlist-subr2
 935            folder numbers flag-table)
 936         (elmo-archive-msgdb-create-as-numlist-subr1
 937          folder numbers flag-table)))))
 938
 939 (defun elmo-archive-msgdb-create-as-numlist-subr1 (folder numlist flag-table)
 940   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 941          (file (elmo-archive-get-archive-name folder))
 942          (method (elmo-archive-get-method type 'cat))
 943          (new-msgdb (elmo-make-msgdb))
 944          entity i percent num message-id flags)
 945     (with-temp-buffer
 946       (setq num (length numlist))
 947       (setq i 0)
 948       (message "Creating msgdb...")
 949       (while numlist
 950         (erase-buffer)
 951         (setq entity
 952               (elmo-archive-msgdb-create-entity
 953                new-msgdb
 954                method file (car numlist) type
 955                (elmo-archive-folder-archive-prefix-internal folder)))
 956         (when entity
 957           (setq message-id (elmo-message-entity-field entity 'message-id)
 958                 flags (elmo-flag-table-get flag-table message-id))
 959           (elmo-global-flags-set flags folder (car numlist) message-id)
 960           (elmo-msgdb-append-entity new-msgdb entity flags))
 961         (when (> num elmo-display-progress-threshold)
 962           (setq i (1+ i))
 963           (setq percent (/ (* i 100) num))
 964           (elmo-display-progress
 965            'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..."
 966            percent))
 967         (setq numlist (cdr numlist)))
 968       (message "Creating msgdb...done")
 969       new-msgdb)))
 970
 971 ;;; info-zip agent
 972 (defun elmo-archive-msgdb-create-as-numlist-subr2 (folder
 973                                                    numlist
 974                                                    flag-table)
 975   (let* ((delim1 elmo-mmdf-delimiter)           ;; MMDF
 976          (delim2 elmo-unixmail-delimiter)       ;; UNIX Mail
 977          (type (elmo-archive-folder-archive-type-internal folder))
 978          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 979          (method (elmo-archive-get-method type 'cat-headers))
 980          (prog (car method))
 981          (args (cdr method))
 982          (arc (elmo-archive-get-archive-name folder))
 983          (new-msgdb (elmo-make-msgdb))
 984          n i percent num msgs case-fold-search)
 985     (with-temp-buffer
 986       (setq num (length numlist))
 987       (setq i 0)
 988       (message "Creating msgdb...")
 989       (while numlist
 990         (setq n (min (1- elmo-archive-fetch-headers-volume)
 991                      (1- (length numlist))))
 992         (setq msgs (reverse (memq (nth n numlist) (reverse numlist))))
 993         (setq numlist (nthcdr (1+ n) numlist))
 994         (erase-buffer)
 995         (insert
 996          (mapconcat
 997           'concat
 998           (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs)
 999           "\n"))
1000         (message "Fetching headers...")
1001         (as-binary-process (apply 'call-process-region
1002                                   (point-min) (point-max)
1003                                   prog t t nil (append args (list arc))))
1004         (goto-char (point-min))
1005         (cond
1006          ((looking-at delim1)   ;; MMDF
1007           (elmo-msgdb-append
1008            new-msgdb
1009            (elmo-archive-parse-mmdf folder msgs flag-table)))
1010 ;;;      ((looking-at delim2)   ;; UNIX MAIL
1011 ;;;       (elmo-msgdb-append
1012 ;;;        new-msgdb
1013 ;;;        (elmo-archive-parse-unixmail msgs flag-table)))
1014          (t                     ;; unknown format
1015           (error "Unknown format!")))
1016         (when (> num elmo-display-progress-threshold)
1017           (setq i (+ n i))
1018           (setq percent (/ (* i 100) num))
1019           (elmo-display-progress
1020            'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..."
1021            percent))))
1022     new-msgdb))
1023
1024 (defun elmo-archive-parse-mmdf (folder msgs flag-table)
1025   (let ((delim elmo-mmdf-delimiter)
1026         (new-msgdb (elmo-make-msgdb))
1027         number sp ep rest entity
1028         message-id flags)
1029     (goto-char (point-min))
1030     (setq rest msgs)
1031     (while (and rest (re-search-forward delim nil t)
1032                 (not (eobp)))
1033       (setq number (car rest))
1034       (setq sp (1+ (point)))
1035       (setq ep (prog2 (re-search-forward delim)
1036                    (1+ (- (point) (length delim)))))
1037       (if (>= sp ep)                    ; no article!
1038           ()                            ; nop
1039         (save-excursion
1040           (narrow-to-region sp ep)
1041           (setq entity (elmo-archive-msgdb-create-entity-subr new-msgdb number)
1042                 message-id (elmo-message-entity-field entity 'message-id)
1043                 flags (elmo-flag-table-get flag-table message-id))
1044           (elmo-global-flags-set flags folder number message-id)
1045           (elmo-msgdb-append-entity new-msgdb entity flags)
1046           (widen)))
1047       (forward-line 1)
1048       (setq rest (cdr rest)))
1049     new-msgdb))
1050
1051
1052 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1053 ;;; Search functions
1054
1055 (defsubst elmo-archive-field-condition-match (folder number number-list
1056                                                      condition prefix)
1057   (save-excursion
1058     (let* ((type (elmo-archive-folder-archive-type-internal folder))
1059            (arc (elmo-archive-get-archive-name folder))
1060            (method (elmo-archive-get-method type 'cat))
1061            (args (list arc (elmo-concat-path prefix (int-to-string number)))))
1062       (elmo-set-work-buf
1063        (when (file-exists-p arc)
1064          (as-binary-process
1065           (elmo-archive-call-method method args t))
1066          (set-buffer-multibyte default-enable-multibyte-characters)
1067          (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
1068          (elmo-message-buffer-match-condition condition number))))))
1069
1070 (luna-define-method elmo-folder-search ((folder elmo-archive-folder)
1071                                         condition &optional from-msgs)
1072   (let* (;;(args (elmo-string-to-list key))
1073          ;; XXX: I don't know whether `elmo-archive-list-folder'
1074          ;;      updates match-data.
1075          ;; (msgs (or from-msgs (elmo-archive-list-folder spec)))
1076          (msgs (or from-msgs (elmo-folder-list-messages folder)))
1077          (num (length msgs))
1078          (i 0)
1079          (case-fold-search nil)
1080          number-list ret-val)
1081     (setq number-list msgs)
1082     (while msgs
1083       (if (elmo-archive-field-condition-match
1084            folder (car msgs) number-list
1085            condition
1086            (elmo-archive-folder-archive-prefix-internal folder))
1087           (setq ret-val (cons (car msgs) ret-val)))
1088       (when (> num elmo-display-progress-threshold)
1089         (setq i (1+ i))
1090         (elmo-display-progress
1091          'elmo-archive-search "Searching..."
1092          (/ (* i 100) num)))
1093       (setq msgs (cdr msgs)))
1094     (nreverse ret-val)))
1095
1096 ;;; method(alist)
1097 (if (null elmo-archive-method-alist)
1098     (let ((mlist elmo-archive-method-list) ; from mew-highlight.el
1099           method type str)
1100       (while mlist
1101         (setq method (car mlist))
1102         (setq mlist (cdr mlist))
1103         (setq str (symbol-name method))
1104         (string-match "elmo-archive-\\([^-].*\\)-method-alist$" str)
1105         (setq type (intern-soft
1106                     (elmo-match-string 1 str)))
1107         (setq elmo-archive-method-alist
1108               (cons (cons type
1109                           (symbol-value method))
1110                     elmo-archive-method-alist)))))
1111
1112 ;;; valid suffix(list)
1113 (if (null elmo-archive-suffixes)
1114     (let ((slist elmo-archive-suffix-alist)
1115           tmp)
1116       (while slist
1117         (setq tmp (car slist))
1118         (setq elmo-archive-suffixes
1119               (nconc elmo-archive-suffixes (list (cdr tmp))))
1120         (setq slist (cdr slist)))))
1121
1122 (luna-define-method elmo-message-use-cache-p ((folder elmo-archive-folder)
1123                                               number)
1124   elmo-archive-use-cache)
1125
1126 ;;; End
1127 (run-hooks 'elmo-archive-load-hook)
1128
1129 (require 'product)
1130 (product-provide (provide 'elmo-archive) (require 'elmo-version))
1131
1132 ;;; elmo-archive.el ends here