-;;; elmo-archive.el -- Archive folder of ELMO.
+;;; elmo-archive.el --- Archive folder of ELMO. -*- coding: euc-japan -*-
;; Copyright (C) 1998,1999,2000 OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;; TODO:
;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£
;;; 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
;;; 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)
(symbol-name
(elmo-archive-folder-archive-type-internal
folder)))
- elmo-msgdb-dir)))
+ elmo-msgdb-directory)))
;;; MMDF parser -- info-zip agent w/ REXX
(defvar elmo-mmdf-delimiter "^\01\01\01\01$"
(` (cdr (assq (, type)
elmo-archive-file-regexp-alist))))
-(static-if (boundp 'NEMACS)
- (defsubst elmo-archive-call-process (prog args &optional output)
- (apply 'call-process prog nil output nil args)
- 0)
- (defsubst elmo-archive-call-process (prog args &optional output)
- (= (apply 'call-process prog nil output nil args) 0)))
+(defsubst elmo-archive-call-process (prog args &optional output)
+ (= (apply 'call-process prog nil output nil args) 0))
(defsubst elmo-archive-call-method (method args &optional output)
(cond
TYPE specifies the archiver's symbol."
(let* ((type (elmo-archive-folder-archive-type-internal folder))
(prefix (elmo-archive-folder-archive-prefix-internal folder))
- (file (elmo-archive-get-archive-name folder))
+ (file (elmo-archive-get-archive-name folder))
(method (elmo-archive-get-method type 'ls))
(args (list file))
(file-regexp (format (elmo-archive-get-regexp type)
(not (eobp))) ; for GNU tar 981010
(setq file-list (nconc file-list (list (string-to-int
(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
(defun elmo-archive-get-archive-name (folder)
(let ((dir (elmo-archive-get-archive-directory folder))
- (suffix (elmo-archive-get-suffix
+ (suffix (elmo-archive-get-suffix
(elmo-archive-folder-archive-type-internal
folder)))
filename dbdir)
dir)
filename))
filename)
- (if (or (not (file-exists-p dir)
- (file-directory-p dir)))
+ (if (or (not (file-exists-p dir))
+ (file-directory-p dir))
(expand-file-name
(concat elmo-archive-basename suffix)
dir)
(luna-define-method elmo-folder-creatable-p ((folder elmo-archive-folder))
t)
+(luna-define-method elmo-folder-writable-p ((folder elmo-archive-folder))
+ t)
+
(luna-define-method elmo-folder-create ((folder elmo-archive-folder))
(let* ((dir (directory-file-name ; remove tail slash.
(elmo-archive-get-archive-directory folder)))
- (type (elmo-archive-folder-archive-type-internal folder))
- (arc (elmo-archive-get-archive-name folder)))
+ (type (elmo-archive-folder-archive-type-internal folder))
+ (arc (elmo-archive-get-archive-name folder)))
(if elmo-archive-treat-file
(setq dir (directory-file-name (file-name-directory dir))))
(cond ((and (file-exists-p dir)
(not (file-directory-p dir)))
- ;; file exists
- (error "Create folder failed; File \"%s\" exists" dir))
- ((file-directory-p dir)
- (if (file-exists-p arc)
- t ; return value
+ ;; file exists
+ (error "Create folder failed; File \"%s\" exists" dir))
+ ((file-directory-p dir)
+ (if (file-exists-p arc)
+ t ; return value
(elmo-archive-create-file arc type folder)))
- (t
+ (t
(elmo-make-directory dir)
(elmo-archive-create-file arc type folder)
t))))
(save-excursion
(let* ((tmp-dir (directory-file-name
(elmo-folder-msgdb-path folder)))
- (dummy elmo-archive-dummy-file)
- (method (or (elmo-archive-get-method type 'create)
+ (dummy elmo-archive-dummy-file)
+ (method (or (elmo-archive-get-method type 'create)
(elmo-archive-get-method type 'mv)))
(args (list archive dummy)))
(when (null method)
))))
(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
(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
(prefix (if (string=
(elmo-archive-folder-archive-prefix-internal folder)
"")
- ""
+ ""
(concat ";"
(elmo-archive-folder-archive-prefix-internal
folder))))
"" (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
suffix prefix)))
flist)))
(elmo-mapcar-list-of-list
- (function (lambda (x) (concat (elmo-folder-prefix-internal folder) x)))
+ (function (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)
(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)))))
+ (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
(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))
(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
+ (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)))
- nil))))))
+ (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)))))
(luna-define-method elmo-folder-append-messages :around
- ((folder elmo-archive-folder) src-folder numbers unread-marks
- &optional same-number)
+ ((folder elmo-archive-folder) src-folder numbers &optional same-number)
(let ((prefix (elmo-archive-folder-archive-prefix-internal folder)))
- (cond
- ((and same-number
- (null prefix)
- (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)
- numbers)
- ((elmo-folder-message-make-temp-file-p src-folder)
- ;; not-same-number (localdir, localnews), (archive maildir) -> archive
- (let ((temp-dir (elmo-folder-message-make-temp-files
- src-folder
- numbers
- (unless same-number
- (1+ (if (file-exists-p (elmo-archive-get-archive-name
- 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)))
- numbers)
- (t (luna-call-next-method)))))
+ (cond
+ ((and same-number
+ (null prefix)
+ (elmo-folder-message-file-p src-folder)
+ (elmo-folder-message-file-number-p src-folder))
+ ;; same-number(localdir, localnews) -> archive
+ (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)
+ ;; not-same-number (localdir, localnews), (archive maildir) -> archive
+ (let ((temp-dir (elmo-folder-message-make-temp-files
+ src-folder
+ numbers
+ (unless same-number
+ (1+ (if (file-exists-p (elmo-archive-get-archive-name
+ 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)
+ (setq numbers nil)))
+ (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
+ numbers)
+ (t (luna-call-next-method)))))
(luna-define-method elmo-folder-message-make-temp-file-p
((folder elmo-archive-folder))
(or (elmo-archive-get-method type 'ext-pipe)
(elmo-archive-get-method type 'ext))))
-(luna-define-method elmo-folder-message-make-temp-files
+(luna-define-method elmo-folder-message-make-temp-files
((folder elmo-archive-folder) numbers
&optional start-number)
(elmo-archive-folder-message-make-temp-files folder numbers start-number))
(defun elmo-archive-folder-message-make-temp-files (folder
numbers
start-number)
- (let* ((tmp-dir-src (elmo-folder-make-temp-dir folder))
- (tmp-dir-dst (elmo-folder-make-temp-dir folder))
- (arc (elmo-archive-get-archive-name folder))
+ (let* ((tmp-dir-src (elmo-folder-make-temporary-directory folder))
+ (tmp-dir-dst (elmo-folder-make-temporary-directory folder))
+ (arc (elmo-archive-get-archive-name folder))
(type (elmo-archive-folder-archive-type-internal folder))
(prefix (elmo-archive-folder-archive-prefix-internal folder))
(p-method (elmo-archive-get-method type 'ext-pipe))
(int-to-string x))) numbers))
number)
;; Expand files in the tmp-dir-src.
- (elmo-bind-directory
+ (elmo-bind-directory
tmp-dir-src
(cond
((functionp n-method)
(elmo-delete-directory tmp-dir-src)
;; tmp-dir-dst is the return directory.
tmp-dir-dst))
-
+
(defun elmo-archive-append-files (folder dir &optional files)
(let* ((dst-type (elmo-archive-folder-archive-type-internal folder))
(arc (elmo-archive-get-archive-name folder))
(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))
(error "WARNING: not delete: %s (method undefined)" type)))))
(defun elmo-archive-exec-msgs-subr1 (prog args msgs)
- (let ((buf (get-buffer-create " *ELMO ARCHIVE exec*")))
- (set-buffer buf)
+ (with-temp-buffer
(insert (mapconcat 'concat msgs "\n")) ;string
- (unwind-protect
- (= 0
- (apply 'call-process-region (point-min) (point-max)
- prog nil nil nil args))
- (kill-buffer buf))))
+ (= 0 (apply 'call-process-region (point-min) (point-max)
+ prog nil nil nil args))))
(defun elmo-archive-exec-msgs-subr2 (prog args msgs arc-length)
(let ((max-len (- elmo-archive-cmdstr-max-length arc-length))
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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)
+(defsubst elmo-archive-msgdb-create-entity (msgdb
+ method
+ archive number type
+ &optional prefix)
(let* ((msg (elmo-concat-path prefix (int-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-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)
+ folder numbers flag-table)
(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)
+ 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 i percent num message-id flags)
(with-temp-buffer
(setq num (length numlist))
(setq i 0)
(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))))
+ (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))
(when (> num elmo-display-progress-threshold)
(setq i (1+ i))
(setq percent (/ (* i 100) num))
percent))
(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))
(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 i percent num msgs case-fold-search)
(with-temp-buffer
(setq num (length numlist))
(setq i 0)
(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)
(elmo-display-progress
'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..."
percent))))
- (list overview number-alist mark-alist)))
+ new-msgdb))
-(defun elmo-archive-parse-mmdf (msgs new-mark
- already-mark
- seen-mark
- seen-list)
+(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)
- (not (eobp)))
+ (not (eobp)))
(setq number (car rest))
(setq sp (1+ (point)))
(setq ep (prog2 (re-search-forward delim)
(1+ (- (point) (length delim)))))
(if (>= sp ep) ; no article!
() ; 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)))
+ (save-excursion
+ (narrow-to-region sp ep)
+ (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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
number-list ret-val)
(setq number-list msgs)
(while msgs
- (if (elmo-archive-field-condition-match
+ (if (elmo-archive-field-condition-match
folder (car msgs) number-list
condition
(elmo-archive-folder-archive-prefix-internal folder))