elmo/elmo-archive.el

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