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-dir)))
 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 (static-if (boundp 'NEMACS)
 264     (defsubst elmo-archive-call-process (prog args &optional output)
 265       (apply 'call-process prog nil output nil args)
 266       0)
 267   (defsubst elmo-archive-call-process (prog args &optional output)
 268     (= (apply 'call-process prog nil output nil args) 0)))
 269
 270 (defsubst elmo-archive-call-method (method args &optional output)
 271   (cond
 272    ((functionp method)
 273     (funcall method args output))
 274    (t
 275     (elmo-archive-call-process
 276      (car method) (append (cdr method) args) output))))
 277
 278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 279 ;;; Scan Folder
 280
 281 (defsubst elmo-archive-list-folder-subr (folder &optional nonsort)
 282   "*Returns list of number-file(int, not string) in archive FILE.
 283 TYPE specifies the archiver's symbol."
 284   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 285          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 286          (file (elmo-archive-get-archive-name folder))
 287          (method (elmo-archive-get-method type 'ls))
 288          (args (list file))
 289          (file-regexp (format (elmo-archive-get-regexp type)
 290                               (elmo-concat-path (regexp-quote prefix) "")))
 291          (killed (elmo-folder-killed-list-internal folder))
 292          numbers buf file-list header-end)
 293     (if (file-exists-p file)
 294         (with-temp-buffer
 295           (unless (elmo-archive-call-method method args t)
 296             (error "%s exited abnormally!" method))
 297           (goto-char (point-min))
 298           (when (re-search-forward elmo-archive-header-regexp nil t)
 299             (forward-line 1)
 300             (setq header-end (point))
 301             (when (re-search-forward elmo-archive-header-regexp nil t)
 302               (beginning-of-line)
 303               (narrow-to-region header-end (point))
 304               (goto-char (point-min))))
 305           (while (and (re-search-forward file-regexp nil t)
 306                       (not (eobp)))  ; for GNU tar 981010
 307             (setq file-list (nconc file-list (list (string-to-int
 308                                                     (match-string 1)))))))
 309       (error "%s does not exist." file))
 310     (if nonsort
 311         (cons (or (elmo-max-of-list file-list) 0)
 312               (if killed
 313                   (- (length file-list)
 314                      (elmo-msgdb-killed-list-length killed))
 315                 (length file-list)))
 316       (setq numbers (sort file-list '<))
 317       (elmo-living-messages numbers killed))))
 318
 319 (luna-define-method elmo-folder-list-messages-internal ((folder
 320                                                          elmo-archive-folder)
 321                                                         &optional nohide)
 322   (elmo-archive-list-folder-subr folder))
 323
 324 (luna-define-method elmo-folder-status ((folder elmo-archive-folder))
 325   (elmo-archive-list-folder-subr folder t))
 326
 327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 328 ;;; Folder related functions
 329
 330 (defsubst elmo-archive-get-archive-directory (folder)
 331   ;; allow fullpath. return format is "/foo/bar/".
 332   (if (file-name-absolute-p (elmo-archive-folder-archive-name-internal folder))
 333       (if (find-file-name-handler
 334            (elmo-archive-folder-archive-name-internal folder)
 335            'copy-file)
 336           (elmo-archive-folder-archive-name-internal folder)
 337         (expand-file-name (elmo-archive-folder-archive-name-internal folder)))
 338     (expand-file-name (elmo-archive-folder-archive-name-internal folder)
 339                       elmo-archive-folder-path)))
 340
 341 (defun elmo-archive-get-archive-name (folder)
 342   (let ((dir (elmo-archive-get-archive-directory folder))
 343         (suffix (elmo-archive-get-suffix
 344                  (elmo-archive-folder-archive-type-internal
 345                   folder)))
 346         filename dbdir)
 347     (unless suffix
 348       (error "Unknown archiver type: %s"
 349              (elmo-archive-folder-archive-type-internal folder)))
 350     (if elmo-archive-treat-file
 351         (if (string-match (concat (regexp-quote suffix) "$")
 352                           (elmo-archive-folder-archive-name-internal folder))
 353             (expand-file-name (elmo-archive-folder-archive-name-internal
 354                                folder)
 355                               elmo-archive-folder-path)
 356           (expand-file-name (concat (elmo-archive-folder-archive-name-internal
 357                                      folder)
 358                                     suffix)
 359                             elmo-archive-folder-path))
 360       (if (string-match
 361            "^\\(ange-ftp\\|efs\\)-"
 362            (symbol-name (find-file-name-handler dir 'copy-file)))
 363           ;; ange-ftp, efs
 364           (progn
 365             (setq filename (expand-file-name
 366                             (concat elmo-archive-basename suffix)
 367                             (setq dbdir
 368                                   (elmo-folder-msgdb-path folder))))
 369             (if (file-directory-p dbdir)
 370                 (); ok.
 371               (if (file-exists-p dbdir)
 372                   (error "File %s already exists" dbdir)
 373                 (elmo-make-directory dbdir)))
 374             (if (not (file-exists-p filename))
 375                 (copy-file
 376                  (if (file-directory-p dir)
 377                      (expand-file-name
 378                       (concat elmo-archive-basename suffix)
 379                       dir)
 380                    dir)
 381                  filename))
 382             filename)
 383         (if (or (not (file-exists-p dir))
 384                 (file-directory-p dir))
 385             (expand-file-name
 386              (concat elmo-archive-basename suffix)
 387              dir)
 388           dir)))))
 389
 390 (luna-define-method elmo-folder-exists-p ((folder elmo-archive-folder))
 391   (file-exists-p (elmo-archive-get-archive-name folder)))
 392
 393 (luna-define-method elmo-folder-creatable-p ((folder elmo-archive-folder))
 394   t)
 395
 396 (luna-define-method elmo-folder-writable-p ((folder elmo-archive-folder))
 397   t)
 398
 399 (luna-define-method elmo-folder-create ((folder elmo-archive-folder))
 400   (let* ((dir (directory-file-name      ; remove tail slash.
 401                (elmo-archive-get-archive-directory folder)))
 402          (type (elmo-archive-folder-archive-type-internal folder))
 403          (arc (elmo-archive-get-archive-name folder)))
 404     (if elmo-archive-treat-file
 405         (setq dir (directory-file-name (file-name-directory dir))))
 406     (cond ((and (file-exists-p dir)
 407                 (not (file-directory-p dir)))
 408            ;; file exists
 409            (error "Create folder failed; File \"%s\" exists" dir))
 410           ((file-directory-p dir)
 411            (if (file-exists-p arc)
 412                t                        ; return value
 413              (elmo-archive-create-file arc type folder)))
 414           (t
 415            (elmo-make-directory dir)
 416            (elmo-archive-create-file arc type folder)
 417            t))))
 418
 419 (defun elmo-archive-create-file (archive type folder)
 420   (save-excursion
 421     (let* ((tmp-dir (directory-file-name
 422                      (elmo-folder-msgdb-path folder)))
 423            (dummy elmo-archive-dummy-file)
 424            (method (or (elmo-archive-get-method type 'create)
 425                        (elmo-archive-get-method type 'mv)))
 426            (args (list archive dummy)))
 427       (when (null method)
 428         (ding)
 429         (error "WARNING: read-only mode: %s (method undefined)" type))
 430       (cond
 431        ((file-directory-p tmp-dir)
 432         ()) ;nop
 433        ((file-exists-p tmp-dir)
 434         ;; file exists
 435         (error "Create directory failed; File \"%s\" exists" tmp-dir))
 436        (t
 437         (elmo-make-directory tmp-dir)))
 438       (elmo-bind-directory
 439        tmp-dir
 440        (write-region (point) (point) dummy nil 'no-msg)
 441        (prog1
 442            (elmo-archive-call-method method args)
 443          (if (file-exists-p dummy)
 444              (delete-file dummy)))
 445        ))))
 446
 447 (luna-define-method elmo-folder-delete ((folder elmo-archive-folder))
 448   (let ((arc (elmo-archive-get-archive-name folder)))
 449     (if (not (file-exists-p arc))
 450         (error "No such file: %s" arc)
 451       (delete-file arc)
 452       t)))
 453
 454 (luna-define-method elmo-folder-rename-internal ((folder elmo-archive-folder)
 455                                                  new-folder)
 456   (let* ((old-arc (elmo-archive-get-archive-name folder))
 457          (new-arc (elmo-archive-get-archive-name new-folder)))
 458     (unless (and (eq (elmo-archive-folder-archive-type-internal folder)
 459                      (elmo-archive-folder-archive-type-internal new-folder))
 460                  (equal (elmo-archive-folder-archive-prefix-internal
 461                          folder)
 462                         (elmo-archive-folder-archive-prefix-internal
 463                          new-folder)))
 464       (error "Not same archive type and prefix"))
 465     (if (not (file-exists-p old-arc))
 466         (error "No such file: %s" old-arc)
 467       (if (file-exists-p new-arc)
 468           (error "Already exists: %s" new-arc)
 469         (rename-file old-arc new-arc)
 470         t))))
 471
 472 (defun elmo-archive-folder-list-subfolders (folder one-level)
 473   (if elmo-archive-treat-file
 474       (let* ((path (elmo-archive-get-archive-directory folder))
 475              (base-folder (or (elmo-archive-folder-archive-name-internal
 476                                folder)
 477                               ""))
 478              (suffix (elmo-archive-folder-archive-type-internal folder))
 479              (prefix (if (string=
 480                           (elmo-archive-folder-archive-prefix-internal folder)
 481                           "")
 482                          ""
 483                        (concat ";"
 484                                (elmo-archive-folder-archive-prefix-internal
 485                                 folder))))
 486              (dir (if (file-directory-p path)
 487                       path (file-name-directory path)))
 488              (name (if (file-directory-p path)
 489                        "" (file-name-nondirectory path)))
 490              (flist (and (file-directory-p dir)
 491                          (directory-files dir nil
 492                                           (concat "^" name "[^A-z][^A-z]")
 493                                           nil)))
 494              (regexp (format "^\\(.*\\)\\(%s\\)$"
 495                              (mapconcat
 496                               '(lambda (x) (regexp-quote (cdr x)))
 497                               elmo-archive-suffix-alist
 498                               "\\|"))))
 499         (if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'.
 500             (setq base-folder (elmo-match-string 1 base-folder))
 501           (unless (file-directory-p path)
 502             (setq base-folder (or (file-name-directory base-folder) ""))))
 503         (delq
 504          nil
 505          (mapcar
 506           '(lambda (x)
 507              (when (and (string-match regexp x)
 508                         (eq suffix
 509                             (car
 510                              (rassoc (elmo-match-string 2 x)
 511                                      elmo-archive-suffix-alist))))
 512                (format "%s%s;%s%s"
 513                        (elmo-folder-prefix-internal folder)
 514                        (elmo-concat-path base-folder (elmo-match-string 1 x))
 515                        suffix prefix)))
 516           flist)))
 517     (elmo-mapcar-list-of-list
 518      (function (lambda (x) (concat (elmo-folder-prefix-internal folder) x)))
 519      (elmo-list-subdirectories
 520       (elmo-archive-get-archive-directory folder)
 521       ""
 522       one-level))))
 523
 524 (luna-define-method elmo-folder-list-subfolders ((folder elmo-archive-folder)
 525                                                  &optional one-level)
 526   (elmo-archive-folder-list-subfolders folder one-level))
 527
 528 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 529 ;;; Article file related functions
 530 ;;; read(extract) / append(move) / delete(delete) / query(list)
 531
 532 (defsubst elmo-archive-message-fetch-internal (folder number)
 533   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 534          (arc (elmo-archive-get-archive-name folder))
 535          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 536          (method (elmo-archive-get-method type 'cat))
 537          (args (list arc (elmo-concat-path
 538                           prefix (int-to-string number)))))
 539     (when (file-exists-p arc)
 540       (and
 541        (as-binary-process
 542         (elmo-archive-call-method method args t))
 543        (elmo-delete-cr-buffer)))))
 544
 545 (luna-define-method elmo-message-fetch-internal ((folder elmo-archive-folder)
 546                                                  number strategy
 547                                                  &optional section unseen)
 548   (elmo-archive-message-fetch-internal folder number))
 549
 550 (luna-define-method elmo-folder-append-buffer ((folder elmo-archive-folder)
 551                                                unread &optional number)
 552   (elmo-archive-folder-append-buffer folder unread number))
 553
 554 ;; verrrrrry slow!!
 555 (defun elmo-archive-folder-append-buffer (folder unread number)
 556   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 557          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 558          (arc (elmo-archive-get-archive-name folder))
 559          (method (elmo-archive-get-method type 'mv))
 560          (next-num (or number
 561                        (1+ (if (file-exists-p arc)
 562                                (car
 563                                 (elmo-folder-status folder)) 0))))
 564          (tmp-dir (elmo-folder-msgdb-path folder))
 565          (src-buffer (current-buffer))
 566          dst-buffer
 567          newfile)
 568     (when (null method)
 569       (ding)
 570       (error "WARNING: read-only mode: %s (method undefined)" type))
 571     (with-temp-buffer
 572       (let ((tmp-dir (expand-file-name prefix tmp-dir)))
 573         (when (not (file-directory-p tmp-dir))
 574           (elmo-make-directory (directory-file-name tmp-dir))))
 575       (setq newfile (elmo-concat-path
 576                      prefix
 577                      (int-to-string next-num)))
 578       (unwind-protect
 579           (elmo-bind-directory
 580            tmp-dir
 581            (if (and (or (functionp method) (car method))
 582                     (file-writable-p newfile))
 583                (progn
 584                  (setq dst-buffer (current-buffer))
 585                  (with-current-buffer src-buffer
 586                    (copy-to-buffer dst-buffer (point-min) (point-max)))
 587                  (as-binary-output-file
 588                   (write-region (point-min) (point-max) newfile nil 'no-msg))
 589                  (elmo-archive-call-method method (list arc newfile))
 590                  t)
 591              nil))))))
 592
 593 (luna-define-method elmo-folder-append-messages :around
 594   ((folder elmo-archive-folder) src-folder numbers unread-marks
 595    &optional same-number)
 596   (let ((prefix (elmo-archive-folder-archive-prefix-internal folder)))
 597     (cond
 598      ((and same-number
 599            (null prefix)
 600            (elmo-folder-message-file-p src-folder)
 601            (elmo-folder-message-file-number-p src-folder))
 602       ;; same-number(localdir, localnews) -> archive
 603       (elmo-archive-append-files folder
 604                                  (elmo-folder-message-file-directory src-folder)
 605                                  numbers)
 606       (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
 607       numbers)
 608      ((elmo-folder-message-make-temp-file-p src-folder)
 609       ;; not-same-number (localdir, localnews), (archive maildir) -> archive
 610       (let ((temp-dir (elmo-folder-message-make-temp-files
 611                        src-folder
 612                        numbers
 613                        (unless same-number
 614                          (1+ (if (file-exists-p (elmo-archive-get-archive-name
 615                                                  folder))
 616                                  (car (elmo-folder-status folder)) 0)))))
 617             new-dir base-dir files)
 618         (setq base-dir temp-dir)
 619         (when (> (length prefix) 0)
 620           (when (file-name-directory prefix)
 621             (elmo-make-directory (file-name-directory prefix)))
 622           (rename-file
 623            temp-dir
 624            (setq new-dir
 625                  (expand-file-name
 626                   prefix
 627                   ;; parent of temp-dir..(works in windows?)
 628                   (expand-file-name ".." temp-dir))))
 629           ;; now temp-dir has name prefix.
 630           (setq temp-dir new-dir)
 631           ;; parent of prefix becomes base-dir.
 632           (setq base-dir (expand-file-name ".." temp-dir)))
 633         (setq files
 634               (mapcar
 635                '(lambda (x) (elmo-concat-path prefix x))
 636                (directory-files temp-dir nil "^[^\\.]")))
 637         (if (elmo-archive-append-files folder
 638                                        base-dir
 639                                        files)
 640             (elmo-delete-directory temp-dir)))
 641       (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
 642       numbers)
 643      (t (luna-call-next-method)))))
 644
 645 (luna-define-method elmo-folder-message-make-temp-file-p
 646   ((folder elmo-archive-folder))
 647   (let ((type (elmo-archive-folder-archive-type-internal folder)))
 648     (or (elmo-archive-get-method type 'ext-pipe)
 649         (elmo-archive-get-method type 'ext))))
 650
 651 (luna-define-method elmo-folder-message-make-temp-files
 652   ((folder elmo-archive-folder) numbers
 653    &optional start-number)
 654   (elmo-archive-folder-message-make-temp-files folder numbers start-number))
 655
 656 (defun elmo-archive-folder-message-make-temp-files (folder
 657                                                     numbers
 658                                                     start-number)
 659   (let* ((tmp-dir-src (elmo-folder-make-temp-dir folder))
 660          (tmp-dir-dst (elmo-folder-make-temp-dir folder))
 661          (arc     (elmo-archive-get-archive-name folder))
 662          (type    (elmo-archive-folder-archive-type-internal folder))
 663          (prefix  (elmo-archive-folder-archive-prefix-internal folder))
 664          (p-method (elmo-archive-get-method type 'ext-pipe))
 665          (n-method (elmo-archive-get-method type 'ext))
 666          (tmp-msgs (mapcar (lambda (x) (elmo-concat-path
 667                                         prefix
 668                                         (int-to-string x))) numbers))
 669          number)
 670     ;; Expand files in the tmp-dir-src.
 671     (elmo-bind-directory
 672      tmp-dir-src
 673      (cond
 674       ((functionp n-method)
 675        (funcall n-method (cons arc tmp-msgs)))
 676       (p-method
 677        (let ((p-prog (car p-method))
 678              (p-prog-arg (cdr p-method)))
 679          (elmo-archive-exec-msgs-subr1
 680           p-prog (append p-prog-arg (list arc)) tmp-msgs)))
 681       (t
 682        (let ((n-prog (car n-method))
 683              (n-prog-arg (cdr n-method)))
 684          (elmo-archive-exec-msgs-subr2
 685           n-prog (append n-prog-arg (list arc)) tmp-msgs
 686           (length arc))))))
 687     ;; Move files to the tmp-dir-dst.
 688     (setq number start-number)
 689     (dolist (tmp-file tmp-msgs)
 690       (rename-file (expand-file-name
 691                     tmp-file
 692                     tmp-dir-src)
 693                    (expand-file-name
 694                     (if start-number
 695                         (int-to-string number)
 696                       (file-name-nondirectory tmp-file))
 697                     tmp-dir-dst))
 698       (if start-number (incf number)))
 699     ;; Remove tmp-dir-src.
 700     (elmo-delete-directory tmp-dir-src)
 701     ;; tmp-dir-dst is the return directory.
 702     tmp-dir-dst))
 703
 704 (defun elmo-archive-append-files (folder dir &optional files)
 705   (let* ((dst-type (elmo-archive-folder-archive-type-internal folder))
 706          (arc (elmo-archive-get-archive-name folder))
 707          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 708          (p-method (elmo-archive-get-method dst-type 'cp-pipe))
 709          (n-method (elmo-archive-get-method dst-type 'cp))
 710          src tmp newfile)
 711     (unless (elmo-folder-exists-p folder) (elmo-folder-create folder))
 712     (unless files (setq files (directory-files dir nil "^[^\\.]")))
 713     (when (null (or p-method n-method))
 714       (ding)
 715       (error "WARNING: read-only mode: %s (method undefined)" dst-type))
 716     (save-excursion
 717       (elmo-bind-directory
 718        dir
 719        (cond
 720         ((functionp n-method)
 721          (funcall n-method (cons arc files)))
 722         (p-method
 723          (let ((p-prog (car p-method))
 724                (p-prog-arg (cdr p-method)))
 725            (elmo-archive-exec-msgs-subr1
 726             p-prog (append p-prog-arg (list arc)) files)))
 727         (t
 728          (let ((n-prog (car n-method))
 729                (n-prog-arg (cdr n-method)))
 730            (elmo-archive-exec-msgs-subr2
 731             n-prog (append n-prog-arg (list arc)) files (length arc)))))))))
 732
 733 (luna-define-method elmo-folder-delete-messages ((folder elmo-archive-folder)
 734                                                  numbers)
 735   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 736          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 737          (arc (elmo-archive-get-archive-name folder))
 738          (p-method (elmo-archive-get-method type 'rm-pipe))
 739          (n-method (elmo-archive-get-method type 'rm))
 740          (numbers (mapcar '(lambda (x) (elmo-concat-path
 741                                         prefix
 742                                         (int-to-string x)))
 743                           numbers)))
 744     (cond ((functionp n-method)
 745            (funcall n-method (cons arc numbers)))
 746           (p-method
 747            (let ((p-prog (car p-method))
 748                  (p-prog-arg (cdr p-method)))
 749              (elmo-archive-exec-msgs-subr1
 750               p-prog (append p-prog-arg (list arc)) numbers)))
 751           (n-method
 752            (let ((n-prog (car n-method))
 753                  (n-prog-arg (cdr n-method)))
 754              (elmo-archive-exec-msgs-subr2
 755               n-prog (append n-prog-arg (list arc)) numbers (length arc))))
 756           (t
 757            (ding)
 758            (error "WARNING: not delete: %s (method undefined)" type)))))
 759
 760 (defun elmo-archive-exec-msgs-subr1 (prog args msgs)
 761   (let ((buf (get-buffer-create " *ELMO ARCHIVE exec*")))
 762     (set-buffer buf)
 763     (insert (mapconcat 'concat msgs "\n")) ;string
 764     (unwind-protect
 765         (= 0
 766            (apply 'call-process-region (point-min) (point-max)
 767                   prog nil nil nil args))
 768       (kill-buffer buf))))
 769
 770 (defun elmo-archive-exec-msgs-subr2 (prog args msgs arc-length)
 771   (let ((max-len (- elmo-archive-cmdstr-max-length arc-length))
 772         (n (length msgs))
 773         rest i sum)
 774     (setq rest msgs) ;string
 775     (setq i 1)
 776     (setq sum 0)
 777     (catch 'done
 778       (while (and rest (<= i n))
 779         (mapcar '(lambda (x)
 780                    (let* ((len (length x))
 781                           (files (member x (reverse rest))))
 782                      ;; total(previous) + current + white space
 783                      (if (<= max-len (+ sum len 1))
 784                          (progn
 785                            (unless
 786                                (elmo-archive-call-process
 787                                 prog (append args files))
 788                              (throw 'done nil))
 789                            (setq sum 0) ;; reset
 790                            (setq rest (nthcdr i rest)))
 791                        (setq sum (+ sum len 1)))
 792                      (setq i (1+ i)))) msgs))
 793       (throw 'done
 794              (or (not rest)
 795                  (elmo-archive-call-process prog (append args rest))))
 796       )))
 797
 798 (defsubst elmo-archive-article-exists-p (arc msg type)
 799   (if (not elmo-archive-check-existance-strict)
 800       t ; nop
 801     (save-excursion ; added 980915
 802       (let* ((method (elmo-archive-get-method type 'ls))
 803              (args (list arc msg))
 804              (buf (get-buffer-create " *ELMO ARCHIVE query*"))
 805              (error-msg "\\(no file\\|0 files\\)")
 806              ret-val)
 807         (set-buffer buf)
 808         (erase-buffer)
 809         (elmo-archive-call-method method args t)
 810         ;; pointer: point-max
 811         (setq ret-val (not (re-search-backward error-msg nil t)))
 812         (kill-buffer buf)
 813         ret-val))))
 814
 815 (defun elmo-archive-tgz-common-func (args exec-type &optional copy)
 816   (let* ((arc (car args))
 817          (tmp-msgs (cdr args))
 818          (decompress (elmo-archive-get-method 'tgz 'decompress))
 819          (compress (elmo-archive-get-method 'tgz 'compress))
 820          (exec (elmo-archive-get-method 'tgz exec-type))
 821          (suffix (elmo-archive-get-suffix 'tgz))
 822          (tar-suffix (elmo-archive-get-suffix 'tar))
 823          arc-tar ret-val
 824          )
 825     (when (null (and decompress compress exec))
 826       (ding)
 827       (error "WARNING: special method undefined: %s of %s"
 828              (or (if (null decompress) 'decompress)
 829                  (if (null compress) 'compress)
 830                  (if (null exec) exec-type))
 831              'tgz))
 832     (unless tar-suffix
 833       (ding)
 834       (error "WARNING: `tar' suffix undefined"))
 835     (if (string-match (concat (regexp-quote suffix) "$") arc)
 836         (setq arc-tar
 837               (concat (substring arc 0 (match-beginning 0)) tar-suffix))
 838       (error "%s: not match suffix [%s]" arc suffix))
 839     (and
 840      ;; decompress
 841      (elmo-archive-call-process
 842       (car decompress) (append (cdr decompress) (list arc)))
 843      ;; append (or delete)
 844      (elmo-archive-exec-msgs-subr2
 845       (car exec) (append (cdr exec) (list arc-tar)) tmp-msgs (length arc-tar))
 846      ;; compress
 847      (setq ret-val
 848            (elmo-archive-call-process
 849             (car compress) (append (cdr compress) (list arc-tar)))))
 850     ;; delete tmporary messages
 851     (if (and (not copy)
 852              (eq exec-type 'append))
 853         (while tmp-msgs
 854           (if (file-exists-p (car tmp-msgs))
 855               (delete-file (car tmp-msgs)))
 856           (setq tmp-msgs (cdr tmp-msgs))))
 857     ret-val))
 858
 859 (defun elmo-archive-tgz-cp-func (args &optional output)
 860   (elmo-archive-tgz-common-func args 'append t))
 861
 862 (defun elmo-archive-tgz-mv-func (args &optional output)
 863   (elmo-archive-tgz-common-func args 'append))
 864
 865 (defun elmo-archive-tgz-rm-func (args &optional output)
 866   (elmo-archive-tgz-common-func args 'delete))
 867
 868 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 869 ;;; MessageDB functions (from elmo-localdir.el)
 870
 871 (defsubst elmo-archive-msgdb-create-entity-subr (number)
 872   (let (header-end)
 873     (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 874     (goto-char (point-min))
 875     (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 876         (setq header-end (point))
 877       (setq header-end (point-max)))
 878     (narrow-to-region (point-min) header-end)
 879     (elmo-msgdb-create-overview-from-buffer number)))
 880
 881 ;; verrrry slow!!
 882 (defsubst elmo-archive-msgdb-create-entity (method archive number type &optional prefix)
 883   (let* ((msg (elmo-concat-path prefix (int-to-string number)))
 884          (arg-list (list archive msg)))
 885     (when (elmo-archive-article-exists-p archive msg type)
 886       ;; insert article.
 887       (as-binary-process
 888        (elmo-archive-call-method method arg-list t))
 889       (elmo-archive-msgdb-create-entity-subr number))))
 890
 891 (luna-define-method elmo-folder-msgdb-create ((folder elmo-archive-folder)
 892                                               numbers new-mark
 893                                               already-mark seen-mark
 894                                               important-mark seen-list)
 895   (when numbers
 896     (save-excursion ;; 981005
 897       (if (and elmo-archive-use-izip-agent
 898                (elmo-archive-get-method
 899                 (elmo-archive-folder-archive-type-internal folder)
 900                 'cat-headers))
 901           (elmo-archive-msgdb-create-as-numlist-subr2
 902            folder numbers new-mark already-mark seen-mark important-mark
 903            seen-list)
 904         (elmo-archive-msgdb-create-as-numlist-subr1
 905          folder numbers new-mark already-mark seen-mark important-mark
 906          seen-list)))))
 907
 908 (defun elmo-archive-msgdb-create-as-numlist-subr1 (folder
 909                                                    numlist new-mark
 910                                                    already-mark seen-mark
 911                                                    important-mark
 912                                                    seen-list)
 913   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 914          (file (elmo-archive-get-archive-name folder))
 915          (method (elmo-archive-get-method type 'cat))
 916          overview number-alist mark-alist entity
 917          i percent num message-id seen gmark)
 918     (with-temp-buffer
 919       (setq num (length numlist))
 920       (setq i 0)
 921       (message "Creating msgdb...")
 922       (while numlist
 923         (erase-buffer)
 924         (setq entity
 925               (elmo-archive-msgdb-create-entity
 926                method file (car numlist) type
 927                (elmo-archive-folder-archive-prefix-internal folder)))
 928         (when entity
 929           (setq overview
 930                 (elmo-msgdb-append-element
 931                  overview entity))
 932           (setq number-alist
 933                 (elmo-msgdb-number-add
 934                  number-alist
 935                  (elmo-msgdb-overview-entity-get-number entity)
 936                  (car entity)))
 937           (setq message-id (car entity))
 938           (setq seen (member message-id seen-list))
 939           (if (setq gmark
 940                     (or (elmo-msgdb-global-mark-get message-id)
 941                         (if (elmo-file-cache-status
 942                              (elmo-file-cache-get message-id))
 943                             (if seen
 944                                 nil
 945                               already-mark)
 946                           (if seen
 947                               seen-mark
 948                             new-mark))))
 949               (setq mark-alist
 950                     (elmo-msgdb-mark-append
 951                      mark-alist
 952                      (elmo-msgdb-overview-entity-get-number entity)
 953                      gmark))))
 954         (when (> num elmo-display-progress-threshold)
 955           (setq i (1+ i))
 956           (setq percent (/ (* i 100) num))
 957           (elmo-display-progress
 958            'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..."
 959            percent))
 960         (setq numlist (cdr numlist)))
 961       (message "Creating msgdb...done")
 962       (list overview number-alist mark-alist))))
 963
 964 ;;; info-zip agent
 965 (defun elmo-archive-msgdb-create-as-numlist-subr2 (folder
 966                                                    numlist new-mark
 967                                                    already-mark seen-mark
 968                                                    important-mark
 969                                                    seen-list)
 970   (let* ((delim1 elmo-mmdf-delimiter)           ;; MMDF
 971          (delim2 elmo-unixmail-delimiter)       ;; UNIX Mail
 972          (type (elmo-archive-folder-archive-type-internal folder))
 973          (prefix (elmo-archive-folder-archive-prefix-internal folder))
 974          (method (elmo-archive-get-method type 'cat-headers))
 975          (prog (car method))
 976          (args (cdr method))
 977          (arc (elmo-archive-get-archive-name folder))
 978          n i percent num result overview number-alist mark-alist
 979          msgs case-fold-search)
 980     (with-temp-buffer
 981       (setq num (length numlist))
 982       (setq i 0)
 983       (message "Creating msgdb...")
 984       (while numlist
 985         (setq n (min (1- elmo-archive-fetch-headers-volume)
 986                      (1- (length numlist))))
 987         (setq msgs (reverse (memq (nth n numlist) (reverse numlist))))
 988         (setq numlist (nthcdr (1+ n) numlist))
 989         (erase-buffer)
 990         (insert
 991          (mapconcat
 992           'concat
 993           (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs)
 994           "\n"))
 995         (message "Fetching headers...")
 996         (as-binary-process (apply 'call-process-region
 997                                   (point-min) (point-max)
 998                                   prog t t nil (append args (list arc))))
 999         (goto-char (point-min))
1000         (cond
1001          ((looking-at delim1)   ;; MMDF
1002           (setq result (elmo-archive-parse-mmdf msgs
1003                                                 new-mark
1004                                                 already-mark seen-mark
1005                                                 seen-list))
1006           (setq overview (append overview (nth 0 result)))
1007           (setq number-alist (append number-alist (nth 1 result)))
1008           (setq mark-alist (append mark-alist (nth 2 result))))
1009 ;;;    ((looking-at delim2)     ;; UNIX MAIL
1010 ;;;     (setq result (elmo-archive-parse-unixmail msgs))
1011 ;;;     (setq overview (append overview (nth 0 result)))
1012 ;;;     (setq number-alist (append number-alist (nth 1 result)))
1013 ;;;     (setq mark-alist (append mark-alist (nth 2 result))))
1014          (t                     ;; unknown format
1015           (error "Unknown format!")))
1016         (when (> num elmo-display-progress-threshold)
1017           (setq i (+ n i))
1018           (setq percent (/ (* i 100) num))
1019           (elmo-display-progress
1020            'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..."
1021            percent))))
1022     (list overview number-alist mark-alist)))
1023
1024 (defun elmo-archive-parse-mmdf (msgs new-mark
1025                                      already-mark
1026                                      seen-mark
1027                                      seen-list)
1028   (let ((delim elmo-mmdf-delimiter)
1029         number sp ep rest entity overview number-alist mark-alist ret-val
1030         message-id seen gmark)
1031     (goto-char (point-min))
1032     (setq rest msgs)
1033     (while (and rest (re-search-forward delim nil t)
1034                 (not (eobp)))
1035       (setq number (car rest))
1036       (setq sp (1+ (point)))
1037       (setq ep (prog2 (re-search-forward delim)
1038                    (1+ (- (point) (length delim)))))
1039       (if (>= sp ep)                    ; no article!
1040           ()                            ; nop
1041         (save-excursion
1042           (narrow-to-region sp ep)
1043           (setq entity (elmo-archive-msgdb-create-entity-subr number))
1044           (setq overview
1045                 (elmo-msgdb-append-element
1046                  overview entity))
1047           (setq number-alist
1048                 (elmo-msgdb-number-add
1049                  number-alist
1050                  (elmo-msgdb-overview-entity-get-number entity)
1051                  (car entity)))
1052           (setq message-id (car entity))
1053           (setq seen (member message-id seen-list))
1054           (if (setq gmark
1055                     (or (elmo-msgdb-global-mark-get message-id)
1056                         (if (elmo-file-cache-status
1057                              (elmo-file-cache-get message-id))
1058                             (if seen
1059                                 nil
1060                               already-mark)
1061                           (if seen
1062                               seen-mark
1063                             new-mark))))
1064               (setq mark-alist
1065                     (elmo-msgdb-mark-append
1066                      mark-alist
1067                      (elmo-msgdb-overview-entity-get-number entity)
1068                      gmark)))
1069           (setq ret-val (append ret-val (list overview number-alist mark-alist)))
1070           (widen)))
1071       (forward-line 1)
1072       (setq rest (cdr rest)))
1073     ret-val))
1074
1075
1076 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1077 ;;; Search functions
1078
1079 (defsubst elmo-archive-field-condition-match (folder number number-list
1080                                                      condition prefix)
1081   (save-excursion
1082     (let* ((type (elmo-archive-folder-archive-type-internal folder))
1083            (arc (elmo-archive-get-archive-name folder))
1084            (method (elmo-archive-get-method type 'cat))
1085            (args (list arc (elmo-concat-path prefix (int-to-string number)))))
1086       (elmo-set-work-buf
1087        (when (file-exists-p arc)
1088          (as-binary-process
1089           (elmo-archive-call-method method args t))
1090          (elmo-set-buffer-multibyte default-enable-multibyte-characters)
1091          (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
1092          (elmo-buffer-field-condition-match condition number number-list))))))
1093
1094 (luna-define-method elmo-folder-search ((folder elmo-archive-folder)
1095                                         condition &optional from-msgs)
1096   (let* (;;(args (elmo-string-to-list key))
1097          ;; XXX: I don't know whether `elmo-archive-list-folder'
1098          ;;      updates match-data.
1099          ;; (msgs (or from-msgs (elmo-archive-list-folder spec)))
1100          (msgs (or from-msgs (elmo-folder-list-messages folder)))
1101          (num (length msgs))
1102          (i 0)
1103          (case-fold-search nil)
1104          number-list ret-val)
1105     (setq number-list msgs)
1106     (while msgs
1107       (if (elmo-archive-field-condition-match
1108            folder (car msgs) number-list
1109            condition
1110            (elmo-archive-folder-archive-prefix-internal folder))
1111           (setq ret-val (cons (car msgs) ret-val)))
1112       (when (> num elmo-display-progress-threshold)
1113         (setq i (1+ i))
1114         (elmo-display-progress
1115          'elmo-archive-search "Searching..."
1116          (/ (* i 100) num)))
1117       (setq msgs (cdr msgs)))
1118     (nreverse ret-val)))
1119
1120 ;;; method(alist)
1121 (if (null elmo-archive-method-alist)
1122     (let ((mlist elmo-archive-method-list) ; from mew-highlight.el
1123           method type str)
1124       (while mlist
1125         (setq method (car mlist))
1126         (setq mlist (cdr mlist))
1127         (setq str (symbol-name method))
1128         (string-match "elmo-archive-\\([^-].*\\)-method-alist$" str)
1129         (setq type (intern-soft
1130                     (elmo-match-string 1 str)))
1131         (setq elmo-archive-method-alist
1132               (cons (cons type
1133                           (symbol-value method))
1134                     elmo-archive-method-alist)))))
1135
1136 ;;; valid suffix(list)
1137 (if (null elmo-archive-suffixes)
1138     (let ((slist elmo-archive-suffix-alist)
1139           tmp)
1140       (while slist
1141         (setq tmp (car slist))
1142         (setq elmo-archive-suffixes
1143               (nconc elmo-archive-suffixes (list (cdr tmp))))
1144         (setq slist (cdr slist)))))
1145
1146 (luna-define-method elmo-message-use-cache-p ((folder elmo-archive-folder)
1147                                               number)
1148   elmo-archive-use-cache)
1149
1150 ;;; End
1151 (run-hooks 'elmo-archive-load-hook)
1152
1153 (require 'product)
1154 (product-provide (provide 'elmo-archive) (require 'elmo-version))
1155
1156 ;;; elmo-archive.el ends here