elmo/elmo-archive.el

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