X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-archive.el;h=8437532c1b4b6d9eedfaa48f7be42fdf630b456c;hb=d9e613d8c4841bd56a057163810d8b77487bf8a9;hp=fe7a2b8e2fa3247c35854ff9673051ba27a0362f;hpb=47972777916535ae9ea19df8ae993dd0aba58546;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index fe7a2b8..8437532 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,7 +33,9 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) +(require 'elmo) (require 'elmo-msgdb) (require 'emu) (require 'std11) @@ -309,7 +311,7 @@ TYPE specifies the archiver's symbol." (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 @@ -447,17 +449,29 @@ TYPE specifies the archiver's symbol." (delete-file dummy))) )))) -(luna-define-method elmo-folder-delete :before ((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))) +(luna-define-method elmo-folder-delete ((folder elmo-archive-folder)) + (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 @@ -465,12 +479,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 @@ -522,7 +538,7 @@ TYPE specifies the archiver's symbol." (elmo-mapcar-list-of-list (function (lambda (x) (if (file-exists-p - (expand-file-name + (expand-file-name (concat elmo-archive-basename (elmo-archive-get-suffix (elmo-archive-folder-archive-type-internal @@ -564,11 +580,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)) @@ -602,13 +618,17 @@ TYPE specifies the archiver's symbol." (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) + (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 @@ -616,9 +636,10 @@ 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) @@ -653,7 +674,8 @@ TYPE specifies the archiver's symbol." (if (elmo-archive-append-files folder base-dir files) - (elmo-delete-directory temp-dir))) + (elmo-delete-directory temp-dir) + (setq numbers nil))) (elmo-progress-notify 'elmo-folder-move-messages (length numbers)) numbers) (t (luna-call-next-method))))) @@ -746,8 +768,9 @@ 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)) @@ -880,30 +903,32 @@ 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) +(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 @@ -911,22 +936,16 @@ TYPE specifies the archiver's symbol." (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) @@ -935,34 +954,14 @@ TYPE specifies the archiver's symbol." (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)) @@ -971,14 +970,12 @@ TYPE specifies the archiver's symbol." 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)) @@ -987,8 +984,8 @@ 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 i percent num msgs case-fold-search) (with-temp-buffer (setq num (length numlist)) (setq i 0) @@ -1011,18 +1008,13 @@ TYPE specifies the archiver's symbol." (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) @@ -1031,15 +1023,13 @@ TYPE specifies the archiver's symbol." (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) @@ -1052,37 +1042,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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1099,7 +1067,7 @@ TYPE specifies the archiver's symbol." (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))))))