X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-archive.el;h=2fb1c3c72afec9a7a3edb71a05f63aeec2e9a063;hb=a5bcb1f0eb41b558a6b4ed277047adc6b8676a2a;hp=0766110f44061a025dc6f20fb929f384fb0ad3cd;hpb=a36cd1f2bbcfbb74e7d369bc5645246cde4f227a;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 0766110..2fb1c3c 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 @@ -81,12 +81,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) @@ -116,7 +123,7 @@ (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$" @@ -302,7 +309,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 @@ -441,16 +448,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 +477,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,7 +506,9 @@ 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 @@ -511,10 +534,20 @@ TYPE specifies the archiver's symbol." 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) @@ -532,11 +565,12 @@ TYPE specifies the archiver's symbol." (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 @@ -544,11 +578,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 flag number) + (elmo-archive-folder-append-buffer folder flag number)) ;; verrrrrry slow!! -(defun elmo-archive-folder-append-buffer (folder unread number) +(defun elmo-archive-folder-append-buffer (folder flag 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)) @@ -587,8 +621,7 @@ TYPE specifies the archiver's symbol." 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 @@ -652,8 +685,8 @@ TYPE specifies the archiver's symbol." (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)) + (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)) @@ -754,14 +787,10 @@ TYPE specifies the archiver's symbol." (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)) @@ -843,7 +872,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 @@ -885,9 +914,7 @@ TYPE specifies the archiver's symbol." (elmo-archive-msgdb-create-entity-subr 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 @@ -895,17 +922,11 @@ 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)) @@ -931,17 +952,13 @@ TYPE specifies the archiver's symbol." (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)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -959,10 +976,8 @@ TYPE specifies the archiver's symbol." ;;; 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)) @@ -995,10 +1010,7 @@ 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 result (elmo-archive-parse-mmdf msgs flag-table)) (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)))) @@ -1017,13 +1029,10 @@ TYPE specifies the archiver's symbol." percent)))) (list overview number-alist mark-alist))) -(defun elmo-archive-parse-mmdf (msgs new-mark - already-mark - seen-mark - seen-list) +(defun elmo-archive-parse-mmdf (msgs flag-table) (let ((delim elmo-mmdf-delimiter) number sp ep rest entity overview number-alist mark-alist ret-val - message-id seen gmark) + message-id gmark) (goto-char (point-min)) (setq rest msgs) (while (and rest (re-search-forward delim nil t) @@ -1046,23 +1055,20 @@ TYPE specifies the archiver's symbol." (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)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (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 ret-val (append ret-val (list overview number-alist + mark-alist))) (widen))) (forward-line 1) (setq rest (cdr rest)))