-;;; elmo-archive.el -- Archive folder of ELMO.
+;;; elmo-archive.el --- Archive folder of ELMO.
;; 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:
-;;
+;;
(require 'elmo-msgdb)
(require 'emu)
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)
(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)
(prefix (if (string=
(elmo-archive-folder-archive-prefix-internal folder)
"")
- ""
+ ""
(concat ";"
(elmo-archive-folder-archive-prefix-internal
folder))))
(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)))
+ (elmo-archive-call-method method (list arc newfile))
+ t)
nil))))))
(luna-define-method elmo-folder-append-messages :around
((folder elmo-archive-folder) src-folder numbers unread-marks
&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))
(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))
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))
+ (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-folder-archive-type-internal folder)
'cat-headers))
(elmo-archive-msgdb-create-as-numlist-subr2
- folder numbers new-mark already-mark seen-mark important-mark
+ folder numbers new-mark already-mark seen-mark important-mark
seen-list)
(elmo-archive-msgdb-create-as-numlist-subr1
- folder numbers new-mark already-mark seen-mark important-mark
+ folder numbers new-mark already-mark seen-mark important-mark
seen-list)))))
-(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder
+(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder
numlist new-mark
already-mark seen-mark
important-mark
(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))
+ (save-excursion
+ (narrow-to-region sp ep)
+ (setq entity (elmo-archive-msgdb-create-entity-subr number))
(setq overview
(elmo-msgdb-append-element
overview entity))
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)))
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))
projects / elisp / wanderlust.git / blobdiff