;;; elmo-archive.el -- Archive folder of ELMO.
-;; Copyright 1998,1999,2000 OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;; Author: OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
+;; Author: OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
;; Created: Sep 13, 1998
-;; Revised: Dec 15, 1998
;; This file is part of ELMO (Elisp Library for Message Orchestration).
;;; Commentary:
;;
;; TODO:
-;; [\e$B%\%=\e(B] append-msgs() \e$B$,M_$7$$!J$1$I\e(B multi-refile \e$BIT2D!K!#\e(B
-;; Info-Zip \e$B@lMQ%(!<%8%'%s%H$rMQ$$$?F|K\8l8!:w!J\e(BOS/2 \e$B@lMQ!K!#\e(B
+;; [¥Ü¥½] append-msgs() ¤¬Íߤ·¤¤¡Ê¤±¤É multi-refile ÉԲġˡ£
+;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£
;;; Code:
;;
"*Regular expression of UNIX Mail delimiter.")
(defvar elmo-archive-header-regexp "^[ \t]*[-=][-=][-=][-=]"
- "*Common regexp of the delimiter in listing archive.") ;; marche
+ "*Common regexp of the delimiter in listing archive.") ; marche
(defvar elmo-archive-file-regexp-alist
(append
(if elmo-archive-lha-dos-compatible
- '((lha . "^%s\\([0-9]+\\)$")) ; OS/2,DOS w/ "-x"
+ '((lha . "^%s\\([0-9]+\\)$")) ; OS/2,DOS w/ "-x"
'((lha . "^.*[ \t]%s\\([0-9]+\\)$")))
'((zip . "^.*[ \t]%s\\([0-9]+\\)$")
(zoo . "^.*[ \t]%s\\([0-9]+\\)$")
- (tar . "^%s\\([0-9]+\\)$") ; ok
- (tgz . "^%s\\([0-9]+\\)$") ; ok
+ (tar . "^%s\\([0-9]+\\)$") ; ok
+ (tgz . "^%s\\([0-9]+\\)$") ; ok
(rar . "^[ \t]%s\\([0-9]+\\)$"))))
(defvar elmo-archive-suffix-alist
'((lha . ".lzh") ; default
-; (lha . ".lzs")
+;;; (lha . ".lzs")
(zip . ".zip")
(zoo . ".zoo")
-; (arc . ".arc")
-; (arj . ".arj")
+;;; (arc . ".arc")
+;;; (arj . ".arj")
(rar . ".rar")
(tar . ".tar")
(tgz . ".tar.gz")))
(rm . ("lha" "d"))
(ls . ("lha" "l" "-x"))
(cat . ("lha" "p" "-n"))
- (ext . ("lha" "x")) ; "-x"
+ (ext . ("lha" "x")) ; "-x"
)
;; some UN|X
'((cp . ("lha" "u"))
(mv . ("zoo" "aMq"))
(mv-pipe . ("zoo" "aMqI"))
(rm . ("zoo" "Dq"))
- (ls . ("zoo" "l")) ; normal
+ (ls . ("zoo" "l")) ; normal
(cat . ("zoo" "xpq"))
(ext . ("zoo" "xq"))))
'((ls . ("gtar" "-tf"))
(cat . ("gtar" "--posix Oxf"))
(ext . ("gtar" "-xf"))
- ;;(rm . ("gtar" "--posix" "--delete" "-f")) ;; well not work
+;;; (rm . ("gtar" "--posix" "--delete" "-f")) ; well not work
)
- '((ls . ("gtar" "-tf"))
- (cat . ("gtar" "-Oxf"))
- (ext . ("gtar" "-xf"))
- ;;(rm . ("gtar" "--delete" "-f")) ;; well not work
- )))
+ '((ls . ("gtar" "-tf"))
+ (cat . ("gtar" "-Oxf"))
+ (ext . ("gtar" "-xf"))
+;;; (rm . ("gtar" "--delete" "-f")) ;; well not work
+ )))
;;; GNU tar (*.tar.gz, *.tar.Z, *.tar.bz2)
(defvar elmo-archive-tgz-method-alist
'((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"))
(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.
(` (cdr (assq (, type)
elmo-archive-file-regexp-alist))))
-(defsubst elmo-archive-call-process (prog args &optional output)
- (= (apply 'call-process prog nil output nil args) 0))
+(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-method (method args &optional output)
(cond
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Scan Folder
-(defsubst elmo-archive-list-folder-subr (file type prefix &optional nonsort)
+(defsubst elmo-archive-list-folder-subr (spec &optional nonsort)
"*Returns list of number-file(int, not string) in archive FILE.
TYPE specifies the archiver's symbol."
- (let* ((method (elmo-archive-get-method type 'ls))
+ (let* ((type (nth 2 spec))
+ (prefix (nth 3 spec))
+ (file (elmo-archive-get-archive-name (nth 1 spec) type spec))
+ (method (elmo-archive-get-method type 'ls))
(args (list file))
(file-regexp (format (elmo-archive-get-regexp type)
(elmo-concat-path (regexp-quote prefix) "")))
- buf file-list header-end)
+ (killed (and elmo-use-killed-list
+ (elmo-msgdb-killed-list-load
+ (elmo-msgdb-expand-path spec))))
+ numbers buf file-list header-end)
(when (file-exists-p file)
(save-excursion
(set-buffer (setq buf (get-buffer-create " *ELMO ARCHIVE ls*")))
(match-string 1))))))
(kill-buffer buf)))
(if nonsort
- (cons (or (elmo-max-of-list file-list) 0) (length file-list))
- (sort file-list '<))))
+ (cons (or (elmo-max-of-list file-list) 0)
+ (if killed
+ (- (length file-list)
+ (elmo-msgdb-killed-list-length killed))
+ (length file-list)))
+ (setq numbers (sort file-list '<))
+ (elmo-living-messages numbers killed))))
-(defun elmo-archive-list-folder (spec)
- (let* ((type (nth 2 spec))
- (prefix (nth 3 spec))
- (arc (elmo-archive-get-archive-name (nth 1 spec) type spec)))
- (elmo-archive-list-folder-subr arc type prefix)))
+(defun elmo-archive-list-folder (spec &optional nohide)
+ (elmo-archive-list-folder-subr spec))
(defun elmo-archive-max-of-folder (spec)
- (let* ((type (nth 2 spec))
- (prefix (nth 3 spec))
- (arc (elmo-archive-get-archive-name (nth 1 spec) type spec)))
- (elmo-archive-list-folder-subr arc type prefix t)))
+ (elmo-archive-list-folder-subr spec t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ((dir (elmo-archive-get-archive-directory folder))
(suffix (elmo-archive-get-suffix type))
filename dbdir)
+ (unless suffix
+ (error "Unknown archiver type: %s" type))
(if elmo-archive-treat-file
(if (string-match (concat (regexp-quote suffix) "$") folder)
(expand-file-name
(expand-file-name
(concat folder suffix)
elmo-archive-folder-path))
- (if (and (not (find-file-name-handler dir 'copy-file)) ; dir is local.
+ (if (and (let ((handler (find-file-name-handler dir 'copy-file))) ; dir is local.
+ (or (not handler)
+ (if (featurep 'xemacs)
+ (eq handler 'dired-handler-fn))))
(or (not (file-exists-p dir))
(file-directory-p dir)))
(expand-file-name
(if (and (find-file-name-handler dir 'copy-file) ; ange-ftp, efs
spec)
(progn
- (setq filename (expand-file-name
+ (setq filename (expand-file-name
(concat elmo-archive-basename suffix)
- (setq dbdir (elmo-msgdb-expand-path nil spec))))
+ (setq dbdir (elmo-msgdb-expand-path spec))))
(if (file-directory-p dbdir)
(); ok.
(if (file-exists-p dbdir)
t)
(defun elmo-archive-create-folder (spec)
- (let* ((dir (directory-file-name ;; remove tail slash.
+ (let* ((dir (directory-file-name ; remove tail slash.
(elmo-archive-get-archive-directory (nth 1 spec))))
(type (nth 2 spec))
(arc (elmo-archive-get-archive-name (nth 1 spec) type)))
(error "Create folder failed; File \"%s\" exists" dir))
((file-directory-p dir)
(if (file-exists-p arc)
- t ; return value
+ t ; return value
(elmo-archive-create-file arc type spec)))
(t
(elmo-make-directory dir)
(defun elmo-archive-create-file (archive type spec)
(save-excursion
(let* ((tmp-dir (directory-file-name
- (elmo-msgdb-expand-path nil spec)))
+ (elmo-msgdb-expand-path spec)))
(dummy elmo-archive-dummy-file)
(method (or (elmo-archive-get-method type 'create)
(elmo-archive-get-method type 'mv)))
(defun elmo-archive-delete-folder (spec)
(let* ((arc (elmo-archive-get-archive-name (nth 1 spec) (nth 2 spec))))
(if (not (file-exists-p arc))
- (error "no such file: %s" arc)
+ (error "No such file: %s" arc)
(delete-file arc)
t)))
(nth 1 new-spec) (nth 2 new-spec))))
(unless (and (eq (nth 2 old-spec) (nth 2 new-spec))
(equal (nth 3 old-spec) (nth 3 new-spec)))
- (error "not same archive type and prefix"))
+ (error "Not same archive type and prefix"))
(if (not (file-exists-p old-arc))
- (error "no such file: %s" old-arc)
+ (error "No such file: %s" old-arc)
(if (file-exists-p new-arc)
- (error "already exists: %s" new-arc)
+ (error "Already exists: %s" new-arc)
(rename-file old-arc new-arc)
t))))
(if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'.
(setq base-folder (elmo-match-string 1 base-folder))
(unless (file-directory-p path)
- (setq base-folder (file-name-directory base-folder))))
+ (setq base-folder (or (file-name-directory base-folder)
+ base-folder))))
(delq
nil
(mapcar
;;; Article file related functions
;;; read(extract) / append(move) / delete(delete) / query(list)
-(defun elmo-archive-read-msg (spec number outbuf)
+(defun elmo-archive-read-msg (spec number outbuf &optional msgdb unread)
(save-excursion
(let* ((type (nth 2 spec))
(arc (elmo-archive-get-archive-name (nth 1 spec) type spec))
(prefix (nth 3 spec))
(method (elmo-archive-get-method type 'cat))
- (args (list arc (elmo-concat-path
+ (args (list arc (elmo-concat-path
prefix (int-to-string number)))))
(set-buffer outbuf)
(erase-buffer)
(elmo-archive-call-method method args t))
(elmo-delete-cr-get-content-type))))))
-(defun elmo-archive-append-msg (spec string &optional msg no-see) ;;; verrrrrry slow!!
+;; verrrrrry slow!!
+(defun elmo-archive-append-msg (spec string &optional msg no-see)
(let* ((type (nth 2 spec))
(prefix (nth 3 spec))
(arc (elmo-archive-get-archive-name (nth 1 spec) type))
(next-num (or msg
(1+ (if (file-exists-p arc)
(car (elmo-archive-max-of-folder spec)) 0))))
- (tmp-dir (elmo-msgdb-expand-path nil spec))
+ (tmp-dir (elmo-msgdb-expand-path spec))
newfile)
(when (null method)
(ding)
nil))
(kill-buffer tmp-buffer)))))
-;;; (localdir, maildir, localnews, archive) -> archive
+;; (localdir, maildir, localnews, archive) -> archive
(defun elmo-archive-copy-msgs (dst-spec msgs src-spec
&optional loc-alist same-number)
(let* ((dst-type (nth 2 dst-spec))
(1+ (car (elmo-archive-max-of-folder dst-spec)))))
(src-dir (elmo-localdir-get-folder-directory src-spec))
(tmp-dir
- (file-name-as-directory (elmo-msgdb-expand-path nil dst-spec)))
+ (file-name-as-directory (elmo-msgdb-expand-path dst-spec)))
(do-link t)
src tmp newfile tmp-msgs)
(when (not (elmo-archive-folder-exists-p dst-spec))
(setq tmp-dir (substring src-dir 0 (match-beginning 0)))
(setq p-method (elmo-archive-get-method dst-type 'cp-pipe)
n-method (elmo-archive-get-method dst-type 'cp))
- (setq tmp-msgs (mapcar '(lambda (x)
+ (setq tmp-msgs (mapcar '(lambda (x)
(elmo-concat-path prefix (int-to-string x)))
msgs))
(setq do-link nil))
(p-method (elmo-archive-get-method src-type 'ext-pipe))
(n-method (elmo-archive-get-method src-type 'ext))
(tmp-dir
- (file-name-as-directory (elmo-msgdb-expand-path nil src-spec)))
+ (file-name-as-directory (elmo-msgdb-expand-path src-spec)))
(tmp-msgs (mapcar '(lambda (x) (elmo-concat-path
prefix
(int-to-string x)))
(defsubst elmo-archive-article-exists-p (arc msg type)
(if (not elmo-archive-check-existance-strict)
- t ; nop
- (save-excursion ;; added 980915
+ t ; nop
+ (save-excursion ; added 980915
(let* ((method (elmo-archive-get-method type 'ls))
(args (list arc msg))
(buf (get-buffer-create " *ELMO ARCHIVE query*"))
(narrow-to-region (point-min) header-end)
(elmo-msgdb-create-overview-from-buffer number)))
-(defsubst elmo-archive-msgdb-create-entity (method archive number type &optional prefix) ;; verrrry slow!!
+;; verrrry slow!!
+(defsubst elmo-archive-msgdb-create-entity (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)
(if (and elmo-archive-use-izip-agent
(elmo-archive-get-method (nth 2 spec) 'cat-headers))
(elmo-archive-msgdb-create-as-numlist-subr2
- spec numlist new-mark already-mark seen-mark important-mark
+ spec numlist new-mark already-mark seen-mark important-mark
seen-list)
(elmo-archive-msgdb-create-as-numlist-subr1
spec numlist new-mark already-mark seen-mark important-mark
(defun elmo-archive-msgdb-create-as-numlist-subr1 (spec numlist new-mark
already-mark seen-mark
- important-mark
+ important-mark
seen-list)
(let* ((type (nth 2 spec))
(file (elmo-archive-get-archive-name (nth 1 spec) type spec))
seen-mark
new-mark))))
(setq mark-alist
- (elmo-msgdb-mark-append
+ (elmo-msgdb-mark-append
mark-alist
(elmo-msgdb-overview-entity-get-number entity)
gmark))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..."
- percent)
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..."
+ percent))
(setq numlist (cdr numlist)))
(kill-buffer tmp-buf)
- (message "Creating msgdb...done.")
+ (message "Creating msgdb...done")
(list overview number-alist mark-alist)) ))
;;; info-zip agent
(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))))
+;;; ((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))))
(t ;; unknown format
- (error "unknown format!")))
- (setq i (+ n i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..."
- percent))
+ (error "Unknown format!")))
+ (when (> num elmo-display-progress-threshold)
+ (setq i (+ n i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..."
+ percent)))
(kill-buffer buf)
(list overview number-alist mark-alist)) )
(defun elmo-archive-parse-mmdf (msgs new-mark
- already-mark
- seen-mark
+ already-mark
+ seen-mark
seen-list)
(let ((delim elmo-mmdf-delimiter)
number sp ep rest entity overview number-alist mark-alist ret-val
(setq sp (1+ (point)))
(setq ep (prog2 (re-search-forward delim)
(1+ (- (point) (length delim)))))
- (if (>= sp ep) ; no article!
- () ; nop
+ (if (>= sp ep) ; no article!
+ () ; nop
(save-excursion
(narrow-to-region sp ep)
(setq entity (elmo-archive-msgdb-create-entity-subr number))
(car entity)))
(setq message-id (car entity))
(setq seen (member message-id seen-list))
- (if (setq gmark
+ (if (setq gmark
(or (elmo-msgdb-global-mark-get message-id)
(if (elmo-cache-exists-p message-id) ; XXX
(if seen
seen-mark
new-mark))))
(setq mark-alist
- (elmo-msgdb-mark-append
+ (elmo-msgdb-mark-append
mark-alist
(elmo-msgdb-overview-entity-get-number entity)
gmark)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Search functions
-(defsubst elmo-archive-field-condition-match (spec number condition prefix)
+(defsubst elmo-archive-field-condition-match (spec number number-list
+ condition prefix)
(save-excursion
(let* ((type (nth 2 spec))
(arc (elmo-archive-get-archive-name (nth 1 spec) type spec))
(elmo-archive-call-method method args t))
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
(decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
- (elmo-buffer-field-condition-match condition))))))
+ (elmo-buffer-field-condition-match condition number number-list))))))
(defun elmo-archive-search (spec condition &optional from-msgs)
(let* (;;(args (elmo-string-to-list key))
(num (length msgs))
(i 0)
(case-fold-search nil)
- ret-val)
+ number-list ret-val)
+ (setq number-list msgs)
(while msgs
- (if (elmo-archive-field-condition-match spec (car msgs)
+ (if (elmo-archive-field-condition-match spec (car msgs) number-list
condition
(nth 3 spec))
(setq ret-val (cons (car msgs) ret-val)))
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-archive-search "Searching..."
- (/ (* i 100) num))
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (elmo-display-progress
+ 'elmo-archive-search "Searching..."
+ (/ (* i 100) num)))
(setq msgs (cdr msgs)))
(nreverse ret-val)))
nil)
(defun elmo-archive-get-msg-filename (spec number &optional loc-alist)
- (let ((tmp-dir (file-name-as-directory (elmo-msgdb-expand-path nil spec)))
+ (let ((tmp-dir (file-name-as-directory (elmo-msgdb-expand-path spec)))
(prefix (nth 3 spec)))
(expand-file-name
(elmo-concat-path prefix (int-to-string number))
tmp-dir)))
-(defalias 'elmo-archive-sync-number-alist
+(defalias 'elmo-archive-sync-number-alist
'elmo-generic-sync-number-alist)
-(defalias 'elmo-archive-list-folder-unread
+(defalias 'elmo-archive-list-folder-unread
'elmo-generic-list-folder-unread)
(defalias 'elmo-archive-list-folder-important
'elmo-generic-list-folder-important)
(defalias 'elmo-archive-commit 'elmo-generic-commit)
+(defalias 'elmo-archive-folder-diff 'elmo-generic-folder-diff)
;;; End
(run-hooks 'elmo-archive-load-hook)
-(provide 'elmo-archive)
+
+(require 'product)
+(product-provide (provide 'elmo-archive) (require 'elmo-version))
;;; elmo-archive.el ends here
projects / elisp / wanderlust.git / blobdiff