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