X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-archive.el;h=a2b954961f6f213775bd578880eb8f1e56788428;hb=54482fff6bd6498729682555a0ba3c3cd092a1b5;hp=6625a7fd84f5d48a29d61236ff077b6a01841722;hpb=9e39553b80115a949a7f04ddced4459a7797f8bd;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 6625a7f..a2b9549 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -1,4 +1,4 @@ -;;; elmo-archive.el --- Archive folder of ELMO. +;;; elmo-archive.el --- Archive folder of ELMO. -*- coding: euc-japan -*- ;; Copyright (C) 1998,1999,2000 OKUNISHI Fujikazu ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi @@ -33,11 +33,10 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) +(require 'elmo) (require 'elmo-msgdb) -(require 'emu) -(require 'std11) -(eval-when-compile (require 'elmo-localdir)) ;;; User vars. (defvar elmo-archive-lha-dos-compatible @@ -81,12 +80,19 @@ ;;; ELMO Local directory folder (eval-and-compile (luna-define-class elmo-archive-folder (elmo-folder) - (archive-name archive-type archive-prefix)) + (archive-name archive-type archive-prefix dir-name)) (luna-define-internal-accessors 'elmo-archive-folder)) +(luna-define-generic elmo-archive-folder-path (folder) + "Return local directory path of the FOLDER.") + +(luna-define-method elmo-archive-folder-path ((folder elmo-archive-folder)) + elmo-archive-folder-path) + (luna-define-method elmo-folder-initialize ((folder elmo-archive-folder) name) + (elmo-archive-folder-set-dir-name-internal folder name) (when (string-match "^\\([^;]*\\);?\\([^;]*\\);?\\([^;]*\\)$" name) @@ -141,11 +147,11 @@ (defvar elmo-archive-suffix-alist '((lha . ".lzh") ; default -;;; (lha . ".lzs") +;;; (lha . ".lzs") (zip . ".zip") (zoo . ".zoo") -;;; (arc . ".arc") -;;; (arj . ".arj") +;;; (arc . ".arc") +;;; (arj . ".arj") (rar . ".rar") (tar . ".tar") (tgz . ".tar.gz"))) @@ -213,7 +219,7 @@ '((ls . ("gtar" "-tf")) (cat . ("gtar" "-Oxf")) (ext . ("gtar" "-xf")) -;;; (rm . ("gtar" "--delete" "-f")) ;; well not work +;;; (rm . ("gtar" "--delete" "-f")) ; well not work ))) ;;; GNU tar (*.tar.gz, *.tar.Z, *.tar.bz2) @@ -221,7 +227,7 @@ '((ls . ("gtar" "-ztf")) (cat . ("gtar" "-Ozxf")) (create . ("gtar" "-zcf")) -;;; (rm . elmo-archive-tgz-rm-func) +;;; (rm . elmo-archive-tgz-rm-func) (cp . elmo-archive-tgz-cp-func) (mv . elmo-archive-tgz-mv-func) (ext . ("gtar" "-zxf")) @@ -229,17 +235,17 @@ (decompress . ("gzip" "-d")) (compress . ("gzip")) (append . ("gtar" "-uf")) -;;; (delete . ("gtar" "--delete" "-f")) ; well not work +;;; (delete . ("gtar" "--delete" "-f")) ; well not work )) (defvar elmo-archive-method-list '(elmo-archive-lha-method-alist elmo-archive-zip-method-alist elmo-archive-zoo-method-alist -;;; elmo-archive-tar-method-alist +;;; elmo-archive-tar-method-alist elmo-archive-tgz-method-alist -;;; elmo-archive-arc-method-alist -;;; elmo-archive-arj-method-alist +;;; elmo-archive-arc-method-alist +;;; elmo-archive-arj-method-alist elmo-archive-rar-method-alist)) ;;; Internal vars. @@ -249,16 +255,13 @@ ;;; Macro (defmacro elmo-archive-get-method (type action) - (` (cdr (assq (, action) (cdr (assq (, type) - elmo-archive-method-alist)))))) + `(cdr (assq ,action (cdr (assq ,type elmo-archive-method-alist))))) (defmacro elmo-archive-get-suffix (type) - (` (cdr (assq (, type) - elmo-archive-suffix-alist)))) + `(cdr (assq ,type elmo-archive-suffix-alist))) (defmacro elmo-archive-get-regexp (type) - (` (cdr (assq (, type) - elmo-archive-file-regexp-alist)))) + `(cdr (assq ,type elmo-archive-file-regexp-alist))) (defsubst elmo-archive-call-process (prog args &optional output) (= (apply 'call-process prog nil output nil args) 0)) @@ -300,9 +303,9 @@ TYPE specifies the archiver's symbol." (goto-char (point-min)))) (while (and (re-search-forward file-regexp nil t) (not (eobp))) ; for GNU tar 981010 - (setq file-list (nconc file-list (list (string-to-int + (setq file-list (nconc file-list (list (string-to-number (match-string 1))))))) - (error "%s does not exist." file)) + (error "%s does not exist" file)) (if nonsort (cons (or (elmo-max-of-list file-list) 0) (if killed @@ -441,16 +444,28 @@ TYPE specifies the archiver's symbol." )))) (luna-define-method elmo-folder-delete ((folder elmo-archive-folder)) - (let ((arc (elmo-archive-get-archive-name folder))) - (if (not (file-exists-p arc)) - (error "No such file: %s" arc) - (delete-file arc) - t))) + (let ((msgs (and (elmo-folder-exists-p folder) + (elmo-folder-list-messages folder)))) + (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? " + (if (> (length msgs) 0) + (format "%d msg(s) exists. " (length msgs)) + "") + (elmo-folder-name-internal folder))) + (let ((arc (elmo-archive-get-archive-name folder))) + (if (not (file-exists-p arc)) + (error "No such file: %s" arc) + (delete-file arc)) + (elmo-msgdb-delete-path folder) + t)))) (luna-define-method elmo-folder-rename-internal ((folder elmo-archive-folder) new-folder) (let* ((old-arc (elmo-archive-get-archive-name folder)) - (new-arc (elmo-archive-get-archive-name new-folder))) + (new-arc (elmo-archive-get-archive-name new-folder)) + (new-dir (directory-file-name + (elmo-archive-get-archive-directory new-folder)))) + (if elmo-archive-treat-file + (setq new-dir (directory-file-name (file-name-directory new-dir)))) (unless (and (eq (elmo-archive-folder-archive-type-internal folder) (elmo-archive-folder-archive-type-internal new-folder)) (equal (elmo-archive-folder-archive-prefix-internal @@ -458,12 +473,14 @@ TYPE specifies the archiver's symbol." (elmo-archive-folder-archive-prefix-internal new-folder))) (error "Not same archive type and prefix")) - (if (not (file-exists-p old-arc)) - (error "No such file: %s" old-arc) - (if (file-exists-p new-arc) - (error "Already exists: %s" new-arc) - (rename-file old-arc new-arc) - t)))) + (unless (file-exists-p old-arc) + (error "No such file: %s" old-arc)) + (when (file-exists-p new-arc) + (error "Already exists: %s" new-arc)) + (unless (file-directory-p new-dir) + (elmo-make-directory new-dir)) + (rename-file old-arc new-arc) + t)) (defun elmo-archive-folder-list-subfolders (folder one-level) (if elmo-archive-treat-file @@ -485,11 +502,13 @@ TYPE specifies the archiver's symbol." "" (file-name-nondirectory path))) (flist (and (file-directory-p dir) (directory-files dir nil - (concat "^" name "[^A-z][^A-z]") + (if (> (length name) 0) + (concat "^" name "[^A-z][^A-z]") + name) nil))) (regexp (format "^\\(.*\\)\\(%s\\)$" (mapconcat - '(lambda (x) (regexp-quote (cdr x))) + (lambda (x) (regexp-quote (cdr x))) elmo-archive-suffix-alist "\\|")))) (if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'. @@ -499,22 +518,32 @@ TYPE specifies the archiver's symbol." (delq nil (mapcar - '(lambda (x) - (when (and (string-match regexp x) - (eq suffix - (car - (rassoc (elmo-match-string 2 x) - elmo-archive-suffix-alist)))) - (format "%s%s;%s%s" - (elmo-folder-prefix-internal folder) - (elmo-concat-path base-folder (elmo-match-string 1 x)) - suffix prefix))) + (lambda (x) + (when (and (string-match regexp x) + (eq suffix + (car + (rassoc (elmo-match-string 2 x) + elmo-archive-suffix-alist)))) + (format "%s%s;%s%s" + (elmo-folder-prefix-internal folder) + (elmo-concat-path base-folder (elmo-match-string 1 x)) + suffix prefix))) flist))) (elmo-mapcar-list-of-list - (function (lambda (x) (concat (elmo-folder-prefix-internal folder) x))) + (lambda (x) + (if (file-exists-p + (expand-file-name + (concat elmo-archive-basename + (elmo-archive-get-suffix + (elmo-archive-folder-archive-type-internal + folder))) + (expand-file-name + x + (elmo-archive-folder-path folder)))) + (concat (elmo-folder-prefix-internal folder) x))) (elmo-list-subdirectories - (elmo-archive-get-archive-directory folder) - "" + (elmo-archive-folder-path folder) + (or (elmo-archive-folder-dir-name-internal folder) "") one-level)))) (luna-define-method elmo-folder-list-subfolders ((folder elmo-archive-folder) @@ -531,12 +560,13 @@ TYPE specifies the archiver's symbol." (prefix (elmo-archive-folder-archive-prefix-internal folder)) (method (elmo-archive-get-method type 'cat)) (args (list arc (elmo-concat-path - prefix (int-to-string number))))) - (when (file-exists-p arc) - (and - (as-binary-process - (elmo-archive-call-method method args t)) - (elmo-delete-cr-buffer))))) + prefix (number-to-string number))))) + (and (file-exists-p arc) + (as-binary-process + (elmo-archive-call-method method args t)) + (progn + (elmo-delete-cr-buffer) + t)))) (luna-define-method elmo-message-fetch-internal ((folder elmo-archive-folder) number strategy @@ -544,11 +574,11 @@ TYPE specifies the archiver's symbol." (elmo-archive-message-fetch-internal folder number)) (luna-define-method elmo-folder-append-buffer ((folder elmo-archive-folder) - unread &optional number) - (elmo-archive-folder-append-buffer folder unread number)) + &optional flags number) + (elmo-archive-folder-append-buffer folder flags number)) ;; verrrrrry slow!! -(defun elmo-archive-folder-append-buffer (folder unread number) +(defun elmo-archive-folder-append-buffer (folder flags number) (let* ((type (elmo-archive-folder-archive-type-internal folder)) (prefix (elmo-archive-folder-archive-prefix-internal folder)) (arc (elmo-archive-get-archive-name folder)) @@ -570,25 +600,30 @@ TYPE specifies the archiver's symbol." (elmo-make-directory (directory-file-name tmp-dir)))) (setq newfile (elmo-concat-path prefix - (int-to-string next-num))) - (unwind-protect - (elmo-bind-directory - tmp-dir - (if (and (or (functionp method) (car method)) - (file-writable-p newfile)) - (progn - (setq dst-buffer (current-buffer)) - (with-current-buffer src-buffer - (copy-to-buffer dst-buffer (point-min) (point-max))) - (as-binary-output-file + (number-to-string next-num))) + (elmo-bind-directory + tmp-dir + (if (and (or (functionp method) (car method)) + (file-writable-p newfile)) + (progn + (setq dst-buffer (current-buffer)) + (with-current-buffer src-buffer + (copy-to-buffer dst-buffer (point-min) (point-max))) + (as-binary-output-file (write-region (point-min) (point-max) newfile nil 'no-msg)) - (elmo-archive-call-method method (list arc newfile)) - t) - nil)))))) - -(luna-define-method elmo-folder-append-messages :around - ((folder elmo-archive-folder) src-folder numbers unread-marks - &optional same-number) + (when (elmo-archive-call-method method (list arc newfile)) + (elmo-folder-preserve-flags + folder + (with-current-buffer src-buffer + (elmo-msgdb-get-message-id-from-buffer)) + flags) + t)) + nil))))) + +(defun elmo-folder-append-messages-*-archive (folder + src-folder + numbers + same-number) (let ((prefix (elmo-archive-folder-archive-prefix-internal folder))) (cond ((and same-number @@ -596,9 +631,11 @@ TYPE specifies the archiver's symbol." (elmo-folder-message-file-p src-folder) (elmo-folder-message-file-number-p src-folder)) ;; same-number(localdir, localnews) -> archive - (elmo-archive-append-files folder - (elmo-folder-message-file-directory src-folder) - numbers) + (unless (elmo-archive-append-files + folder + (elmo-folder-message-file-directory src-folder) + numbers) + (setq numbers nil)) (elmo-progress-notify 'elmo-folder-move-messages (length numbers)) numbers) ((elmo-folder-message-make-temp-file-p src-folder) @@ -611,32 +648,37 @@ TYPE specifies the archiver's symbol." folder)) (car (elmo-folder-status folder)) 0))))) new-dir base-dir files) - (setq base-dir temp-dir) - (when (> (length prefix) 0) - (when (file-name-directory prefix) - (elmo-make-directory (file-name-directory prefix))) - (rename-file - temp-dir - (setq new-dir - (expand-file-name - prefix - ;; parent of temp-dir..(works in windows?) - (expand-file-name ".." temp-dir)))) - ;; now temp-dir has name prefix. - (setq temp-dir new-dir) - ;; parent of prefix becomes base-dir. - (setq base-dir (expand-file-name ".." temp-dir))) - (setq files - (mapcar - '(lambda (x) (elmo-concat-path prefix x)) - (directory-files temp-dir nil "^[^\\.]"))) - (if (elmo-archive-append-files folder - base-dir - files) - (elmo-delete-directory temp-dir))) + (unwind-protect + (progn + (setq base-dir temp-dir) + (when (> (length prefix) 0) + (when (file-name-directory prefix) + (elmo-make-directory (file-name-directory prefix))) + (rename-file + temp-dir + (setq new-dir + (expand-file-name + prefix + ;; parent of temp-dir..(works in windows?) + (expand-file-name ".." temp-dir)))) + ;; now temp-dir has name prefix. + (setq temp-dir new-dir) + ;; parent of prefix becomes base-dir. + (setq base-dir (expand-file-name ".." temp-dir))) + (setq files + (mapcar + (lambda (x) (elmo-concat-path prefix x)) + (directory-files temp-dir nil "^[^\\.]"))) + (unless (elmo-archive-append-files folder + base-dir + files) + (setq numbers nil))) + (elmo-delete-directory temp-dir))) (elmo-progress-notify 'elmo-folder-move-messages (length numbers)) numbers) - (t (luna-call-next-method))))) + (t + (elmo-folder-append-messages folder src-folder numbers same-number + 'elmo-folder-append-messages-*-archive))))) (luna-define-method elmo-folder-message-make-temp-file-p ((folder elmo-archive-folder)) @@ -661,7 +703,7 @@ TYPE specifies the archiver's symbol." (n-method (elmo-archive-get-method type 'ext)) (tmp-msgs (mapcar (lambda (x) (elmo-concat-path prefix - (int-to-string x))) numbers)) + (number-to-string x))) numbers)) number) ;; Expand files in the tmp-dir-src. (elmo-bind-directory @@ -688,7 +730,7 @@ TYPE specifies the archiver's symbol." tmp-dir-src) (expand-file-name (if start-number - (int-to-string number) + (number-to-string number) (file-name-nondirectory tmp-file)) tmp-dir-dst)) (if start-number (incf number))) @@ -726,16 +768,17 @@ TYPE specifies the archiver's symbol." (elmo-archive-exec-msgs-subr2 n-prog (append n-prog-arg (list arc)) files (length arc))))))))) -(luna-define-method elmo-folder-delete-messages ((folder elmo-archive-folder) - numbers) +(luna-define-method elmo-folder-delete-messages-internal ((folder + elmo-archive-folder) + numbers) (let* ((type (elmo-archive-folder-archive-type-internal folder)) (prefix (elmo-archive-folder-archive-prefix-internal folder)) (arc (elmo-archive-get-archive-name folder)) (p-method (elmo-archive-get-method type 'rm-pipe)) (n-method (elmo-archive-get-method type 'rm)) - (numbers (mapcar '(lambda (x) (elmo-concat-path - prefix - (int-to-string x))) + (numbers (mapcar (lambda (x) (elmo-concat-path + prefix + (number-to-string x))) numbers))) (cond ((functionp n-method) (funcall n-method (cons arc numbers))) @@ -768,20 +811,22 @@ TYPE specifies the archiver's symbol." (setq sum 0) (catch 'done (while (and rest (<= i n)) - (mapcar '(lambda (x) - (let* ((len (length x)) - (files (member x (reverse rest)))) - ;; total(previous) + current + white space - (if (<= max-len (+ sum len 1)) - (progn - (unless - (elmo-archive-call-process - prog (append args files)) - (throw 'done nil)) - (setq sum 0) ;; reset - (setq rest (nthcdr i rest))) - (setq sum (+ sum len 1))) - (setq i (1+ i)))) msgs)) + (mapc + (lambda (x) + (let* ((len (length x)) + (files (member x (reverse rest)))) + ;; total(previous) + current + white space + (if (<= max-len (+ sum len 1)) + (progn + (unless + (elmo-archive-call-process + prog (append args files)) + (throw 'done nil)) + (setq sum 0) ;; reset + (setq rest (nthcdr i rest))) + (setq sum (+ sum len 1))) + (setq i (1+ i)))) + msgs)) (throw 'done (or (not rest) (elmo-archive-call-process prog (append args rest)))) @@ -839,7 +884,7 @@ TYPE specifies the archiver's symbol." (setq ret-val (elmo-archive-call-process (car compress) (append (cdr compress) (list arc-tar))))) - ;; delete tmporary messages + ;; delete temporary messages (if (and (not copy) (eq exec-type 'append)) (while tmp-msgs @@ -860,105 +905,72 @@ TYPE specifies the archiver's symbol." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; MessageDB functions (from elmo-localdir.el) -(defsubst elmo-archive-msgdb-create-entity-subr (number) +(defsubst elmo-archive-msgdb-create-entity-subr (msgdb number) (let (header-end) - (elmo-set-buffer-multibyte default-enable-multibyte-characters) + (set-buffer-multibyte default-enable-multibyte-characters) (goto-char (point-min)) (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t) (setq header-end (point)) (setq header-end (point-max))) (narrow-to-region (point-min) header-end) - (elmo-msgdb-create-overview-from-buffer number))) + (elmo-msgdb-create-message-entity-from-buffer + (elmo-msgdb-message-entity-handler msgdb) number))) ;; verrrry slow!! -(defsubst elmo-archive-msgdb-create-entity (method archive number type &optional prefix) - (let* ((msg (elmo-concat-path prefix (int-to-string number))) +(defsubst elmo-archive-msgdb-create-entity (msgdb + method + archive number type + &optional prefix) + (let* ((msg (elmo-concat-path prefix (number-to-string number))) (arg-list (list archive msg))) (when (elmo-archive-article-exists-p archive msg type) ;; insert article. (as-binary-process (elmo-archive-call-method method arg-list t)) - (elmo-archive-msgdb-create-entity-subr number)))) + (elmo-archive-msgdb-create-entity-subr msgdb number)))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-archive-folder) - numbers new-mark - already-mark seen-mark - important-mark seen-list) + numbers flag-table) (when numbers (save-excursion ;; 981005 - (if (and elmo-archive-use-izip-agent - (elmo-archive-get-method - (elmo-archive-folder-archive-type-internal folder) - 'cat-headers)) - (elmo-archive-msgdb-create-as-numlist-subr2 - folder numbers new-mark already-mark seen-mark important-mark - seen-list) - (elmo-archive-msgdb-create-as-numlist-subr1 - folder numbers new-mark already-mark seen-mark important-mark - seen-list))))) - -(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder - numlist new-mark - already-mark seen-mark - important-mark - seen-list) + (elmo-with-progress-display (elmo-folder-create-msgdb (length numbers)) + "Creating msgdb" + (if (and elmo-archive-use-izip-agent + (elmo-archive-get-method + (elmo-archive-folder-archive-type-internal folder) + 'cat-headers)) + (elmo-archive-msgdb-create-as-numlist-subr2 + folder numbers flag-table) + (elmo-archive-msgdb-create-as-numlist-subr1 + folder numbers flag-table)))))) + +(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder numlist flag-table) (let* ((type (elmo-archive-folder-archive-type-internal folder)) (file (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'cat)) - overview number-alist mark-alist entity - i percent num message-id seen gmark) + (new-msgdb (elmo-make-msgdb)) + entity message-id flags) (with-temp-buffer - (setq num (length numlist)) - (setq i 0) - (message "Creating msgdb...") (while numlist (erase-buffer) (setq entity (elmo-archive-msgdb-create-entity + new-msgdb method file (car numlist) type (elmo-archive-folder-archive-prefix-internal folder))) (when entity - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq number-alist - (elmo-msgdb-number-add - number-alist - (elmo-msgdb-overview-entity-get-number entity) - (car entity))) - (setq message-id (car entity)) - (setq seen (member message-id seen-list)) - (if (setq gmark - (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - seen-mark - new-mark)))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - (elmo-msgdb-overview-entity-get-number entity) - gmark)))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (setq percent (/ (* i 100) num)) - (elmo-display-progress - 'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..." - percent)) + (setq message-id (elmo-message-entity-field entity 'message-id) + flags (elmo-flag-table-get flag-table message-id)) + (elmo-global-flags-set flags folder (car numlist) message-id) + (elmo-msgdb-append-entity new-msgdb entity flags)) + (elmo-progress-notify 'elmo-folder-msgdb-create) (setq numlist (cdr numlist))) - (message "Creating msgdb...done") - (list overview number-alist mark-alist)))) + new-msgdb))) ;;; info-zip agent (defun elmo-archive-msgdb-create-as-numlist-subr2 (folder - numlist new-mark - already-mark seen-mark - important-mark - seen-list) + numlist + flag-table) (let* ((delim1 elmo-mmdf-delimiter) ;; MMDF (delim2 elmo-unixmail-delimiter) ;; UNIX Mail (type (elmo-archive-folder-archive-type-internal folder)) @@ -967,12 +979,9 @@ TYPE specifies the archiver's symbol." (prog (car method)) (args (cdr method)) (arc (elmo-archive-get-archive-name folder)) - n i percent num result overview number-alist mark-alist - msgs case-fold-search) + (new-msgdb (elmo-make-msgdb)) + n msgs case-fold-search) (with-temp-buffer - (setq num (length numlist)) - (setq i 0) - (message "Creating msgdb...") (while numlist (setq n (min (1- elmo-archive-fetch-headers-volume) (1- (length numlist)))) @@ -982,44 +991,32 @@ TYPE specifies the archiver's symbol." (insert (mapconcat 'concat - (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs) + (mapcar (lambda (x) (elmo-concat-path prefix (number-to-string x))) + msgs) "\n")) - (message "Fetching headers...") (as-binary-process (apply 'call-process-region (point-min) (point-max) prog t t nil (append args (list arc)))) (goto-char (point-min)) (cond ((looking-at delim1) ;; MMDF - (setq result (elmo-archive-parse-mmdf msgs - new-mark - already-mark seen-mark - seen-list)) - (setq overview (append overview (nth 0 result))) - (setq number-alist (append number-alist (nth 1 result))) - (setq mark-alist (append mark-alist (nth 2 result)))) -;;; ((looking-at delim2) ;; UNIX MAIL -;;; (setq result (elmo-archive-parse-unixmail msgs)) -;;; (setq overview (append overview (nth 0 result))) -;;; (setq number-alist (append number-alist (nth 1 result))) -;;; (setq mark-alist (append mark-alist (nth 2 result)))) + (elmo-msgdb-append + new-msgdb + (elmo-archive-parse-mmdf folder msgs flag-table))) +;;; ((looking-at delim2) ; UNIX MAIL +;;; (elmo-msgdb-append +;;; new-msgdb +;;; (elmo-archive-parse-unixmail msgs flag-table))) (t ;; unknown format (error "Unknown format!"))) - (when (> num elmo-display-progress-threshold) - (setq i (+ n i)) - (setq percent (/ (* i 100) num)) - (elmo-display-progress - 'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..." - percent)))) - (list overview number-alist mark-alist))) - -(defun elmo-archive-parse-mmdf (msgs new-mark - already-mark - seen-mark - seen-list) + (elmo-progress-notify 'elmo-folder-msgdb-create))) + new-msgdb)) + +(defun elmo-archive-parse-mmdf (folder msgs flag-table) (let ((delim elmo-mmdf-delimiter) - number sp ep rest entity overview number-alist mark-alist ret-val - message-id seen gmark) + (new-msgdb (elmo-make-msgdb)) + number sp ep rest entity + message-id flags) (goto-char (point-min)) (setq rest msgs) (while (and rest (re-search-forward delim nil t) @@ -1032,37 +1029,15 @@ TYPE specifies the archiver's symbol." () ; nop (save-excursion (narrow-to-region sp ep) - (setq entity (elmo-archive-msgdb-create-entity-subr number)) - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq number-alist - (elmo-msgdb-number-add - number-alist - (elmo-msgdb-overview-entity-get-number entity) - (car entity))) - (setq message-id (car entity)) - (setq seen (member message-id seen-list)) - (if (setq gmark - (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - seen-mark - new-mark)))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - (elmo-msgdb-overview-entity-get-number entity) - gmark))) - (setq ret-val (append ret-val (list overview number-alist mark-alist))) + (setq entity (elmo-archive-msgdb-create-entity-subr new-msgdb number) + message-id (elmo-message-entity-field entity 'message-id) + flags (elmo-flag-table-get flag-table message-id)) + (elmo-global-flags-set flags folder number message-id) + (elmo-msgdb-append-entity new-msgdb entity flags) (widen))) (forward-line 1) (setq rest (cdr rest))) - ret-val)) + new-msgdb)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1074,39 +1049,31 @@ TYPE specifies the archiver's symbol." (let* ((type (elmo-archive-folder-archive-type-internal folder)) (arc (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'cat)) - (args (list arc (elmo-concat-path prefix (int-to-string number))))) + (args (list arc (elmo-concat-path prefix (number-to-string number))))) (elmo-set-work-buf (when (file-exists-p arc) (as-binary-process (elmo-archive-call-method method args t)) - (elmo-set-buffer-multibyte default-enable-multibyte-characters) + (set-buffer-multibyte default-enable-multibyte-characters) (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset) - (elmo-buffer-field-condition-match condition number number-list)))))) + (elmo-message-buffer-match-condition condition number)))))) (luna-define-method elmo-folder-search ((folder elmo-archive-folder) condition &optional from-msgs) - (let* (;;(args (elmo-string-to-list key)) - ;; XXX: I don't know whether `elmo-archive-list-folder' - ;; updates match-data. - ;; (msgs (or from-msgs (elmo-archive-list-folder spec))) + (let* ((case-fold-search nil) +;;; (args (elmo-string-to-list key)) +;;; XXX: I don't know whether `elmo-archive-list-folder' updates match-data. +;;; (msgs (or from-msgs (elmo-archive-list-folder spec))) (msgs (or from-msgs (elmo-folder-list-messages folder))) - (num (length msgs)) - (i 0) - (case-fold-search nil) - number-list ret-val) - (setq number-list msgs) - (while msgs - (if (elmo-archive-field-condition-match - folder (car msgs) number-list - condition - (elmo-archive-folder-archive-prefix-internal folder)) - (setq ret-val (cons (car msgs) ret-val))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (elmo-display-progress - 'elmo-archive-search "Searching..." - (/ (* i 100) num))) - (setq msgs (cdr msgs))) + ret-val) + (elmo-with-progress-display (elmo-folder-search (length msgs)) "Searching" + (dolist (number msgs) + (when (elmo-archive-field-condition-match + folder number msgs + condition + (elmo-archive-folder-archive-prefix-internal folder)) + (setq ret-val (cons number ret-val))) + (elmo-progress-notify 'elmo-folder-search))) (nreverse ret-val))) ;;; method(alist)