X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-archive.el;h=4db7c42e4be81249770615e3b833fbf9a66a07d8;hb=64eb91d7fe775e78e0f1e6555b595e40f391260a;hp=eb3e8954113294e4de792d3fb10addad8041b935;hpb=326b52af9c83997f55f60853ffbe7e70fcaf8157;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index eb3e895..4db7c42 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. ;; 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$" @@ -260,12 +267,8 @@ (` (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 @@ -444,7 +447,7 @@ TYPE specifies the archiver's symbol." (delete-file dummy))) )))) -(luna-define-method elmo-folder-delete ((folder elmo-archive-folder)) +(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) @@ -489,7 +492,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 @@ -515,10 +520,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) @@ -536,11 +551,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 @@ -591,54 +607,55 @@ 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 - (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 + (elmo-archive-append-files folder + (elmo-folder-message-file-directory src-folder) + numbers) + (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))) + (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)) @@ -654,8 +671,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)) @@ -756,14 +773,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)) @@ -845,7 +858,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 @@ -887,9 +900,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 seen-list) (when numbers (save-excursion ;; 981005 (if (and elmo-archive-use-izip-agent @@ -897,17 +908,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 seen-list) (elmo-archive-msgdb-create-as-numlist-subr1 - folder numbers new-mark already-mark seen-mark important-mark - seen-list))))) + folder numbers seen-list))))) -(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder - numlist new-mark - already-mark seen-mark - important-mark - seen-list) +(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder numlist seen-list) (let* ((type (elmo-archive-folder-archive-type-internal folder)) (file (elmo-archive-get-archive-name folder)) (method (elmo-archive-get-method type 'cat)) @@ -940,10 +945,10 @@ TYPE specifies the archiver's symbol." (elmo-file-cache-get message-id)) (if seen nil - already-mark) + elmo-msgdb-unread-cached-mark) (if seen - seen-mark - new-mark)))) + elmo-msgdb-read-uncached-mark + elmo-msgdb-new-mark)))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -961,9 +966,7 @@ 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 + numlist seen-list) (let* ((delim1 elmo-mmdf-delimiter) ;; MMDF (delim2 elmo-unixmail-delimiter) ;; UNIX Mail @@ -997,10 +1000,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 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)))) @@ -1019,10 +1019,7 @@ 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 seen-list) (let ((delim elmo-mmdf-delimiter) number sp ep rest entity overview number-alist mark-alist ret-val message-id seen gmark) @@ -1055,16 +1052,17 @@ TYPE specifies the archiver's symbol." (elmo-file-cache-get message-id)) (if seen nil - already-mark) + elmo-msgdb-unread-cached-mark) (if seen - seen-mark - new-mark)))) + elmo-msgdb-read-uncached-mark + elmo-msgdb-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 ret-val (append ret-val (list overview number-alist + mark-alist))) (widen))) (forward-line 1) (setq rest (cdr rest)))