X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-archive.el;h=274bde1c3ab960e88495e120dd12fc3277044ee8;hb=6417feb1562e27e7c923ed470cf63760a553d46d;hp=31b7c704fda9b649a3e109e7ed3d065e4d78b863;hpb=e0d2e104ccdb5ee1c8fa06b722bf9fe7b3aa36d2;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 31b7c70..274bde1 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -146,15 +146,15 @@ (rar . "^[ \t]%s\\([0-9]+\\)$")))) (defvar elmo-archive-suffix-alist - '((lha . ".lzh") ; default -;;; (lha . ".lzs") - (zip . ".zip") - (zoo . ".zoo") -;;; (arc . ".arc") -;;; (arj . ".arj") - (rar . ".rar") - (tar . ".tar") - (tgz . ".tar.gz"))) + '((lha . ".lzh") ; default +;;; (lha . ".lzs") + (zip . ".zip") + (zoo . ".zoo") +;;; (arc . ".arc") +;;; (arj . ".arj") + (rar . ".rar") + (tar . ".tar") + (tgz . ".tar.gz"))) ;;; lha (defvar elmo-archive-lha-method-alist @@ -219,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) @@ -227,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")) @@ -235,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. @@ -428,20 +428,19 @@ TYPE specifies the archiver's symbol." (error "WARNING: read-only mode: %s (method undefined)" type)) (cond ((file-directory-p tmp-dir) - ()) ;nop + ()) ; nop ((file-exists-p tmp-dir) ;; file exists (error "Create directory failed; File \"%s\" exists" tmp-dir)) (t (elmo-make-directory tmp-dir))) - (elmo-bind-directory - tmp-dir - (write-region (point) (point) dummy nil 'no-msg) - (prog1 - (elmo-archive-call-method method args) - (if (file-exists-p dummy) - (delete-file dummy))) - )))) + (elmo-bind-directory tmp-dir + (write-region (point) (point) dummy nil 'no-msg) + (prog1 + (elmo-archive-call-method method args) + (if (file-exists-p dummy) + (delete-file dummy))) + )))) (luna-define-method elmo-folder-delete ((folder elmo-archive-folder)) (let ((msgs (and (elmo-folder-exists-p folder) @@ -508,7 +507,7 @@ TYPE specifies the archiver's symbol." 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 '/'. @@ -518,29 +517,29 @@ 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) - (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)))) + (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-folder-path folder) (or (elmo-archive-folder-dir-name-internal folder) "") @@ -560,7 +559,7 @@ 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))))) + prefix (number-to-string number))))) (and (file-exists-p arc) (as-binary-process (elmo-archive-call-method method args t)) @@ -600,25 +599,24 @@ 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))) - (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)) - (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))))) + (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)) + (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 @@ -667,7 +665,7 @@ TYPE specifies the archiver's symbol." (setq base-dir (expand-file-name ".." temp-dir))) (setq files (mapcar - '(lambda (x) (elmo-concat-path prefix x)) + (lambda (x) (elmo-concat-path prefix x)) (directory-files temp-dir nil "^[^\\.]"))) (unless (elmo-archive-append-files folder base-dir @@ -703,25 +701,24 @@ 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 - tmp-dir-src - (cond - ((functionp n-method) - (funcall n-method (cons arc tmp-msgs))) - (p-method - (let ((p-prog (car p-method)) - (p-prog-arg (cdr p-method))) - (elmo-archive-exec-msgs-subr1 - p-prog (append p-prog-arg (list arc)) tmp-msgs))) - (t - (let ((n-prog (car n-method)) - (n-prog-arg (cdr n-method))) - (elmo-archive-exec-msgs-subr2 - n-prog (append n-prog-arg (list arc)) tmp-msgs - (length arc)))))) + (elmo-bind-directory tmp-dir-src + (cond + ((functionp n-method) + (funcall n-method (cons arc tmp-msgs))) + (p-method + (let ((p-prog (car p-method)) + (p-prog-arg (cdr p-method))) + (elmo-archive-exec-msgs-subr1 + p-prog (append p-prog-arg (list arc)) tmp-msgs))) + (t + (let ((n-prog (car n-method)) + (n-prog-arg (cdr n-method))) + (elmo-archive-exec-msgs-subr2 + n-prog (append n-prog-arg (list arc)) tmp-msgs + (length arc)))))) ;; Move files to the tmp-dir-dst. (setq number start-number) (dolist (tmp-file tmp-msgs) @@ -730,7 +727,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))) @@ -752,21 +749,20 @@ TYPE specifies the archiver's symbol." (ding) (error "WARNING: read-only mode: %s (method undefined)" dst-type)) (save-excursion - (elmo-bind-directory - dir - (cond - ((functionp n-method) - (funcall n-method (cons arc files))) - (p-method - (let ((p-prog (car p-method)) - (p-prog-arg (cdr p-method))) - (elmo-archive-exec-msgs-subr1 - p-prog (append p-prog-arg (list arc)) files))) - (t - (let ((n-prog (car n-method)) - (n-prog-arg (cdr n-method))) - (elmo-archive-exec-msgs-subr2 - n-prog (append n-prog-arg (list arc)) files (length arc))))))))) + (elmo-bind-directory dir + (cond + ((functionp n-method) + (funcall n-method (cons arc files))) + (p-method + (let ((p-prog (car p-method)) + (p-prog-arg (cdr p-method))) + (elmo-archive-exec-msgs-subr1 + p-prog (append p-prog-arg (list arc)) files))) + (t + (let ((n-prog (car n-method)) + (n-prog-arg (cdr n-method))) + (elmo-archive-exec-msgs-subr2 + n-prog (append n-prog-arg (list arc)) files (length arc))))))))) (luna-define-method elmo-folder-delete-messages-internal ((folder elmo-archive-folder) @@ -776,9 +772,9 @@ TYPE specifies the archiver's symbol." (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))) @@ -811,20 +807,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)))) @@ -919,7 +917,7 @@ TYPE specifies the archiver's symbol." method archive number type &optional prefix) - (let* ((msg (elmo-concat-path prefix (int-to-string number))) + (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. @@ -989,7 +987,8 @@ 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")) (as-binary-process (apply 'call-process-region (point-min) (point-max) @@ -1000,7 +999,7 @@ TYPE specifies the archiver's symbol." (elmo-msgdb-append new-msgdb (elmo-archive-parse-mmdf folder msgs flag-table))) -;;; ((looking-at delim2) ;; UNIX MAIL +;;; ((looking-at delim2) ; UNIX MAIL ;;; (elmo-msgdb-append ;;; new-msgdb ;;; (elmo-archive-parse-unixmail msgs flag-table))) @@ -1046,23 +1045,22 @@ 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)) - (set-buffer-multibyte default-enable-multibyte-characters) - (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset) - (elmo-message-buffer-match-condition condition number)))))) + (when (file-exists-p arc) + (as-binary-process + (elmo-archive-call-method method args t)) + (set-buffer-multibyte default-enable-multibyte-characters) + (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset) + (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))) - (case-fold-search nil) ret-val) (elmo-with-progress-display (elmo-folder-search (length msgs)) "Searching" (dolist (number msgs)