-elmo-search \e$B$G\e(B msgdb \e$B$H%U%)%k%@K\BN$r%7!<%`%l%9$K8!:w\e(B
-pick/virtual \e$B$N\e(B completion \e$BE}9g\e(B
msgdb \e$B9=B$$N8+D>$7$H\e(B obarray \e$B2=\e(B
\e$B=EMW%^!<%/$N4IM}\e(B
\e$B%5%^%j%U%)!<%^%C%H<+M32=\e(B
+2001-02-06 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-mark.el: New file.
+
+ * elmo-internal.el: Rewrite (Almost empty).
+
+2001-02-05 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * mmimap.el (mmimap-make-mime-entity): Consider message/rfc822.
+ (mime-imap-entity-header-string): Ditto.
+ (mmimap-entity-section): Rewrite.
+
+2001-01-30 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-nmz.el: New file.
+
+ * elmo-pipe.el: Rewrite with luna.
+
+2001-01-29 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-archive.el: Rewrite with luna.
+
+ * elmo-multi.el (elmo-folder-list-unreads-internal): Fixed.
+ (elmo-folder-list-importants-internal): Ditto.
+
+2001-01-24 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-archive.el (elmo-archive-version): Abolish.
+ (toplevel) Removed `boso' comment.
+
+2001-01-23 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-msgdb.el (elmo-msgdb-add-msgs-to-seen-list): Renamed from
+ elmo-msgdb-add-msgs-to-seen-list-subr;
+ Changed argument seen-marks to unread-marks.
+
+ * elmo-nntp.el: Rewrite with luna.
+
+2001-01-22 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-filter.el: Rewrite with luna.
+
+2001-01-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-pop3.el: Rewrite with luna.
+
+2001-01-17 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-multi.el: Rewrite with luna.
+
+ * elmo-vars.el (elmo-use-killed-list): Abolish.
+ All other related portions are changed.
+ (elmo-filename-replace-string-alist): Renamed from
+ elmo-msgid-replace-string-alist.
+
+2001-01-16 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-msgdb.el (elmo-msgdb-delete-msgs): Changed argument.
+
+ * elmo-map.el: New file.
+ * elmo-maildir.el: Rewrite with luna.
+
+2001-01-14 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo.el: Changed meaning of `elmo-folder-commit'.
+ * elmo-mime.el (elmo-mime-display-as-is-internal): New function.
+
+2001-01-07 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo.el (elmo-folder-append-buffer): New function.
+ (Renamed from `elmo-append-msg')
+
+2000-12-18 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-mime.el: New file.
+
+2000-12-14 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-cache.el: Rewrite.
+
+2000-12-08 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-vars.el (elmo): New group.
+ (elmo-strict-diff-folder-regexp): New variable.
+
+ * elmo-util.el (elmo-call-func): Abolish.
+ (elmo-folder-get-type): Ditto.
+ (elmo-*-get-spec): Ditto.
+ (elmo-*-spec-*): Ditto.
+ (elmo-imap4-identical-name-space-p): Ditto.
+ (elmo-folder-identical-system-p): Ditto.
+ (elmo-folder-direct-copy-alist): Ditto.
+ (elmo-folder-direct-copy-p): Ditto.
+
+ * elmo-pipe.el (elmo-pipe-folder): New luna class.
+ (elmo-folder-initialize): Define.
+ (elmo-folder-get-primitive-list): Ditto.
+
+ * elmo-nntp.el (elmo-nntp-folder): New luna class.
+ (elmo-folder-initialize): Define.
+ Renamed `elmo-network-session-host-internal' to
+ `elmo-network-session-server-internal'.
+
+ * elmo-multi.el (elmo-multi-folder): New luna class.
+ (elmo-folder-initialize): Define.
+ (elmo-folder-get-primitive-list): Ditto.
+ (elmo-folder-contains-type): Ditto.
+ (elmo-message-use-cache-p): Ditto.
+
+ * elmo-msgdb.el (elmo-msgdb-expand-path): Abolish.
+ Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path'.
+
+ * elmo-maildir.el (elmo-maildir-folder): New luna class.
+ (elmo-folder-initialize): Define.
+
+ * elmo-filter.el (elmo-filter-folder): New luna class.
+ (elmo-folder-initialize): Define.
+ (elmo-folder-get-primitive-list): Ditto.
+ (elmo-folder-contains-type): Ditto.
+
+2000-12-06 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-imap4.el: Rewrite with luna.
+
+ * elmo-net.el: Ditto.
+
+ * elmo-pop3.el (elmo-pop3-folder): New luna class.
+ (elmo-folder-initialize): Define.
+
+ * elmo-archive.el (elmo-archive-folder): New luna class.
+ (elmo-folder-initialize): Define.
+
+ * elmo-dop.el: Rename `elmo-msgdb-expand-path' to
+ `elmo-folder-msgdb-path'.
+ (elmo-dop-queue-append): Use `elmo-folder-name-internal' and
+ `elmo-make-folder'.
+
+2000-12-06 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo.el: New file.
+
+ * elmo2.el: Renamed to elmo.el.
+
+\f
2001-02-01 OKAZAKI Tetsurou <okazaki@be.to>
* elmo-cache.el (elmo-cache-expire-by-size): Count
;;; Commentary:
;;
;; TODO:
-;; [¥Ü¥½] append-msgs() ¤¬Íߤ·¤¤¡Ê¤±¤É multi-refile ÉԲġˡ£
;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£
;;; Code:
(require 'std11)
(eval-when-compile (require 'elmo-localdir))
-;;; Const
-(defconst elmo-archive-version "v0.18 [990729/alpha]")
-
;;; User vars.
(defvar elmo-archive-lha-dos-compatible
(memq system-type '(OS/2 emx windows-nt))
(defvar elmo-archive-treat-file nil
"*Treat archive folder as a file if non-nil.")
+;;; User variables for elmo-archive.
+(defvar elmo-archive-default-type 'zip
+ "*Default archiver type. The value must be a symbol.")
+
+(defvar elmo-archive-use-cache nil
+ "Use cache in archive folder.")
+
+;;; ELMO Local directory folder
+(eval-and-compile
+ (luna-define-class elmo-archive-folder (elmo-folder)
+ (archive-name archive-type archive-prefix))
+ (luna-define-internal-accessors 'elmo-archive-folder))
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-archive-folder)
+ name)
+ (when (string-match
+ "^\\([^;]*\\);?\\([^;]*\\);?\\([^;]*\\)$"
+ name)
+ ;; Drive letter is OK!
+ (or (elmo-archive-folder-set-archive-name-internal
+ folder (elmo-match-string 1 name))
+ (elmo-archive-folder-set-archive-name-internal
+ folder ""))
+ (or (elmo-archive-folder-set-archive-type-internal
+ folder (intern-soft (elmo-match-string 2 name)))
+ (elmo-archive-folder-set-archive-type-internal
+ folder elmo-archive-default-type))
+ (or (elmo-archive-folder-set-archive-prefix-internal
+ folder (elmo-match-string 3 name))
+ (elmo-archive-folder-set-archive-prefix-internal
+ folder "")))
+ folder)
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-archive-folder))
+ ;; For compatibility
+ (expand-file-name
+ (elmo-replace-string-as-filename
+ (elmo-folder-name-internal folder))
+ (expand-file-name (concat (symbol-name (elmo-folder-type-internal folder))
+ "/"
+ (symbol-name
+ (elmo-archive-folder-archive-type-internal
+ folder)))
+ elmo-msgdb-dir)))
+
;;; MMDF parser -- info-zip agent w/ REXX
(defvar elmo-mmdf-delimiter "^\01\01\01\01$"
"*Regular expression of MMDF delimiter.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Scan Folder
-(defsubst elmo-archive-list-folder-subr (spec &optional nonsort)
+(defsubst elmo-archive-list-folder-subr (folder &optional nonsort)
"*Returns list of number-file(int, not string) in archive FILE.
TYPE specifies the archiver's symbol."
- (let* ((type (nth 2 spec))
- (prefix (nth 3 spec))
- (file (elmo-archive-get-archive-name (nth 1 spec) type spec))
+ (let* ((type (elmo-archive-folder-archive-type-internal folder))
+ (prefix (elmo-archive-folder-archive-prefix-internal 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)
(elmo-concat-path (regexp-quote prefix) "")))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
+ (killed (elmo-folder-killed-list-internal folder))
numbers buf file-list header-end)
- (when (file-exists-p file)
- (save-excursion
- (set-buffer (setq buf (get-buffer-create " *ELMO ARCHIVE ls*")))
- (unless (elmo-archive-call-method method args t)
- (error "%s exited abnormally!" method))
- (goto-char (point-min))
- (when (re-search-forward elmo-archive-header-regexp nil t)
- (forward-line 1)
- (setq header-end (point))
+ (if (file-exists-p file)
+ (with-temp-buffer
+ (unless (elmo-archive-call-method method args t)
+ (error "%s exited abnormally!" method))
+ (goto-char (point-min))
(when (re-search-forward elmo-archive-header-regexp nil t)
+ (forward-line 1)
+ (setq header-end (point))
+ (when (re-search-forward elmo-archive-header-regexp nil t)
(beginning-of-line)
(narrow-to-region header-end (point))
(goto-char (point-min))))
- (while (and (re-search-forward file-regexp nil t)
- (not (eobp))) ; for GNU tar 981010
- (setq file-list (nconc file-list (list (string-to-int
- (match-string 1))))))
- (kill-buffer buf)))
+ (while (and (re-search-forward file-regexp nil t)
+ (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))
(if nonsort
(cons (or (elmo-max-of-list file-list) 0)
(if killed
(setq numbers (sort file-list '<))
(elmo-living-messages numbers killed))))
-(defun elmo-archive-list-folder (spec)
- (elmo-archive-list-folder-subr spec))
-
-(defun elmo-archive-max-of-folder (spec)
- (elmo-archive-list-folder-subr spec t))
+(luna-define-method elmo-folder-list-messages-internal ((folder
+ elmo-archive-folder))
+ (elmo-archive-list-folder-subr folder))
+(luna-define-method elmo-folder-status ((folder elmo-archive-folder))
+ (elmo-archive-list-folder-subr folder t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Folder related functions
-(defsubst elmo-archive-get-archive-directory (name)
+(defsubst elmo-archive-get-archive-directory (folder)
;; allow fullpath. return format is "/foo/bar/".
- (if (file-name-absolute-p name)
- (if (find-file-name-handler name 'copy-file)
- name
- (expand-file-name name))
- (expand-file-name name elmo-archive-folder-path)))
-
-(defun elmo-archive-get-archive-name (folder type &optional spec)
+ (if (file-name-absolute-p (elmo-archive-folder-archive-name-internal folder))
+ (if (find-file-name-handler
+ (elmo-archive-folder-archive-name-internal folder)
+ 'copy-file)
+ (elmo-archive-folder-archive-name-internal folder)
+ (expand-file-name (elmo-archive-folder-archive-name-internal folder)))
+ (expand-file-name (elmo-archive-folder-archive-name-internal folder)
+ elmo-archive-folder-path)))
+
+(defun elmo-archive-get-archive-name (folder)
(let ((dir (elmo-archive-get-archive-directory folder))
- (suffix (elmo-archive-get-suffix type))
+ (suffix (elmo-archive-get-suffix
+ (elmo-archive-folder-archive-type-internal
+ folder)))
filename dbdir)
(if elmo-archive-treat-file
- (if (string-match (concat (regexp-quote suffix) "$") folder)
- (expand-file-name
- folder
- elmo-archive-folder-path)
- (expand-file-name
- (concat folder suffix)
- elmo-archive-folder-path))
- (if (and (let ((handler (find-file-name-handler dir 'copy-file))) ; dir is local.
+ (if (string-match (concat (regexp-quote suffix) "$")
+ (elmo-archive-folder-archive-name-internal folder))
+ (expand-file-name (elmo-archive-folder-archive-name-internal
+ folder)
+ elmo-archive-folder-path)
+ (expand-file-name (concat (elmo-archive-folder-archive-name-internal
+ folder)
+ suffix)
+ elmo-archive-folder-path))
+ (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))))
(concat elmo-archive-basename suffix)
dir)
;; for full-path specification.
- (if (and (find-file-name-handler dir 'copy-file) ; ange-ftp, efs
- spec)
+ (if (find-file-name-handler dir 'copy-file) ; ange-ftp, efs
(progn
(setq filename (expand-file-name
(concat elmo-archive-basename suffix)
- (setq dbdir (elmo-msgdb-expand-path spec))))
+ (setq dbdir
+ (elmo-folder-msgdb-path folder))))
(if (file-directory-p dbdir)
(); ok.
(if (file-exists-p dbdir)
filename)
dir)))))
-(defun elmo-archive-folder-exists-p (spec)
- (file-exists-p
- (elmo-archive-get-archive-name (nth 1 spec) (nth 2 spec) spec)))
+(luna-define-method elmo-folder-exists-p ((folder elmo-archive-folder))
+ (file-exists-p (elmo-archive-get-archive-name folder)))
-(defun elmo-archive-folder-creatable-p (spec)
+(luna-define-method elmo-folder-creatable-p ((folder elmo-archive-folder))
t)
-(defun elmo-archive-create-folder (spec)
+(luna-define-method elmo-folder-create ((folder elmo-archive-folder))
(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)))
+ (elmo-archive-get-archive-directory 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)
((file-directory-p dir)
(if (file-exists-p arc)
t ; return value
- (elmo-archive-create-file arc type spec)))
+ (elmo-archive-create-file arc type folder)))
(t
(elmo-make-directory dir)
- (elmo-archive-create-file arc type spec)
+ (elmo-archive-create-file arc type folder)
t))))
-(defun elmo-archive-create-file (archive type spec)
+(defun elmo-archive-create-file (archive type folder)
(save-excursion
(let* ((tmp-dir (directory-file-name
- (elmo-msgdb-expand-path spec)))
+ (elmo-folder-msgdb-path folder)))
(dummy elmo-archive-dummy-file)
(method (or (elmo-archive-get-method type 'create)
(elmo-archive-get-method type 'mv)))
(delete-file dummy)))
))))
-(defun elmo-archive-delete-folder (spec)
- (let* ((arc (elmo-archive-get-archive-name (nth 1 spec) (nth 2 spec))))
+(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)))
-(defun elmo-archive-rename-folder (old-spec new-spec)
- (let* ((old-arc (elmo-archive-get-archive-name
- (nth 1 old-spec) (nth 2 old-spec)))
- (new-arc (elmo-archive-get-archive-name
- (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)))
+(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)))
+ (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
+ folder)
+ (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)
(rename-file old-arc new-arc)
t))))
-(defun elmo-archive-list-folders (spec &optional hierarchy)
- (let ((folder (concat "$" (nth 1 spec)))
- (elmo-localdir-folder-path elmo-archive-folder-path))
- (if elmo-archive-treat-file
- (let* ((path (elmo-localdir-get-folder-directory spec))
- (base-folder (or (nth 1 spec) ""))
- (suffix (nth 2 spec))
- (prefix (if (string= (nth 3 spec) "")
- "" (concat ";" (nth 3 spec))))
- (dir (if (file-directory-p path)
- path (file-name-directory path)))
- (name (if (file-directory-p path)
- "" (file-name-nondirectory path)))
- (flist (and (file-directory-p dir)
- (directory-files dir nil name nil)))
- (regexp (format "^\\(.*\\)\\(%s\\)$"
- (mapconcat
- '(lambda (x) (regexp-quote (cdr x)))
- elmo-archive-suffix-alist
- "\\|"))))
- (if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'.
- (setq base-folder (elmo-match-string 1 base-folder))
- (unless (file-directory-p path)
- (setq base-folder (or (file-name-directory base-folder)
- base-folder))))
- (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"
- (elmo-concat-path base-folder (elmo-match-string 1 x))
- suffix prefix)))
- flist)))
- (elmo-localdir-list-folders-subr folder hierarchy))))
-
+(defun elmo-archive-folder-list-subfolders (folder one-level)
+ (if elmo-archive-treat-file
+ (let* ((path (elmo-archive-get-archive-directory folder))
+ (base-folder (or (elmo-archive-folder-archive-name-internal
+ folder)
+ ""))
+ (suffix (elmo-archive-folder-archive-type-internal folder))
+ (prefix (if (string=
+ (elmo-archive-folder-archive-prefix-internal folder)
+ "")
+ ""
+ (concat ";"
+ (elmo-archive-folder-archive-prefix-internal
+ folder))))
+ (dir (if (file-directory-p path)
+ path (file-name-directory path)))
+ (name (if (file-directory-p path)
+ "" (file-name-nondirectory path)))
+ (flist (and (file-directory-p dir)
+ (directory-files dir nil name nil)))
+ (regexp (format "^\\(.*\\)\\(%s\\)$"
+ (mapconcat
+ '(lambda (x) (regexp-quote (cdr x)))
+ elmo-archive-suffix-alist
+ "\\|"))))
+ (if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'.
+ (setq base-folder (elmo-match-string 1 base-folder))
+ (unless (file-directory-p path)
+ (setq base-folder (or (file-name-directory base-folder)
+ base-folder))))
+ (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)))
+ flist)))
+ (mapcar
+ (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
+ (elmo-list-subdirectories
+ (elmo-archive-get-archive-directory folder)
+ ""
+ one-level))))
+
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-archive-folder)
+ &optional one-level)
+ (elmo-archive-folder-list-subfolders folder one-level))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Article file related functions
;;; read(extract) / append(move) / delete(delete) / query(list)
-(defun elmo-archive-read-msg (spec number outbuf)
- (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
- prefix (int-to-string number)))))
- (set-buffer outbuf)
- (erase-buffer)
- (when (file-exists-p arc)
- (and
- (as-binary-process
- (elmo-archive-call-method method args t))
- (elmo-delete-cr-get-content-type))))))
+(defsubst elmo-archive-message-fetch-internal (folder number)
+ (let* ((type (elmo-archive-folder-archive-type-internal folder))
+ (arc (elmo-archive-get-archive-name folder))
+ (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)))))
+ (when (file-exists-p arc)
+ (and
+ (as-binary-process
+ (elmo-archive-call-method method args t))
+ (elmo-delete-cr-buffer)))))
+
+(luna-define-method elmo-message-fetch ((folder elmo-archive-folder)
+ number strategy &optional section
+ outbuf unseen)
+ (if outbuf
+ (with-current-buffer outbuf
+ (elmo-archive-message-fetch-internal folder number)
+ t)
+ (with-temp-buffer
+ (elmo-archive-message-fetch-internal folder number)
+ (buffer-string))))
+
+(luna-define-method elmo-folder-append-buffer ((folder elmo-archive-folder)
+ unread &optional number)
+ (elmo-archive-folder-append-buffer folder unread number))
;; 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))
+(defun elmo-archive-folder-append-buffer (folder unread 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))
(method (elmo-archive-get-method type 'mv))
- (tmp-buffer (get-buffer-create " *ELMO ARCHIVE mv*"))
- (next-num (or msg
+ (next-num (or number
(1+ (if (file-exists-p arc)
- (car (elmo-archive-max-of-folder spec)) 0))))
- (tmp-dir (elmo-msgdb-expand-path spec))
+ (car
+ (elmo-folder-status folder)) 0))))
+ (tmp-dir (elmo-folder-msgdb-path folder))
+ (src-buffer (current-buffer))
+ dst-buffer
newfile)
(when (null method)
(ding)
(error "WARNING: read-only mode: %s (method undefined)" type))
- (save-excursion
- (set-buffer tmp-buffer)
- (erase-buffer)
+ (with-temp-buffer
(let ((tmp-dir (expand-file-name prefix tmp-dir)))
(when (not (file-directory-p tmp-dir))
(elmo-make-directory (directory-file-name tmp-dir))))
(if (and (or (functionp method) (car method))
(file-writable-p newfile))
(progn
- (insert string)
+ (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))
(elmo-archive-call-method method (list arc newfile)))
- nil))
- (kill-buffer tmp-buffer)))))
-
-;; (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))
- (arc (elmo-archive-get-archive-name (nth 1 dst-spec) dst-type))
- (prefix (nth 3 dst-spec))
- (p-method (elmo-archive-get-method dst-type 'mv-pipe))
- (n-method (elmo-archive-get-method dst-type 'mv))
- (new (unless same-number
- (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 dst-spec)))
- (do-link t)
- src tmp newfile tmp-msgs)
- (when (not (elmo-archive-folder-exists-p dst-spec))
- (elmo-archive-create-folder dst-spec))
+ nil))))))
+
+(luna-define-method elmo-folder-append-messages :around
+ ((folder elmo-archive-folder) src-folder numbers unread-marks
+ &optional same-number)
+ (cond
+ ((and same-number
+ (null (elmo-archive-folder-archive-prefix-internal folder))
+ (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)
+ (setq base-dir temp-dir)
+ (when (> (length (elmo-archive-folder-archive-prefix-internal folder)) 0)
+ (rename-file
+ temp-dir
+ (setq new-dir
+ (expand-file-name
+ (elmo-archive-folder-archive-prefix-internal folder)
+ ;; 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)))
+ (if (elmo-archive-append-files folder base-dir)
+ (elmo-delete-directory temp-dir)))
+ numbers)
+ (t (luna-call-next-method))))
+
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-archive-folder))
+ (let ((type (elmo-archive-folder-archive-type-internal folder)))
+ (or (elmo-archive-get-method type 'ext-pipe)
+ (elmo-archive-get-method type 'ext))))
+
+(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))
+
+(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))
+ (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))
+ (n-method (elmo-archive-get-method type 'ext))
+ (tmp-msgs (mapcar (lambda (x) (elmo-concat-path
+ prefix
+ (int-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))))))
+ ;; Move files to the tmp-dir-dst.
+ (setq number start-number)
+ (dolist (tmp-file tmp-msgs)
+ (rename-file (expand-file-name
+ tmp-file
+ tmp-dir-src)
+ (expand-file-name
+ (if start-number
+ (int-to-string number)
+ (file-name-nondirectory tmp-file))
+ tmp-dir-dst))
+ (if start-number (incf number)))
+ ;; Remove tmp-dir-src.
+ (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))
+ (prefix (elmo-archive-folder-archive-prefix-internal folder))
+ (p-method (elmo-archive-get-method dst-type 'cp-pipe))
+ (n-method (elmo-archive-get-method dst-type 'cp))
+ src tmp newfile)
+ (unless (elmo-folder-exists-p folder) (elmo-folder-create folder))
+ (unless files (setq files (directory-files dir nil "^[^\\.]")))
(when (null (or p-method n-method))
(ding)
(error "WARNING: read-only mode: %s (method undefined)" dst-type))
- (when (and same-number
- (not (eq (car src-spec) 'maildir))
- (string-match (concat prefix "$") src-dir)
- (or
- (elmo-archive-get-method dst-type 'cp-pipe)
- (elmo-archive-get-method dst-type 'cp)))
- (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)
- (elmo-concat-path prefix (int-to-string x)))
- msgs))
- (setq do-link nil))
- (when do-link
- (let ((tmp-dir (expand-file-name prefix tmp-dir)))
- (when (not (file-directory-p tmp-dir))
- (elmo-make-directory (directory-file-name tmp-dir))))
- (while msgs
- (setq newfile (elmo-concat-path prefix (int-to-string
- (if same-number
- (car msgs)
- new))))
- (setq tmp-msgs (nconc tmp-msgs (list newfile)))
- (elmo-copy-file
- ;; src file
- (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
- ;; tmp file
- (expand-file-name newfile tmp-dir))
- (setq msgs (cdr msgs))
- (unless same-number (setq new (1+ new)))))
(save-excursion
(elmo-bind-directory
- tmp-dir
+ dir
(cond
((functionp n-method)
- (funcall n-method (cons arc tmp-msgs)))
+ (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)) tmp-msgs)))
+ 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)) tmp-msgs (length arc)))))))))
-
-;;; archive -> (localdir, localnews, archive)
-(defun elmo-archive-copy-msgs-froms (dst-spec msgs src-spec
- &optional loc-alist same-number)
- (let* ((src-type (nth 2 src-spec))
- (arc (elmo-archive-get-archive-name (nth 1 src-spec) src-type))
- (prefix (nth 3 src-spec))
- (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 src-spec)))
- (tmp-msgs (mapcar '(lambda (x) (elmo-concat-path
- prefix
- (int-to-string x)))
- msgs))
- result)
- (unwind-protect
- (setq result
- (and
- ;; extract messages
- (save-excursion
- (elmo-bind-directory
- tmp-dir
- (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)))))))
- ;; call elmo-*-copy-msgs of destination folder
- (elmo-call-func dst-spec "copy-msgs"
- msgs src-spec loc-alist same-number)))
- ;; clean up tmp-dir
- (elmo-bind-directory
- tmp-dir
- (while tmp-msgs
- (if (file-exists-p (car tmp-msgs))
- (delete-file (car tmp-msgs)))
- (setq tmp-msgs (cdr tmp-msgs))))
- result)))
-
-(defun elmo-archive-delete-msgs (spec msgs)
- (save-excursion
- (let* ((type (nth 2 spec))
- (prefix (nth 3 spec))
- (arc (elmo-archive-get-archive-name (nth 1 spec) type))
- (p-method (elmo-archive-get-method type 'rm-pipe))
- (n-method (elmo-archive-get-method type 'rm))
- (msgs (mapcar '(lambda (x) (elmo-concat-path
- prefix
- (int-to-string x)))
- msgs)))
- (cond ((functionp n-method)
- (funcall n-method (cons arc 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)) msgs)))
- (n-method
- (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)) msgs (length arc))))
- (t
- (ding)
- (error "WARNING: not delete: %s (method undefined)" type))) )))
+ n-prog (append n-prog-arg (list arc)) files (length arc)))))))))
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-archive-folder)
+ numbers)
+ (let* ((type (elmo-archive-folder-archive-type-internal folder))
+ (prefix (elmo-archive-folder-archive-prefix-internal folder))
+ (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)))
+ (cond ((functionp n-method)
+ (funcall n-method (cons arc numbers)))
+ (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)) numbers)))
+ (n-method
+ (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)) numbers (length arc))))
+ (t
+ (ding)
+ (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*")))
(elmo-archive-call-method method arg-list t))
(elmo-archive-msgdb-create-entity-subr number))))
-(defun elmo-archive-msgdb-create-as-numlist (spec numlist new-mark
- already-mark seen-mark
- important-mark seen-list)
- (when numlist
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-archive-folder)
+ numbers new-mark
+ already-mark seen-mark
+ important-mark seen-list)
+ (when numbers
(save-excursion ;; 981005
(if (and elmo-archive-use-izip-agent
- (elmo-archive-get-method (nth 2 spec) 'cat-headers))
+ (elmo-archive-get-method
+ (elmo-archive-folder-archive-type-internal folder)
+ 'cat-headers))
(elmo-archive-msgdb-create-as-numlist-subr2
- spec numlist 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
- spec numlist new-mark already-mark seen-mark important-mark
+ folder numbers new-mark already-mark seen-mark important-mark
seen-list)))))
-(defalias 'elmo-archive-msgdb-create 'elmo-archive-msgdb-create-as-numlist)
-
-
-(defun elmo-archive-msgdb-create-as-numlist-subr1 (spec numlist new-mark
- already-mark seen-mark
- important-mark
- seen-list)
- (let* ((type (nth 2 spec))
- (file (elmo-archive-get-archive-name (nth 1 spec) type spec))
+(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder
+ numlist new-mark
+ already-mark seen-mark
+ important-mark
+ 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))
- (tmp-buf (get-buffer-create " *ELMO ARCHIVE msgdb*"))
overview number-alist mark-alist entity
i percent num message-id seen gmark)
- (save-excursion
- (set-buffer tmp-buf)
+ (with-temp-buffer
(setq num (length numlist))
(setq i 0)
(message "Creating msgdb...")
(erase-buffer)
(setq entity
(elmo-archive-msgdb-create-entity
- method file (car numlist) type (nth 3 spec)))
+ method file (car numlist) type
+ (elmo-archive-folder-archive-prefix-internal folder)))
(when entity
(setq overview
(elmo-msgdb-append-element
(setq seen (member message-id seen-list))
(if (setq gmark
(or (elmo-msgdb-global-mark-get message-id)
- (if (elmo-cache-exists-p message-id) ; XXX
+ (if (elmo-file-cache-status
+ (elmo-file-cache-get message-id))
(if seen
nil
already-mark)
'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..."
percent))
(setq numlist (cdr numlist)))
- (kill-buffer tmp-buf)
(message "Creating msgdb...done")
- (list overview number-alist mark-alist)) ))
+ (list overview number-alist mark-alist))))
;;; info-zip agent
-(defun elmo-archive-msgdb-create-as-numlist-subr2 (spec numlist new-mark
- already-mark seen-mark
- important-mark
- seen-list)
- (let* ((buf (get-buffer-create " *ELMO ARCHIVE headers*"))
- (delim1 elmo-mmdf-delimiter) ;; MMDF
+(defun elmo-archive-msgdb-create-as-numlist-subr2 (folder
+ numlist new-mark
+ already-mark seen-mark
+ important-mark
+ seen-list)
+ (let* ((delim1 elmo-mmdf-delimiter) ;; MMDF
(delim2 elmo-unixmail-delimiter) ;; UNIX Mail
- (type (nth 2 spec))
- (prefix (nth 3 spec))
+ (type (elmo-archive-folder-archive-type-internal folder))
+ (prefix (elmo-archive-folder-archive-prefix-internal folder))
(method (elmo-archive-get-method type 'cat-headers))
(prog (car method))
(args (cdr method))
- (arc (elmo-archive-get-archive-name (nth 1 spec) type))
+ (arc (elmo-archive-get-archive-name folder))
n i percent num result overview number-alist mark-alist
msgs case-fold-search)
- (set-buffer buf)
- (setq num (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq n (min (1- elmo-archive-fetch-headers-volume)
- (1- (length numlist))))
- (setq msgs (reverse (memq (nth n numlist) (reverse numlist))))
- (setq numlist (nthcdr (1+ n) numlist))
- (erase-buffer)
- (insert
- (mapconcat
- 'concat
- (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs)
- "\n"))
- (message "Fetching headers...")
- (as-binary-process (apply 'call-process-region
- (point-min) (point-max)
- prog t t nil (append args (list arc))))
- (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 overview (append overview (nth 0 result)))
- (setq number-alist (append number-alist (nth 1 result)))
- (setq mark-alist (append mark-alist (nth 2 result))))
+ (with-temp-buffer
+ (setq num (length numlist))
+ (setq i 0)
+ (message "Creating msgdb...")
+ (while numlist
+ (setq n (min (1- elmo-archive-fetch-headers-volume)
+ (1- (length numlist))))
+ (setq msgs (reverse (memq (nth n numlist) (reverse numlist))))
+ (setq numlist (nthcdr (1+ n) numlist))
+ (erase-buffer)
+ (insert
+ (mapconcat
+ 'concat
+ (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs)
+ "\n"))
+ (message "Fetching headers...")
+ (as-binary-process (apply 'call-process-region
+ (point-min) (point-max)
+ prog t t nil (append args (list arc))))
+ (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 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!")))
- (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)) )
+ (t ;; unknown format
+ (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))))
+ (list overview number-alist mark-alist)))
(defun elmo-archive-parse-mmdf (msgs new-mark
already-mark
(setq seen (member message-id seen-list))
(if (setq gmark
(or (elmo-msgdb-global-mark-get message-id)
- (if (elmo-cache-exists-p message-id) ; XXX
+ (if (elmo-file-cache-status
+ (elmo-file-cache-get message-id))
(if seen
nil
already-mark)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Search functions
-(defsubst elmo-archive-field-condition-match (spec number number-list
- condition prefix)
+(defsubst elmo-archive-field-condition-match (folder number number-list
+ condition prefix)
(save-excursion
- (let* ((type (nth 2 spec))
- (arc (elmo-archive-get-archive-name (nth 1 spec) type spec))
+ (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)))))
(elmo-set-work-buf
(decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
(elmo-buffer-field-condition-match condition number number-list))))))
-(defun elmo-archive-search (spec condition &optional from-msgs)
+(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)))
- (msgs (or from-msgs (elmo-archive-list-folder spec)))
+ (msgs (or from-msgs (elmo-folder-list-messages folder)))
(num (length msgs))
(i 0)
(case-fold-search nil)
number-list ret-val)
(setq number-list msgs)
(while msgs
- (if (elmo-archive-field-condition-match spec (car msgs) number-list
- condition
- (nth 3 spec))
+ (if (elmo-archive-field-condition-match
+ folder (car msgs) number-list
+ condition
+ (elmo-archive-folder-archive-prefix-internal folder))
(setq ret-val (cons (car msgs) ret-val)))
(when (> num elmo-display-progress-threshold)
(setq i (1+ i))
(setq msgs (cdr msgs)))
(nreverse ret-val)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Misc functions
-
-(defun elmo-archive-check-validity (spec validity-file)
- t) ; ok.
-
-(defun elmo-archive-sync-validity (spec validity-file)
- t) ; ok.
-
-\f
;;; method(alist)
(if (null elmo-archive-method-alist)
(let ((mlist elmo-archive-method-list) ; from mew-highlight.el
(nconc elmo-archive-suffixes (list (cdr tmp))))
(setq slist (cdr slist)))))
-(defun elmo-archive-use-cache-p (spec number)
+(luna-define-method elmo-message-use-cache-p ((folder elmo-archive-folder)
+ number)
elmo-archive-use-cache)
-(defun elmo-archive-local-file-p (spec number)
- nil)
-
-(defun elmo-archive-get-msg-filename (spec number &optional loc-alist)
- (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
- 'elmo-generic-sync-number-alist)
-(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)
(require 'elmo-vars)
(require 'elmo-util)
-(defun elmo-cache-delete (msgid folder number)
- "Delete cache file associated with message-id 'MSGID', FOLDER, NUMBER."
- (let ((path (elmo-cache-exists-p msgid folder number)))
- (if path (delete-file path))))
-
(defsubst elmo-cache-to-msgid (filename)
- (concat "<" (elmo-recover-msgid-from-filename filename) ">"))
-
-(defun elmo-cache-force-delete (path &optional locked)
- "Delete cache file."
- ;; for safety...
- (unless (string-match elmo-cache-dirname path)
- (error "%s is not cache file!" path))
- (let (message-id)
- (if (or (elmo-msgdb-global-mark-get
- (setq message-id
- (elmo-cache-to-msgid (file-name-nondirectory path))))
- (member message-id locked))
- nil;; Don't delete caches with mark (or locked message).
- (if (and path
- (file-directory-p path))
+ (concat "<" (elmo-recover-string-from-filename filename) ">"))
+
+;;; File cache.
+
+(defun elmo-file-cache-get-path (msgid &optional section)
+ "Get cache path for MSGID.
+If optional argument SECTION is specified, partial cache path is returned."
+ (if (setq msgid (elmo-msgid-to-cache msgid))
+ (expand-file-name
+ (if section
+ (format "%s/%s/%s/%s/%s"
+ elmo-msgdb-dir
+ elmo-cache-dirname
+ (elmo-cache-get-path-subr msgid)
+ msgid
+ section)
+ (format "%s/%s/%s/%s"
+ elmo-msgdb-dir
+ elmo-cache-dirname
+ (elmo-cache-get-path-subr msgid)
+ msgid)))))
+
+(defmacro elmo-file-cache-expand-path (path section)
+ "Return file name for the file-cache corresponds to the section.
+PATH is the file-cache path.
+SECTION is the section string."
+ (` (expand-file-name (or (, section) "") (, path))))
+
+(defun elmo-file-cache-delete (path)
+ "Delete a cache on PATH."
+ (let (files)
+ (when (file-exists-p path)
+ (if (file-directory-p path)
(progn
- (mapcar 'delete-file (directory-files path t "^[^\\.]"))
+ (setq files (directory-files path t "^[^\\.]"))
+ (while files
+ (delete-file (car files))
+ (setq files (cdr files)))
(delete-directory path))
- (delete-file path))
- t)))
-
-(defun elmo-cache-delete-partial (msgid folder number)
- "Delete cache file only if it is partial message."
+ (delete-file path)))))
+
+(defun elmo-file-cache-exists-p (msgid)
+ "Returns 'section or 'entire if a cache which corresponds to MSGID exists."
+ (elmo-file-cache-status (elmo-file-cache-get msgid)))
+
+(defun elmo-file-cache-save (cache-path section)
+ "Save current buffer as cache on PATH."
+ (let ((path (if section (expand-file-name section cache-path) cache-path))
+ files dir)
+ (if (and (null section)
+ (file-directory-p path))
+ (progn
+ (setq files (directory-files path t "^[^\\.]"))
+ (while files
+ (delete-file (car files))
+ (setq files (cdr files)))
+ (delete-directory path))
+ (if (and section
+ (not (file-directory-p cache-path)))
+ (delete-file cache-path)))
+ (when path
+ (setq dir (directory-file-name (file-name-directory path)))
+ (if (not (file-exists-p dir))
+ (elmo-make-directory dir))
+ (write-region-as-binary (point-min) (point-max)
+ path nil 'no-msg))))
+
+(defmacro elmo-make-file-cache (path status)
+ "PATH is the cache file name.
+STATUS is one of 'section, 'entire or nil.
+ nil means no cache exists.
+'section means partial section cache exists.
+'entire means entire cache exists.
+If the cache is partial file-cache, TYPE is 'partial."
+ (` (cons (, path) (, status))))
+
+(defmacro elmo-file-cache-path (file-cache)
+ "Returns the file path of the FILE-CACHE."
+ (` (car (, file-cache))))
+
+(defmacro elmo-file-cache-status (file-cache)
+ "Returns the status of the FILE-CACHE."
+ (` (cdr (, file-cache))))
+
+(defun elmo-file-cache-get (msgid &optional section)
+ "Returns the current file-cache object associated with MSGID.
+MSGID is the message-id of the message.
+If optional argument SECTION is specified, get partial file-cache object
+associated with SECTION."
(if msgid
- (let ((path1 (elmo-cache-get-path msgid))
- path2)
- (if (and path1
- (file-exists-p path1))
- (if (and folder
- (file-directory-p path1))
- (when (file-exists-p (setq path2
- (expand-file-name
- (format "%s@%s"
- number
- (elmo-safe-filename
- folder))
- path1)))
- (delete-file path2)
- (unless (directory-files path1 t "^[^\\.]")
- (delete-directory path1))))))))
-
-(defun elmo-cache-read (msgid &optional folder number outbuf)
- "Read cache contents to OUTBUF."
- (save-excursion
- (let ((path (elmo-cache-exists-p msgid folder number)))
- (when path
- (if outbuf (set-buffer outbuf))
- (erase-buffer)
- (as-binary-input-file (insert-file-contents path))
- t))))
-
+ (let ((path (elmo-cache-get-path msgid)))
+ (if (and path (file-exists-p path))
+ (if (file-directory-p path)
+ (if section
+ (if (file-exists-p (setq path (expand-file-name
+ section path)))
+ (cons path 'section))
+ ;; section is not specified but sectional.
+ (cons path 'section))
+ ;; not directory.
+ (unless section
+ (cons path 'entire)))
+ ;; no cache.
+ (cons path nil)))))
+
+;;;
(defun elmo-cache-expire ()
(interactive)
(let* ((completion-ignore-case t)
(setq files (cdr files))))
(setq dirs (cdr dirs)))))
-(defun elmo-cache-save (msgid partial folder number &optional inbuf)
- "If PARTIAL is non-nil, save current buffer (or INBUF) as partial cache."
- (condition-case nil
- (save-excursion
- (let* ((path (if partial
- (elmo-cache-get-path msgid folder number)
- (elmo-cache-get-path msgid)))
- dir tmp-buf)
- (when path
- (setq dir (directory-file-name (file-name-directory path)))
- (if (not (file-exists-p dir))
- (elmo-make-directory dir))
- (if inbuf (set-buffer inbuf))
- (goto-char (point-min))
- (as-binary-output-file (write-region (point-min) (point-max)
- path nil 'no-msg)))))
- (error)))
-
-(defun elmo-cache-exists-p (msgid &optional folder number)
- "Returns the path if the cache exists."
- (save-match-data
- (if msgid
- (let ((path (elmo-cache-get-path msgid)))
- (if (and path
- (file-exists-p path))
- (if (and folder
- (file-directory-p path))
- (if (file-exists-p (setq path (expand-file-name
- (format "%s@%s"
- (or number "")
- (elmo-safe-filename
- folder))
- path)))
- path
- )
- ;; not directory.
- path))))))
-
(defun elmo-cache-search-all (folder condition from-msgs)
(let* ((number-alist (elmo-msgdb-number-load
(elmo-msgdb-expand-path folder)))
(defun elmo-msgid-to-cache (msgid)
(when (and msgid
(string-match "<\\(.+\\)>$" msgid))
- (elmo-replace-msgid-as-filename (elmo-match-string 1 msgid))))
+ (elmo-replace-string-as-filename (elmo-match-string 1 msgid))))
(defun elmo-cache-get-path (msgid &optional folder number)
"Get path for cache file associated with MSGID, FOLDER, and NUMBER."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; buffer cache module
-
-(defconst elmo-buffer-cache-name " *elmo cache*")
-
-(defvar elmo-buffer-cache nil
- "Message cache. (old ... new) order alist.
-With association ((\"folder\" message \"message-id\") . cache-buffer).")
-
-(defmacro elmo-buffer-cache-buffer-get (entry)
- (` (cdr (, entry))))
-
-(defmacro elmo-buffer-cache-folder-get (entry)
- (` (car (car (, entry)))))
-
-(defmacro elmo-buffer-cache-message-get (entry)
- (` (cdr (car (, entry)))))
-
-(defmacro elmo-buffer-cache-entry-make (fld-msg-id buf)
- (` (cons (, fld-msg-id) (, buf))))
-
-(defmacro elmo-buffer-cache-hit (fld-msg-id)
- "Return value assosiated with key."
- (` (elmo-buffer-cache-buffer-get
- (assoc (, fld-msg-id) elmo-buffer-cache))))
-
-(defun elmo-buffer-cache-sort (entry)
- (let* ((pointer (cons nil elmo-buffer-cache))
- (top pointer))
- (while (cdr pointer)
- (if (equal (car (cdr pointer)) entry)
- (setcdr pointer (cdr (cdr pointer)))
- (setq pointer (cdr pointer))))
- (setcdr pointer (list entry))
- (setq elmo-buffer-cache (cdr top))))
-
-(defun elmo-buffer-cache-add (fld-msg-id)
- "Adding (FLD-MSG-ID . buf) to the top of `elmo-buffer-cache'.
-Returning its cache buffer."
- (let ((len (length elmo-buffer-cache))
- (buf nil))
- (if (< len elmo-buffer-cache-size)
- (setq buf (get-buffer-create (format "%s%d" elmo-buffer-cache-name len)))
- (setq buf (elmo-buffer-cache-buffer-get (nth (1- len) elmo-buffer-cache)))
- (setcdr (nthcdr (- len 2) elmo-buffer-cache) nil))
- (save-excursion
- (set-buffer buf)
- (elmo-set-buffer-multibyte nil))
- (setq elmo-buffer-cache
- (cons (elmo-buffer-cache-entry-make fld-msg-id buf)
- elmo-buffer-cache))
- buf))
-
-(defun elmo-buffer-cache-delete ()
- "Delete the most recent cache entry."
- (let ((buf (elmo-buffer-cache-buffer-get (car elmo-buffer-cache))))
- (setq elmo-buffer-cache
- (nconc (cdr elmo-buffer-cache)
- (list (elmo-buffer-cache-entry-make nil buf))))))
-
-(defun elmo-buffer-cache-clean-up ()
- "A function to flush all decoded messages in cache list."
- (interactive)
- (let ((n 0) buf)
- (while (< n elmo-buffer-cache-size)
- (setq buf (concat elmo-buffer-cache-name (int-to-string n)))
- (elmo-kill-buffer buf)
- (setq n (1+ n))))
- (setq elmo-buffer-cache nil))
-
+;;
;;
;; cache backend by Kenichi OKADA <okada@opaopa.org>
;;
(require 'path-util)
-(if (module-installed-p 'timezone)
- (require 'timezone))
+(require 'timezone)
(require 'elmo-vars)
+(defmacro elmo-match-substring (pos string from)
+ "Substring of POSth matched string of STRING."
+ (` (substring (, string)
+ (+ (match-beginning (, pos)) (, from))
+ (match-end (, pos)))))
+
+(defmacro elmo-match-string (pos string)
+ "Substring POSth matched STRING."
+ (` (substring (, string) (match-beginning (, pos)) (match-end (, pos)))))
+
+(defmacro elmo-match-buffer (pos)
+ "Substring POSth matched from the current buffer."
+ (` (buffer-substring-no-properties
+ (match-beginning (, pos)) (match-end (, pos)))))
+
+;; from subr.el
+(defun elmo-replace-in-string (str regexp newtext &optional literal)
+ "Replace all matches in STR for REGEXP with NEWTEXT string.
+And returns the new string.
+Optional LITERAL non-nil means do a literal replacement.
+Otherwise treat \\ in NEWTEXT string as special:
+ \\& means substitute original matched text,
+ \\N means substitute match for \(...\) number N,
+ \\\\ means insert one \\."
+ (let ((rtn-str "")
+ (start 0)
+ (special)
+ match prev-start)
+ (while (setq match (string-match regexp str start))
+ (setq prev-start start
+ start (match-end 0)
+ rtn-str
+ (concat
+ rtn-str
+ (substring str prev-start match)
+ (cond (literal newtext)
+ (t (mapconcat
+ (function
+ (lambda (c)
+ (if special
+ (progn
+ (setq special nil)
+ (cond ((eq c ?\\) "\\")
+ ((eq c ?&)
+ (elmo-match-string 0 str))
+ ((and (>= c ?0) (<= c ?9))
+ (if (> c (+ ?0 (length
+ (match-data))))
+ ;; Invalid match num
+ (error "Invalid match num: %c" c)
+ (setq c (- c ?0))
+ (elmo-match-string c str)))
+ (t (char-to-string c))))
+ (if (eq c ?\\) (progn (setq special t) nil)
+ (char-to-string c)))))
+ newtext ""))))))
+ (concat rtn-str (substring str start))))
+
(defvar elmo-date-descriptions
'((yesterday . [0 0 1])
(lastweek . [0 0 7])
;;; Code:
;;
+(require 'elmo)
(require 'elmo-vars)
(require 'elmo-msgdb)
(require 'elmo-util)
-(eval-when-compile
- (require 'elmo-imap4)
- (require 'elmo-localdir))
;; global variable.
(defvar elmo-dop-queue nil
Automatically loaded/saved.")
(defun elmo-dop-queue-append (folder function argument)
- (let ((operation (list (elmo-string folder) function argument)))
+ (let ((operation (list (elmo-folder-name-internal folder)
+ function argument)))
(elmo-dop-queue-load)
(unless (member operation elmo-dop-queue) ;; don't append same operation
(setq elmo-dop-queue
(count 0)
len)
(while queue
- (if (or force (elmo-folder-plugged-p (caar queue)))
+ (if (or force (elmo-folder-plugged-p (elmo-make-folder (caar queue))))
(setq count (1+ count)))
(setq queue (cdr queue)))
(when (> count 0)
(expand-file-name (if resume
elmo-msgdb-resume-list-filename
elmo-msgdb-append-list-filename)
- (elmo-msgdb-expand-path folder))))
+ (elmo-folder-msgdb-path folder))))
(defun elmo-dop-append-list-save (folder append-list &optional resume)
(if append-list
(expand-file-name (if resume
elmo-msgdb-resume-list-filename
elmo-msgdb-append-list-filename)
- (elmo-msgdb-expand-path folder))
+ (elmo-folder-msgdb-path folder))
append-list)
(condition-case ()
(delete-file (expand-file-name (if resume
elmo-msgdb-resume-list-filename
elmo-msgdb-append-list-filename)
- (elmo-msgdb-expand-path folder)))
+ (elmo-folder-msgdb-path folder)))
(error))))
(defun elmo-dop-deleting-numbers-to-msgids (alist numbers appended)
(setq numbers (cdr numbers)))
(cons appended deleting-msgids)))
-(defun elmo-dop-list-deleted (folder number-alist)
- "List message numbers to be deleted on FOLDER from NUMBER-ALIST."
+(defun elmo-dop-list-deleted (name number-alist)
+ "List message numbers to be deleted on folder with NAME from NUMBER-ALIST."
(elmo-dop-queue-load)
(let ((queue elmo-dop-queue)
numbers matches nalist)
(while queue
- (if (and (string= (nth 0 (car queue)) folder)
+ (if (and (string= (nth 0 (car queue)) name)
(string= (nth 1 (car queue)) "delete-msgids"))
(setq numbers
(nconc numbers
(save-match-data
(elmo-dop-queue-append folder "prefetch-msgs" msgs)))
-(defun elmo-dop-list-folder (folder)
- (if (or (memq (elmo-folder-get-type folder)
- '(imap4 nntp pop3 filter pipe))
- (and (elmo-multi-p folder) (not (elmo-folder-local-p folder))))
- (if elmo-enable-disconnected-operation
- (let* ((path (elmo-msgdb-expand-path folder))
- (number-alist (elmo-msgdb-number-load path))
- (number-list (mapcar 'car number-alist))
- (append-list (elmo-dop-append-list-load folder))
- (append-num (length append-list))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load path)))
- alreadies
- max-num
- (i 0))
- (setq killed (nconc (elmo-dop-list-deleted folder number-alist)
- killed))
- (while append-list
- (if (rassoc (car append-list) number-alist)
- (setq alreadies (append alreadies
- (list (car append-list)))))
- (setq append-list (cdr append-list)))
- (setq append-num (- append-num (length alreadies)))
- (setq max-num
- (or (nth (max (- (length number-list) 1) 0)
- number-list) 0))
- (while (< i append-num)
- (setq number-list
- (append number-list
- (list (+ max-num i 1))))
- (setq i (+ 1 i)))
- (elmo-living-messages number-list killed))
- (error "Unplugged"))
- ;; not imap4 folder...list folder
- (elmo-call-func folder "list-folder")))
+(defun elmo-dop-list-messages (folder)
+ (let* ((path (elmo-msgdb-expand-path folder))
+ (number-alist (elmo-msgdb-number-load path))
+ (number-list (mapcar 'car number-alist))
+ (append-list (elmo-dop-append-list-load folder))
+ (append-num (length append-list))
+ alreadies
+ killed
+ max-num
+ (i 0))
+ (setq killed (elmo-dop-list-deleted folder number-alist))
+ (while append-list
+ (if (rassoc (car append-list) number-alist)
+ (setq alreadies (append alreadies
+ (list (car append-list)))))
+ (setq append-list (cdr append-list)))
+ (setq append-num (- append-num (length alreadies)))
+ (setq max-num
+ (or (nth (max (- (length number-list) 1) 0)
+ number-list) 0))
+ (while (< i append-num)
+ (setq number-list
+ (append number-list
+ (list (+ max-num i 1))))
+ (setq i (+ 1 i)))
+ (elmo-living-messages number-list killed)))
(defun elmo-dop-count-appended (folder)
(length (elmo-dop-append-list-load folder)))
(elmo-folder-get-spec folder)
msgs msgdb))))
+(defun elmo-dop-folder-status (folder)
+ (let* ((number-alist (elmo-msgdb-number-load
+ (elmo-folder-msgdb-path folder)))
+ (number-list (mapcar 'car number-alist))
+ (append-list (elmo-dop-append-list-load folder))
+ (append-num (length append-list))
+ alreadies
+ (i 0)
+ max-num)
+ (while append-list
+ (if (rassoc (car append-list) number-alist)
+ (setq alreadies (append alreadies
+ (list (car append-list)))))
+ (setq append-list (cdr append-list)))
+ (setq max-num
+ (or (nth (max (- (length number-list) 1) 0) number-list)
+ 0))
+ (cons (- (+ max-num append-num) (length alreadies))
+ (- (+ (length number-list) append-num) (length alreadies)))))
+
(defun elmo-dop-max-of-folder (folder)
(if (eq (elmo-folder-get-type folder) 'imap4)
(if elmo-enable-disconnected-operation
;;; Code:
;;
-(require 'elmo-msgdb)
-
-(defun elmo-filter-msgdb-create (spec numlist new-mark already-mark
- seen-mark important-mark seen-list)
- (if (eq (nth 2 spec) 'partial)
- (elmo-msgdb-create (nth 2 spec)
- numlist
- new-mark
- already-mark
- seen-mark important-mark seen-list)
- (elmo-msgdb-create-as-numlist (nth 2 spec)
- numlist
- new-mark
- already-mark
- seen-mark important-mark seen-list)))
-
-(defun elmo-filter-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- (elmo-msgdb-create-as-numlist (nth 2 spec)
- numlist
- new-mark
- already-mark
- seen-mark important-mark seen-list))
-
-(defun elmo-filter-list-folders (spec &optional hierarchy)
- nil)
-
-(defun elmo-filter-append-msg (spec string &optional msg no-see)
- (elmo-call-func (nth 2 spec) "append" string))
-
-(defun elmo-filter-read-msg (spec number outbuf)
- (elmo-call-func (nth 2 spec) "read-msg" number outbuf))
-
-(defun elmo-filter-delete-msgs (spec msgs)
- (elmo-call-func (nth 2 spec) "delete-msgs" msgs))
-
-(defun elmo-filter-list-folder (spec)
- (elmo-search (nth 2 spec) (nth 1 spec)))
-
-(defun elmo-filter-list-folder-unread (spec number-alist mark-alist
- unread-marks)
- (elmo-list-filter
- (mapcar 'car number-alist)
- (elmo-list-folder-unread
- (nth 2 spec) number-alist mark-alist unread-marks)))
-
-(defun elmo-filter-list-folder-important (spec number-alist)
- (elmo-list-filter
- (mapcar 'car number-alist)
- (elmo-list-folder-important (nth 2 spec) number-alist)))
-
-(defun elmo-filter-folder-diff (spec folder &optional number-list)
- (if (or (elmo-multi-p folder)
- (not (and (vectorp (nth 1 spec))
- (string-match "^last$"
- (elmo-filter-key (nth 1 spec))))))
- (cons nil (cdr (elmo-folder-diff (nth 2 spec))))
- (elmo-generic-folder-diff spec folder number-list)))
-
-(defun elmo-filter-max-of-folder (spec)
- (elmo-max-of-folder (nth 2 spec)))
-
-(defun elmo-filter-folder-exists-p (spec)
- (elmo-folder-exists-p (nth 2 spec)))
-
-(defun elmo-filter-folder-creatable-p (spec)
- (elmo-call-func (nth 2 spec) "folder-creatable-p"))
-
-(defun elmo-filter-create-folder (spec)
- (elmo-create-folder (nth 2 spec)))
-
-(defun elmo-filter-search (spec condition &optional from-msgs)
+(require 'elmo)
+
+;;; ELMO filter folder
+(eval-and-compile
+ (luna-define-class elmo-filter-folder (elmo-folder)
+ (condition target))
+ (luna-define-internal-accessors 'elmo-filter-folder))
+
+(luna-define-method elmo-folder-initialize ((folder elmo-filter-folder)
+ name)
+ (let (pair)
+ (setq pair (elmo-parse-search-condition name))
+ (elmo-filter-folder-set-condition-internal folder
+ (car pair))
+ (if (string-match "^ */\\(.*\\)$" (cdr pair))
+ (elmo-filter-folder-set-target-internal
+ folder
+ (elmo-make-folder (elmo-match-string 1 (cdr pair))))
+ (error "Folder syntax error `%s'" (elmo-folder-name-internal folder)))
+ folder))
+
+(luna-define-method elmo-folder-open-internal ((folder elmo-filter-folder))
+ (elmo-folder-open-internal (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-check ((folder elmo-filter-folder))
+ (elmo-folder-check (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-filter-folder))
+ (elmo-folder-close-internal (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-filter-folder))
+ (expand-file-name
+ (elmo-replace-string-as-filename (elmo-folder-name-internal folder))
+ (expand-file-name "filter" elmo-msgdb-dir)))
+
+(luna-define-method elmo-find-fetch-strategy
+ ((folder elmo-filter-folder) entity &optional ignore-cache)
+ (elmo-find-fetch-strategy
+ (elmo-filter-folder-target-internal folder)
+ entity ignore-cache))
+
+(luna-define-method elmo-folder-get-primitive-list ((folder
+ elmo-filter-folder))
+ (list (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-contains-type ((folder elmo-filter-folder)
+ type)
+ (elmo-folder-contains-type
+ (elmo-filter-folder-target-internal folder)
+ type))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-filter-folder)
+ numlist new-mark already-mark
+ seen-mark important-mark
+ seen-list)
+ (elmo-folder-msgdb-create (elmo-filter-folder-target-internal folder)
+ numlist
+ new-mark
+ already-mark
+ seen-mark important-mark seen-list))
+
+(luna-define-method elmo-folder-append-buffer ((folder elmo-filter-folder)
+ unread &optional number)
+ (elmo-folder-append-buffer
+ (elmo-filter-folder-target-internal folder)
+ unread number))
+
+(luna-define-method elmo-message-fetch ((folder elmo-filter-folder)
+ number strategy
+ &optional section outbuf unseen)
+ (elmo-message-fetch
+ (elmo-filter-folder-target-internal folder)
+ number strategy section outbuf unseen))
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-filter-folder)
+ numbers)
+ (elmo-folder-delete-messages
+ (elmo-filter-folder-target-internal folder) numbers))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-filter-folder))
+ (elmo-folder-search (elmo-filter-folder-target-internal folder)
+ (elmo-filter-folder-condition-internal folder)))
+
+(defsubst elmo-filter-folder-list-unreads-internal (folder unread-marks)
+ (let ((unreads (elmo-folder-list-unreads-internal
+ (elmo-filter-folder-target-internal folder)
+ unread-marks)))
+ (unless (listp unreads)
+ (setq unreads
+ (delq nil
+ (mapcar
+ (function
+ (lambda (x)
+ (if (member (cadr x) unread-marks)
+ (car x))))
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))))
+ (elmo-list-filter
+ (mapcar 'car (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder)))
+ unreads)))
+
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-filter-folder)
+ unread-marks)
+ (elmo-filter-folder-list-unreads-internal folder unread-marks))
+
+
+(defsubst elmo-filter-folder-list-importants-internal (folder important-mark)
+ (let ((importants (elmo-folder-list-importants-internal
+ (elmo-filter-folder-target-internal folder)
+ important-mark)))
+ (unless (listp importants)
+ (setq importants
+ (delq nil
+ (mapcar
+ (function
+ (lambda (x)
+ (if (string= (cadr x) important-mark)
+ (car x))))
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))))
+ (elmo-list-filter
+ (mapcar 'car (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder)))
+ importants)))
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-filter-folder)
+ important-mark)
+ (elmo-filter-folder-list-importants-internal folder important-mark))
+
+(luna-define-method elmo-folder-diff :around ((folder elmo-filter-folder)
+ &optional numbers)
+ (if (not (and (vectorp (elmo-filter-folder-condition-internal
+ folder))
+ (string-match "^last$"
+ (elmo-filter-key
+ (elmo-filter-folder-condition-internal
+ folder)))))
+ (cons nil (cdr (elmo-folder-diff (elmo-filter-folder-target-internal
+ folder))))
+ (luna-call-next-method)))
+
+(luna-define-method elmo-folder-status ((folder elmo-filter-folder))
+ (elmo-folder-status
+ (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-filter-folder))
+ (elmo-folder-exists-p (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-creatable-p ((folder elmo-filter-folder))
+ (elmo-folder-creatable-p (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-create ((folder elmo-filter-folder))
+ (elmo-folder-create (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-search ((folder elmo-filter-folder)
+ condition &optional numbers)
;; search from messages in this folder
(elmo-list-filter
- from-msgs
- (elmo-search (nth 2 spec) condition
- (elmo-filter-list-folder spec))))
-
-(defun elmo-filter-use-cache-p (spec number)
- (elmo-call-func (nth 2 spec) "use-cache-p" number))
-
-(defun elmo-filter-local-file-p (spec number)
- (elmo-call-func (nth 2 spec) "local-file-p" number))
-
-(defun elmo-filter-commit (spec)
- (elmo-commit (nth 2 spec)))
-
-(defun elmo-filter-plugged-p (spec)
- (elmo-folder-plugged-p (nth 2 spec)))
-
-(defun elmo-filter-set-plugged (spec plugged add)
- (elmo-folder-set-plugged (nth 2 spec) plugged add))
-
-(defun elmo-filter-get-msg-filename (spec number &optional loc-alist)
- ;; This function may be called when elmo-filter-local-file-p()
- ;; returns t.
- (elmo-call-func (nth 2 spec) "get-msg-filename" number loc-alist))
-
-(defun elmo-filter-sync-number-alist (spec number-alist)
- (elmo-call-func (nth 2 spec) "sync-number-alist" number-alist))
+ numbers
+ (elmo-folder-search (elmo-filter-folder-target-internal folder)
+ condition
+ (elmo-folder-list-messages folder))))
+
+(luna-define-method elmo-message-use-cache-p ((folder elmo-filter-folder)
+ number)
+ (elmo-message-use-cache-p (elmo-filter-folder-target-internal folder)
+ number))
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-filter-folder))
+ (elmo-folder-message-file-p (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-plugged-p ((folder elmo-filter-folder))
+ (elmo-folder-plugged-p (elmo-filter-folder-target-internal folder)))
+
+(luna-define-method elmo-folder-set-plugged ((folder elmo-filter-folder)
+ plugged &optional add)
+ (elmo-folder-set-plugged (elmo-filter-folder-target-internal folder)
+ plugged add))
+
+(luna-define-method elmo-message-file-name ((folder elmo-filter-folder)
+ number)
+ (elmo-message-file-name (elmo-filter-folder-target-internal folder)
+ number))
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-filter-folder)
+ numbers)
+ (elmo-folder-mark-as-read (elmo-filter-folder-target-internal folder)
+ numbers))
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-filter-folder)
+ numbers)
+ (elmo-folder-unmark-read (elmo-filter-folder-target-internal folder)
+ numbers))
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-filter-folder)
+ numbers)
+ (elmo-folder-mark-as-important (elmo-filter-folder-target-internal folder)
+ numbers))
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-filter-folder)
+ numbers)
+ (elmo-folder-unmark-important (elmo-filter-folder-target-internal folder)
+ numbers))
-(defun elmo-filter-server-diff (spec)
- (elmo-call-func (nth 2 spec) "server-diff"))
(require 'product)
(product-provide (provide 'elmo-filter) (require 'elmo-version))
(require 'elmo-vars)
(require 'elmo-util)
-(require 'elmo-msgdb)
(require 'elmo-date)
+(require 'elmo-msgdb)
(require 'elmo-cache)
+(require 'elmo)
(require 'elmo-net)
(require 'utf7)
+(require 'elmo-mime)
;;; Code:
(eval-when-compile (require 'cl))
-(defvar elmo-imap4-use-lock t
- "USE IMAP4 with locking process.")
+;;; User options.
+(defcustom elmo-imap4-default-mailbox "inbox"
+ "*Default IMAP4 mailbox."
+ :type 'string
+ :group 'elmo)
+
+(defcustom elmo-imap4-default-server "localhost"
+ "*Default IMAP4 server."
+ :type 'string
+ :group 'elmo)
+
+(defcustom elmo-imap4-default-authenticate-type 'login
+ "*Default Authentication type for IMAP4."
+ :type 'symbol
+ :group 'elmo)
+
+(defcustom elmo-imap4-default-user (or (getenv "USER")
+ (getenv "LOGNAME")
+ (user-login-name))
+ "*Default username for IMAP4."
+ :type 'string
+ :group 'elmo)
+
+(defcustom elmo-imap4-default-port 143
+ "*Default Port number of IMAP."
+ :type 'integer
+ :group 'elmo)
+
+(defcustom elmo-imap4-default-stream-type nil
+ "*Default stream type for IMAP4.
+Any symbol value of `elmo-network-stream-type-alist' or
+`elmo-imap4-stream-type-alist'."
+ :type 'symbol
+ :group 'elmo)
+
+;;; Obsolete.
+(defvar elmo-default-imap4-mailbox elmo-imap4-default-mailbox)
+(defvar elmo-default-imap4-server elmo-imap4-default-server)
+(defvar elmo-default-imap4-authenticate-type
+ elmo-imap4-default-authenticate-type)
+(defvar elmo-default-imap4-user elmo-imap4-default-user)
+(defvar elmo-default-imap4-port elmo-imap4-default-port)
+(defvar elmo-default-imap4-stream-type elmo-imap4-default-stream-type)
+
+(defvar elmo-imap4-stream-type-alist nil
+ "*Stream bindings for IMAP4.
+This is taken precedence over `elmo-network-stream-type-alist'.")
+
+(defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
+ "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored.
+(Except `\\Deleted' flag).")
+
+(defvar elmo-imap4-overview-fetch-chop-length 200
+ "*Number of overviews to fetch in one request in imap4.")
+
+(defvar elmo-imap4-force-login nil
+ "*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.")
+
+(defvar elmo-imap4-use-select-to-update-status nil
+ "*Some imapd have to send select command to update status.
+(ex. UW imapd 4.5-BETA?). For these imapd, you must set this variable t.")
+
+(defvar elmo-imap4-use-modified-utf7 nil
+ "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.")
+
+(defvar elmo-imap4-use-cache t
+ "Use cache in imap4 folder.")
+
+(defvar elmo-imap4-extra-namespace-alist
+ '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
+ "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).")
;;
;;; internal variables
;;
(defvar elmo-imap4-reached-tag "elmo-imap40")
;;; buffer local variables
-
-(defvar elmo-imap4-extra-namespace-alist
- '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
- "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).")
(defvar elmo-imap4-default-hierarchy-delimiter "/")
(defvar elmo-imap4-server-capability nil)
(defvar elmo-imap4-debug-inhibit-logging nil)
-;;;
+;;; ELMO IMAP4 folder
+(eval-and-compile
+ (luna-define-class elmo-imap4-folder (elmo-net-folder)
+ (mailbox))
+ (luna-define-internal-accessors 'elmo-imap4-folder))
+;;; Session
(eval-and-compile
(luna-define-class elmo-imap4-session (elmo-network-session)
(capability current-mailbox read-only))
(luna-define-internal-accessors 'elmo-imap4-session))
-;;; imap4 spec
-
-(defsubst elmo-imap4-spec-mailbox (spec)
- (nth 1 spec))
-
-(defsubst elmo-imap4-spec-username (spec)
- (nth 2 spec))
-
-(defsubst elmo-imap4-spec-auth (spec)
- (nth 3 spec))
-
-(defsubst elmo-imap4-spec-hostname (spec)
- (nth 4 spec))
-
-(defsubst elmo-imap4-spec-port (spec)
- (nth 5 spec))
-
-(defsubst elmo-imap4-spec-stream-type (spec)
- (nth 6 spec))
-
+;;; MIME-ELMO-IMAP Location
+(eval-and-compile
+ (luna-define-class mime-elmo-imap-location
+ (mime-imap-location)
+ (folder number rawbuf strategy))
+ (luna-define-internal-accessors 'mime-elmo-imap-location))
;;; Debug
-
(defsubst elmo-imap4-debug (message &rest args)
(if elmo-imap4-debug
(with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
(insert "NO LOGGING\n")
(insert (apply 'format message args) "\n")))))
+
+(defsubst elmo-imap4-decode-folder-string (string)
+ (if elmo-imap4-use-modified-utf7
+ (utf7-decode-string string 'imap)
+ string))
+
+(defsubst elmo-imap4-encode-folder-string (string)
+ (if elmo-imap4-use-modified-utf7
+ (utf7-encode-string string 'imap)
+ string))
+
;;; Response
(defmacro elmo-imap4-response-continue-req-p (response)
(error "IMAP error: %s"
(or (elmo-imap4-response-error-text response)
"No `OK' response from server."))))))
+
+
+
+;;; MIME-ELMO-IMAP Location
+(luna-define-method mime-imap-location-section-body ((location
+ mime-elmo-imap-location)
+ section)
+ (if (and (stringp section)
+ (string= section "HEADER"))
+ ;; Even in the section mode, header fields should be saved to the
+ ;; raw buffer .
+ (with-current-buffer (mime-elmo-imap-location-rawbuf-internal location)
+ (erase-buffer)
+ (elmo-message-fetch
+ (mime-elmo-imap-location-folder-internal location)
+ (mime-elmo-imap-location-number-internal location)
+ (mime-elmo-imap-location-strategy-internal location)
+ section
+ (current-buffer)
+ 'unseen)
+ (buffer-string))
+ (elmo-message-fetch
+ (mime-elmo-imap-location-folder-internal location)
+ (mime-elmo-imap-location-number-internal location)
+ (mime-elmo-imap-location-strategy-internal location)
+ section
+ nil 'unseen)))
+
+
+(luna-define-method mime-imap-location-bodystructure
+ ((location mime-elmo-imap-location))
+ (elmo-imap4-fetch-bodystructure
+ (mime-elmo-imap-location-folder-internal location)
+ (mime-elmo-imap-location-number-internal location)
+ (mime-elmo-imap-location-strategy-internal location)))
+
;;;
(defun elmo-imap4-session-check (session)
(car (nth 1 entry))))
response)))
-;;; Backend methods.
-(defun elmo-imap4-list-folders (spec &optional hierarchy)
- (let* ((root (elmo-imap4-spec-mailbox spec))
- (session (elmo-imap4-get-session spec))
- (delim (or
- (cdr
- (elmo-string-matched-assoc
- root
- (with-current-buffer (elmo-network-session-buffer session)
- elmo-imap4-server-namespace)))
- elmo-imap4-default-hierarchy-delimiter))
- result append-serv type)
- ;; Append delimiter
- (if (and root
- (not (string= root ""))
- (not (string-match (concat "\\(.*\\)"
- (regexp-quote delim)
- "\\'")
- root)))
- (setq root (concat root delim)))
- (setq result (elmo-imap4-response-get-selectable-mailbox-list
- (elmo-imap4-send-command-wait
- session
- (list "list " (elmo-imap4-mailbox root) " *"))))
- (unless (string= (elmo-imap4-spec-username spec)
- elmo-default-imap4-user)
- (setq append-serv (concat ":" (elmo-imap4-spec-username spec))))
- (unless (eq (elmo-imap4-spec-auth spec)
- elmo-default-imap4-authenticate-type)
- (setq append-serv
- (concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec)))))
- (unless (string= (elmo-imap4-spec-hostname spec)
- elmo-default-imap4-server)
- (setq append-serv (concat append-serv "@" (elmo-imap4-spec-hostname
- spec))))
- (unless (eq (elmo-imap4-spec-port spec)
- elmo-default-imap4-port)
- (setq append-serv (concat append-serv ":"
- (int-to-string
- (elmo-imap4-spec-port spec)))))
- (setq type (elmo-imap4-spec-stream-type spec))
- (unless (eq (elmo-network-stream-type-symbol type)
- elmo-default-imap4-stream-type)
- (if type
- (setq append-serv (concat append-serv
- (elmo-network-stream-type-spec-string
- type)))))
- (if hierarchy
- (let (folder folders ret)
- (while (setq folders (car result))
- (if (prog1
- (string-match
- (concat "^\\(" root "[^" delim "]" "+\\)" delim)
- folders)
- (setq folder (match-string 1 folders)))
- (progn
- (setq ret
- (append ret (list (list
- (concat "%" (elmo-imap4-decode-folder-string folder)
- (and append-serv
- (eval append-serv)))))))
- (setq result
- (delq nil
- (mapcar '(lambda (fld)
- (unless
- (string-match
- (concat "^" (regexp-quote folder))
- fld)
- fld))
- result))))
- (setq ret (append ret (list
- (concat "%" (elmo-imap4-decode-folder-string folders)
- (and append-serv
- (eval append-serv))))))
- (setq result (cdr result))))
- ret)
- (mapcar (lambda (fld)
- (concat "%" (elmo-imap4-decode-folder-string fld)
- (and append-serv
- (eval append-serv))))
- result))))
-
-(defun elmo-imap4-folder-exists-p (spec)
- (let ((session (elmo-imap4-get-session spec)))
- (if (string=
- (elmo-imap4-session-current-mailbox-internal session)
- (elmo-imap4-spec-mailbox spec))
- t
+(defun elmo-imap4-fetch-bodystructure (folder number strategy)
+ "Fetch BODYSTRUCTURE for the message in the FOLDER with NUMBER using STRATEGY."
+ (if (elmo-fetch-strategy-use-cache strategy)
+ (elmo-object-load
+ (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ "bodystructure"))
+ (let ((session (elmo-imap4-get-session folder))
+ bodystructure)
(elmo-imap4-session-select-mailbox
session
- (elmo-imap4-spec-mailbox spec)
- 'force 'no-error))))
-
-(defun elmo-imap4-folder-creatable-p (spec)
- t)
-
-(defun elmo-imap4-create-folder-maybe (spec dummy)
- (unless (elmo-imap4-folder-exists-p spec)
- (elmo-imap4-create-folder spec)))
+ (elmo-imap4-folder-mailbox-internal folder))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (prog1 (setq bodystructure
+ (elmo-imap4-response-value
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s bodystructure"
+ "fetch %s bodystructure")
+ number))
+ 'fetch)
+ 'bodystructure))
+ (when (elmo-fetch-strategy-save-cache strategy)
+ (elmo-file-cache-delete
+ (elmo-fetch-strategy-cache-path strategy))
+ (elmo-object-save
+ (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ "bodystructure")
+ bodystructure))))))
-(defun elmo-imap4-create-folder (spec)
+;;; Backend methods.
+(luna-define-method elmo-create-folder-plugged ((folder elmo-imap4-folder))
(elmo-imap4-send-command-wait
- (elmo-imap4-get-session spec)
+ (elmo-imap4-get-session folder)
(list "create " (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec)))))
+ (elmo-imap4-folder-mailbox-internal folder)))))
-(defun elmo-imap4-delete-folder (spec)
- (let ((session (elmo-imap4-get-session spec))
- msgs)
- (when (elmo-imap4-spec-mailbox spec)
- (when (setq msgs (elmo-imap4-list-folder spec))
- (elmo-imap4-delete-msgs spec msgs))
- (elmo-imap4-send-command-wait session "close")
- (elmo-imap4-send-command-wait
- session
- (list "delete "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)))))))
-
-(defun elmo-imap4-rename-folder (old-spec new-spec)
- (let ((session (elmo-imap4-get-session old-spec)))
- (elmo-imap4-send-command-wait session "close")
- (elmo-imap4-send-command-wait
- session
- (list "rename "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox old-spec))
- " "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox new-spec))))))
-
-(defun elmo-imap4-max-of-folder (spec)
- (let ((session (elmo-imap4-get-session spec))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- status)
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-status-callback nil)
- (setq elmo-imap4-status-callback-data nil))
- (setq status (elmo-imap4-response-value
- (elmo-imap4-send-command-wait
- session
- (list "status "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec))
- " (uidnext messages)"))
- 'status))
- (cons
- (- (elmo-imap4-response-value status 'uidnext) 1)
- (if killed
- (-
- (elmo-imap4-response-value status 'messages)
- (elmo-msgdb-killed-list-length killed))
- (elmo-imap4-response-value status 'messages)))))
+(defun elmo-imap4-get-session (folder &optional if-exists)
+ (elmo-network-get-session 'elmo-imap4-session "IMAP" folder if-exists))
-(defun elmo-imap4-folder-diff (spec folder &optional number-list)
- (if elmo-use-server-diff
- (elmo-imap4-server-diff spec)
- (elmo-generic-folder-diff spec folder number-list)))
-
-(defun elmo-imap4-get-session (spec &optional if-exists)
- (elmo-network-get-session
- 'elmo-imap4-session
- "IMAP"
- (elmo-imap4-spec-hostname spec)
- (elmo-imap4-spec-port spec)
- (elmo-imap4-spec-username spec)
- (elmo-imap4-spec-auth spec)
- (elmo-imap4-spec-stream-type spec)
- if-exists))
-
-(defun elmo-imap4-commit (spec)
- (if (elmo-imap4-plugged-p spec)
- (let ((session (elmo-imap4-get-session spec 'if-exists)))
- (when session
- (if (string=
- (elmo-imap4-session-current-mailbox-internal session)
- (elmo-imap4-spec-mailbox spec))
- (if elmo-imap4-use-select-to-update-status
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-spec-mailbox spec)
- 'force)
- (elmo-imap4-session-check session)))))))
-
(defun elmo-imap4-session-select-mailbox (session mailbox
&optional force no-error)
"Select MAILBOX in SESSION.
;; Not used.
)
-(defun elmo-imap4-list (spec flag)
- (let ((session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
+(defun elmo-imap4-list (folder flag)
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
(elmo-imap4-response-value
(elmo-imap4-send-command-wait
session
"search %s") flag))
'search)))
-(defun elmo-imap4-list-folder (spec)
- (let ((killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- numbers)
- (setq numbers (elmo-imap4-list spec "all"))
- (elmo-living-messages numbers killed)))
-
-(defun elmo-imap4-list-folder-unread (spec number-alist mark-alist
- unread-marks)
- (if (and (elmo-imap4-plugged-p spec)
- (elmo-imap4-use-flag-p spec))
- (elmo-imap4-list spec "unseen")
- (elmo-generic-list-folder-unread spec number-alist mark-alist
- unread-marks)))
-
-(defun elmo-imap4-list-folder-important (spec number-alist)
- (if (and (elmo-imap4-plugged-p spec)
- (elmo-imap4-use-flag-p spec))
- (elmo-imap4-list spec "flagged")))
-
-(defmacro elmo-imap4-detect-search-charset (string)
- (` (with-temp-buffer
- (insert (, string))
- (detect-mime-charset-region (point-min) (point-max)))))
-
-(defun elmo-imap4-search-internal-primitive (spec session filter from-msgs)
- (let ((search-key (elmo-filter-key filter))
- (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"))
- charset)
- (cond
- ((string= "last" search-key)
- (let ((numbers (or from-msgs (elmo-imap4-list-folder spec))))
- (nthcdr (max (- (length numbers)
- (string-to-int (elmo-filter-value filter)))
- 0)
- numbers)))
- ((string= "first" search-key)
- (let* ((numbers (or from-msgs (elmo-imap4-list-folder spec)))
- (rest (nthcdr (string-to-int (elmo-filter-value filter) )
- numbers)))
- (mapcar '(lambda (x) (delete x numbers)) rest)
- numbers))
- ((or (string= "since" search-key)
- (string= "before" search-key))
- (setq search-key (concat "sent" search-key))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid search %s%s%s %s"
- "search %s%s%s %s")
- (if from-msgs
- (concat
- (if elmo-imap4-use-uid "uid ")
- (cdr
- (car
- (elmo-imap4-make-number-set-list
- from-msgs)))
- " ")
- "")
- (if (eq (elmo-filter-type filter)
- 'unmatch)
- "not " "")
- search-key
- (elmo-date-get-description
- (elmo-date-get-datevec
- (elmo-filter-value filter)))))
- 'search))
- (t
- (setq charset
- (if (eq (length (elmo-filter-value filter)) 0)
- (setq charset 'us-ascii)
- (elmo-imap4-detect-search-charset
- (elmo-filter-value filter))))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (list
- (if elmo-imap4-use-uid "uid ")
- "search "
- "CHARSET "
- (elmo-imap4-astring
- (symbol-name charset))
- " "
- (if from-msgs
- (concat
- (if elmo-imap4-use-uid "uid ")
- (cdr
- (car
- (elmo-imap4-make-number-set-list
- from-msgs)))
- " ")
- "")
- (if (eq (elmo-filter-type filter)
- 'unmatch)
- "not " "")
- (format "%s%s "
- (if (member
- (elmo-filter-key filter)
- imap-search-keys)
- ""
- "header ")
- (elmo-filter-key filter))
- (elmo-imap4-astring
- (encode-mime-charset-string
- (elmo-filter-value filter) charset))))
- 'search)))))
-
-(defun elmo-imap4-search-internal (spec session condition from-msgs)
- (let (result)
- (cond
- ((vectorp condition)
- (setq result (elmo-imap4-search-internal-primitive
- spec session condition from-msgs)))
- ((eq (car condition) 'and)
- (setq result (elmo-imap4-search-internal spec session (nth 1 condition)
- from-msgs)
- result (elmo-list-filter result
- (elmo-imap4-search-internal
- spec session (nth 2 condition)
- from-msgs))))
- ((eq (car condition) 'or)
- (setq result (elmo-imap4-search-internal
- spec session (nth 1 condition) from-msgs)
- result (elmo-uniq-list
- (nconc result
- (elmo-imap4-search-internal
- spec session (nth 2 condition) from-msgs)))
- result (sort result '<))))))
-
-
-(defun elmo-imap4-search (spec condition &optional from-msgs)
- (save-excursion
- (let ((session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-spec-mailbox spec))
- (elmo-imap4-search-internal spec session condition from-msgs))))
-
-(defun elmo-imap4-use-flag-p (spec)
- (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
- (elmo-imap4-spec-mailbox spec))))
-
(static-cond
((fboundp 'float)
;; Emacs can parse dot symbol.
set-list)))
(nreverse set-list)))
-;;
-;; set mark
-;; read-mark -> "\\Seen"
-;; important -> "\\Flagged"
-;;
-;; (delete -> \\Deleted)
-(defun elmo-imap4-mark-set-on-msgs (spec msgs mark &optional unmark no-expunge)
- "SET flag of MSGS as MARK.
-If optional argument UNMARK is non-nil, unmark."
- (let ((session (elmo-imap4-get-session spec))
- set-list)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq set-list (elmo-imap4-make-number-set-list msgs))
- (when set-list
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-fetch-callback nil)
- (setq elmo-imap4-fetch-callback-data nil))
- (elmo-imap4-send-command-wait
- session
- (format
- (if elmo-imap4-use-uid
- "uid store %s %sflags.silent (%s)"
- "store %s %sflags.silent (%s)")
- (cdr (car set-list))
- (if unmark "-" "+")
- mark))
- (unless no-expunge
- (elmo-imap4-send-command-wait session "expunge")))
- t))
-
-(defun elmo-imap4-mark-as-important (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" nil 'no-expunge)))
-
-(defun elmo-imap4-mark-as-read (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" nil 'no-expunge)))
-
-(defun elmo-imap4-unmark-important (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" 'unmark
- 'no-expunge)))
-
-(defun elmo-imap4-mark-as-unread (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" 'unmark 'no-expunge)))
-
-(defun elmo-imap4-delete-msgs (spec msgs)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted"))
-
-(defun elmo-imap4-delete-msgs-no-expunge (spec msgs)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted" nil 'no-expunge))
-
-(defun elmo-imap4-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- "Create msgdb for SPEC for NUMLIST."
- (elmo-imap4-msgdb-create spec numlist new-mark already-mark
- seen-mark important-mark seen-list t))
-
;; Current buffer is process buffer.
(defun elmo-imap4-fetch-callback (element app-data)
(funcall elmo-imap4-fetch-callback
(if (member "\\Flagged" flags)
(elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
(setq mark (or (elmo-msgdb-global-mark-get (car entity))
- (if (elmo-cache-exists-p (car entity)) ;; XXX
+ (if (elmo-file-cache-status
+ (elmo-file-cache-get (car entity)))
(if (or seen
(and use-flag
(member "\\Seen" flags)))
(list (elmo-msgdb-overview-entity-get-number entity)
mark))))))))
-(defun elmo-imap4-msgdb-create (spec numlist &rest args)
- "Create msgdb for SPEC."
- (when numlist
- (let ((session (elmo-imap4-get-session spec))
- (headers
- (append
- '("Subject" "From" "To" "Cc" "Date"
- "Message-Id" "References" "In-Reply-To")
- elmo-msgdb-extra-fields))
- (total 0)
- (length (length numlist))
- rfc2060 set-list)
- (setq rfc2060 (memq 'imap4rev1
- (elmo-imap4-session-capability-internal
- session)))
- (message "Getting overview...")
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq set-list (elmo-imap4-make-number-set-list
- numlist
- elmo-imap4-overview-fetch-chop-length))
- ;; Setup callback.
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-current-msgdb nil
- elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
- elmo-imap4-fetch-callback-data (cons args
- (elmo-imap4-use-flag-p
- spec)))
- (while set-list
- (elmo-imap4-send-command-wait
- session
- ;; get overview entity from IMAP4
- (format "%sfetch %s (%s rfc822.size flags)"
- (if elmo-imap4-use-uid "uid " "")
- (cdr (car set-list))
- (if rfc2060
- (format "body.peek[header.fields %s]" headers)
- (format "%s" headers))))
- (when (> length elmo-display-progress-threshold)
- (setq total (+ total (car (car set-list))))
- (elmo-display-progress
- 'elmo-imap4-msgdb-create "Getting overview..."
- (/ (* total 100) length)))
- (setq set-list (cdr set-list)))
- (message "Getting overview...done")
- elmo-imap4-current-msgdb))))
-
(defun elmo-imap4-parse-capability (string)
(if (string-match "^\\*\\(.*\\)$" string)
(elmo-read
mechanism
(elmo-network-session-user-internal session)
"imap"
- (elmo-network-session-host-internal session)))
+ (elmo-network-session-server-internal session)))
;;; (if elmo-imap4-auth-user-realm
;;; (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm))
(setq name (sasl-mechanism-name mechanism)
(elmo-imap4-send-command-wait session "namespace")
'namespace)))))
-(defun elmo-imap4-setup-send-buffer (string)
- (let ((tmp-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*")))
+(defun elmo-imap4-setup-send-buffer (&optional string)
+ (let ((send-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*"))
+ (source-buf (unless string (current-buffer))))
(save-excursion
(save-match-data
- (set-buffer tmp-buf)
+ (set-buffer send-buf)
(erase-buffer)
(elmo-set-buffer-multibyte nil)
- (insert string)
+ (if string
+ (insert string)
+ (with-current-buffer source-buf
+ (copy-to-buffer send-buf (point-min) (point-max))))
(goto-char (point-min))
(if (eq (re-search-forward "^$" nil t)
(point-max))
(goto-char (point-min))
(while (search-forward "\n" nil t)
(replace-match "\r\n"))))
- tmp-buf))
-
-(defun elmo-imap4-read-part (folder msg part)
- (let* ((spec (elmo-folder-get-spec folder))
- (session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-fetch-callback nil)
- (setq elmo-imap4-fetch-callback-data nil))
- (elmo-delete-cr
- (elmo-imap4-response-bodydetail-text
- (elmo-imap4-response-value-all
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body.peek[%s]"
- "fetch %s body.peek[%s]")
- msg part))
- 'fetch)))))
-
-(defun elmo-imap4-prefetch-msg (spec msg outbuf)
- (elmo-imap4-read-msg spec msg outbuf 'unseen))
-
-(defun elmo-imap4-read-msg (spec msg outbuf
- &optional leave-seen-flag-untouched)
- (let ((session (elmo-imap4-get-session spec))
- response)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-fetch-callback nil)
- (setq elmo-imap4-fetch-callback-data nil))
- (setq response
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body%s[]"
- "fetch %s body%s[]")
- msg
- (if leave-seen-flag-untouched
- ".peek" ""))))
- (and (setq response (elmo-imap4-response-bodydetail-text
- (elmo-imap4-response-value-all
- response 'fetch )))
- (with-current-buffer outbuf
- (erase-buffer)
- (insert response)
- (elmo-delete-cr-get-content-type)))))
+ send-buf))
(defun elmo-imap4-setup-send-buffer-from-file (file)
(let ((tmp-buf (get-buffer-create
(replace-match "\r\n"))))
tmp-buf))
-(defun elmo-imap4-delete-msgids (spec msgids)
- "If actual message-id is matched, then delete it."
- (let ((message-ids msgids)
- (i 0)
- (num (length msgids)))
- (while message-ids
- (setq i (+ 1 i))
- (message "Deleting message...%d/%d" i num)
- (elmo-imap4-delete-msg-by-id spec (car message-ids))
- (setq message-ids (cdr message-ids)))
- (elmo-imap4-send-command-wait (elmo-imap4-get-session spec) "expunge")))
-
-(defun elmo-imap4-delete-msg-by-id (spec msgid)
- (let ((session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (elmo-imap4-delete-msgs-no-expunge
- spec
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (list
- (if elmo-imap4-use-uid
- "uid search header message-id "
- "search header message-id ")
- (elmo-imap4-field-body msgid)))
- 'search))))
-
-(defun elmo-imap4-append-msg-by-id (spec msgid)
- (let ((session (elmo-imap4-get-session spec))
- send-buf)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq send-buf (elmo-imap4-setup-send-buffer-from-file
- (elmo-cache-get-path msgid)))
- (unwind-protect
- (elmo-imap4-send-command-wait
- session
- (list
- "append "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
- " (\\Seen) "
- (elmo-imap4-buffer-literal send-buf)))
- (kill-buffer send-buf)))
- t)
-
-(defun elmo-imap4-append-msg (spec string &optional msg no-see)
- (let ((session (elmo-imap4-get-session spec))
- send-buf)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq send-buf (elmo-imap4-setup-send-buffer string))
- (unwind-protect
- (elmo-imap4-send-command-wait
- session
- (list
- "append "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
- (if no-see " " " (\\Seen) ")
- (elmo-imap4-buffer-literal send-buf)))
- (kill-buffer send-buf)))
- t)
-
-(defun elmo-imap4-copy-msgs (dst-spec
- msgs src-spec &optional expunge-it same-number)
- "Equivalence of hostname, username is assumed."
- (let ((session (elmo-imap4-get-session src-spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox src-spec))
- (while msgs
- (elmo-imap4-send-command-wait session
- (list
- (format
- (if elmo-imap4-use-uid
- "uid copy %s "
- "copy %s ")
- (car msgs))
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox dst-spec))))
- (setq msgs (cdr msgs)))
- (when expunge-it
- (elmo-imap4-send-command-wait session "expunge"))
- t))
+(luna-define-method elmo-delete-message-safe ((folder elmo-imap4-folder)
+ number msgid)
+ (let ((session (elmo-imap4-get-session folder))
+ candidates)
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
+ (setq candidates
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait session
+ (list
+ (if elmo-imap4-use-uid
+ "uid search header message-id "
+ "search header message-id ")
+ (elmo-imap4-field-body msgid)))
+ 'search))
+ (if (memq number candidates)
+ (elmo-folder-delete-messages folder (list number)))))
(defun elmo-imap4-server-diff-async-callback-1 (status data)
(funcall elmo-imap4-server-diff-async-callback
(elmo-imap4-response-value status 'messages))
data))
-(defun elmo-imap4-server-diff-async (spec)
- (let ((session (elmo-imap4-get-session spec)))
- ;; commit.
- ;; (elmo-imap4-commit spec)
+(defun elmo-imap4-server-diff-async (folder)
+ (let ((session (elmo-imap4-get-session folder)))
+ ;; We should `check' folder to obtain newest information here.
+ ;; But since there's no asynchronous check mechanism in elmo yet,
+ ;; checking is not done here.
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback
'elmo-imap4-server-diff-async-callback-1)
(list
"status "
(elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec))
+ (elmo-imap4-folder-mailbox-internal folder))
" (unseen messages)"))))
-(defun elmo-imap4-server-diff (spec)
- "Get server status"
- (let ((session (elmo-imap4-get-session spec))
- response)
+(luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder)))
;; commit.
-;;; (elmo-imap4-commit spec)
+ ;; (elmo-imap4-commit spec)
(with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-status-callback nil)
- (setq elmo-imap4-status-callback-data nil))
- (setq response
- (elmo-imap4-send-command-wait session
- (list
- "status "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec))
- " (unseen messages)")))
- (setq response (elmo-imap4-response-value response 'status))
- (cons (elmo-imap4-response-value response 'unseen)
- (elmo-imap4-response-value response 'messages))))
-
-(defun elmo-imap4-use-cache-p (spec number)
- elmo-imap4-use-cache)
-
-(defun elmo-imap4-local-file-p (spec number)
- nil)
-
-(defun elmo-imap4-port-label (spec)
- (concat "imap4"
- (if (elmo-imap4-spec-stream-type spec)
- (concat "!" (symbol-name
- (elmo-network-stream-type-symbol
- (elmo-imap4-spec-stream-type spec)))))))
-
-
-(defsubst elmo-imap4-portinfo (spec)
- (list (elmo-imap4-spec-hostname spec) (elmo-imap4-spec-port spec)))
-
-(defun elmo-imap4-plugged-p (spec)
- (apply 'elmo-plugged-p
- (append (elmo-imap4-portinfo spec)
- (list nil (quote (elmo-imap4-port-label spec))))))
-
-(defun elmo-imap4-set-plugged (spec plugged add)
- (apply 'elmo-set-plugged plugged
- (append (elmo-imap4-portinfo spec)
- (list nil nil (quote (elmo-imap4-port-label spec)) add))))
-
-(defalias 'elmo-imap4-sync-number-alist 'elmo-generic-sync-number-alist)
+ (setq elmo-imap4-status-callback
+ 'elmo-imap4-server-diff-async-callback-1)
+ (setq elmo-imap4-status-callback-data
+ elmo-imap4-server-diff-async-callback-data))
+ (elmo-imap4-send-command session
+ (list
+ "status "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder))
+ " (unseen messages)"))))
;;; IMAP parser.
(elmo-imap4-forward)
(nreverse body)))))
+(luna-define-method elmo-folder-initialize :around ((folder
+ elmo-imap4-folder)
+ name)
+ (let ((default-user elmo-default-imap4-user)
+ (default-server elmo-default-imap4-server)
+ (default-port elmo-default-imap4-port)
+ (elmo-network-stream-type-alist
+ (if elmo-imap4-stream-type-alist
+ (append elmo-imap4-stream-type-alist
+ elmo-network-stream-type-alist)
+ elmo-network-stream-type-alist)))
+ (when (string-match "\\(.*\\)@\\(.*\\)" default-server)
+ ;; case: default-imap4-server is specified like
+ ;; "hoge%imap.server@gateway".
+ (setq default-user (elmo-match-string 1 default-server))
+ (setq default-server (elmo-match-string 2 default-server)))
+ (setq name (luna-call-next-method))
+ (when (string-match
+ "^\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?"
+ name)
+ (progn
+ (if (match-beginning 1)
+ (progn
+ (elmo-imap4-folder-set-mailbox-internal
+ folder
+ (elmo-match-string 1 name))
+ (if (eq (length (elmo-imap4-folder-mailbox-internal folder))
+ 0)
+ ;; No information is specified other than folder type.
+ (elmo-imap4-folder-set-mailbox-internal
+ folder
+ elmo-default-imap4-mailbox)))
+ (elmo-imap4-folder-set-mailbox-internal
+ folder
+ elmo-default-imap4-mailbox))
+ ;; Setup slots for elmo-net-folder.
+ (elmo-net-folder-set-user-internal
+ folder
+ (if (match-beginning 2)
+ (elmo-match-substring 2 name 1)
+ default-user))
+ (elmo-net-folder-set-auth-internal
+ folder
+ (if (match-beginning 3)
+ (intern (elmo-match-substring 3 name 1))
+ elmo-default-imap4-authenticate-type))
+ (unless (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-set-server-internal folder default-server))
+ (unless (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-set-port-internal folder default-port))
+ (unless (elmo-net-folder-stream-type-internal folder)
+ (elmo-net-folder-set-stream-type-internal
+ folder
+ elmo-default-imap4-stream-type))
+ folder))))
+
+;;; ELMO IMAP4 folder
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-imap4-folder))
+ (convert-standard-filename
+ (let ((mailbox (elmo-imap4-folder-mailbox-internal folder)))
+ (if (string= "inbox" (downcase mailbox))
+ (setq mailbox "inbox"))
+ (if (eq (string-to-char mailbox) ?/)
+ (setq mailbox (substring mailbox 1 (length mailbox))))
+ (expand-file-name
+ mailbox
+ (expand-file-name
+ (or (elmo-net-folder-user-internal folder) "nobody")
+ (expand-file-name (or (elmo-net-folder-server-internal folder)
+ "nowhere")
+ (expand-file-name
+ "imap"
+ elmo-msgdb-dir)))))))
+
+(luna-define-method elmo-folder-status-plugged ((folder
+ elmo-imap4-folder))
+ (elmo-imap4-folder-status-plugged folder))
+
+(defun elmo-imap4-folder-status-plugged (folder)
+ (let ((session (elmo-imap4-get-session folder))
+ (killed (elmo-msgdb-killed-list-load
+ (elmo-folder-msgdb-path folder)))
+ status)
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-status-callback nil)
+ (setq elmo-imap4-status-callback-data nil))
+ (setq status (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (list "status "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder))
+ " (uidnext messages)"))
+ 'status))
+ (cons
+ (- (elmo-imap4-response-value status 'uidnext) 1)
+ (if killed
+ (-
+ (elmo-imap4-response-value status 'messages)
+ (elmo-msgdb-killed-list-length killed))
+ (elmo-imap4-response-value status 'messages)))))
+
+(luna-define-method elmo-folder-list-messages-plugged ((folder
+ elmo-imap4-folder))
+ (elmo-imap4-list folder "all"))
+
+(luna-define-method elmo-folder-list-unreads-plugged
+ ((folder elmo-imap4-folder))
+ (elmo-imap4-list folder "unseen"))
+
+(luna-define-method elmo-folder-list-importants-plugged
+ ((folder elmo-imap4-folder))
+ (elmo-imap4-list folder "flagged"))
+
+(luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
+ (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
+ (elmo-imap4-folder-mailbox-internal folder))))
+
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-imap4-folder)
+ &optional one-level)
+ (let* ((root (elmo-imap4-folder-mailbox-internal folder))
+ (session (elmo-imap4-get-session folder))
+ (prefix (elmo-folder-prefix-internal folder))
+ (delim (or
+ (cdr
+ (elmo-string-matched-assoc
+ root
+ (with-current-buffer (elmo-network-session-buffer session)
+ elmo-imap4-server-namespace)))
+ elmo-imap4-default-hierarchy-delimiter))
+ result append-serv type)
+ ;; Append delimiter
+ (if (and root
+ (not (string= root ""))
+ (not (string-match (concat "\\(.*\\)"
+ (regexp-quote delim)
+ "\\'")
+ root)))
+ (setq root (concat root delim)))
+ (setq result (elmo-imap4-response-get-selectable-mailbox-list
+ (elmo-imap4-send-command-wait
+ session
+ (list "list " (elmo-imap4-mailbox root) " *"))))
+ (unless (string= (elmo-net-folder-user-internal folder)
+ elmo-default-imap4-user)
+ (setq append-serv (concat ":" (elmo-net-folder-user-internal folder))))
+ (unless (eq (elmo-net-folder-auth-internal folder)
+ elmo-default-imap4-authenticate-type)
+ (setq append-serv
+ (concat append-serv "/"
+ (symbol-name (elmo-net-folder-auth-internal folder)))))
+ (unless (string= (elmo-net-folder-server-internal folder)
+ elmo-default-imap4-server)
+ (setq append-serv (concat append-serv "@"
+ (elmo-net-folder-server-internal folder))))
+ (unless (eq (elmo-net-folder-port-internal folder) elmo-default-imap4-port)
+ (setq append-serv (concat append-serv ":"
+ (int-to-string
+ (elmo-net-folder-port-internal folder)))))
+ (setq type (elmo-net-folder-stream-type-internal folder))
+ (unless (eq (elmo-network-stream-type-symbol type)
+ elmo-default-imap4-stream-type)
+ (if type
+ (setq append-serv (concat append-serv
+ (elmo-network-stream-type-spec-string
+ type)))))
+ (if one-level
+ (let (folder folders ret)
+ (while (setq folders (car result))
+ (if (prog1
+ (string-match
+ (concat "^\\(" root "[^" delim "]" "+\\)" delim)
+ folders)
+ (setq folder (match-string 1 folders)))
+ (progn
+ (setq ret
+ (append ret
+ (list
+ (list
+ (concat
+ prefix
+ (elmo-imap4-decode-folder-string folder)
+ (and append-serv
+ (eval append-serv)))))))
+ (setq result
+ (delq
+ nil
+ (mapcar '(lambda (fld)
+ (unless
+ (string-match
+ (concat "^" (regexp-quote folder))
+ fld)
+ fld))
+ result))))
+ (setq ret (append
+ ret
+ (list
+ (concat prefix
+ (elmo-imap4-decode-folder-string folders)
+ (and append-serv
+ (eval append-serv))))))
+ (setq result (cdr result))))
+ ret)
+ (mapcar (lambda (fld)
+ (concat prefix (elmo-imap4-decode-folder-string fld)
+ (and append-serv
+ (eval append-serv))))
+ result))))
+
+(luna-define-method elmo-folder-exists-p-plugged ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder)))
+ (if (string=
+ (elmo-imap4-session-current-mailbox-internal session)
+ (elmo-imap4-folder-mailbox-internal folder))
+ t
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder)
+ 'force 'no-error))))
+
+(luna-define-method elmo-folder-delete ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder))
+ msgs)
+ (when (elmo-imap4-folder-mailbox-internal folder)
+ (when (setq msgs (elmo-folder-list-messages folder))
+ (elmo-folder-delete-messages folder msgs))
+ (elmo-imap4-send-command-wait session "close")
+ (elmo-imap4-send-command-wait
+ session
+ (list "delete "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder)))))))
+
+(luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder)
+ new-folder)
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-send-command-wait session "close")
+ (elmo-imap4-send-command-wait
+ session
+ (list "rename "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder))
+ " "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal new-folder))))))
+
+(defun elmo-imap4-copy-messages (src-folder dst-folder numbers)
+ (let ((session (elmo-imap4-get-session src-folder))
+ (set-list (elmo-imap4-make-number-set-list numbers)))
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ src-folder))
+ (when set-list
+ (if (elmo-imap4-send-command-wait session
+ (list
+ (format
+ (if elmo-imap4-use-uid
+ "uid copy %s "
+ "copy %s ")
+ (cdr (car set-list)))
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal
+ dst-folder))))
+ numbers))))
+
+(defun elmo-imap4-set-flag (folder numbers flag &optional remove)
+ "Set flag on messages.
+FOLDER is the ELMO folder structure.
+NUMBERS is the message numbers to be flagged.
+FLAG is the flag name.
+If optional argument REMOVE is non-nil, remove FLAG."
+ (let ((session (elmo-imap4-get-session folder))
+ set-list)
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (setq set-list (elmo-imap4-make-number-set-list numbers))
+ (when set-list
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid store %s %sflags.silent (%s)"
+ "store %s %sflags.silent (%s)")
+ (cdr (car set-list))
+ (if remove "-" "+")
+ flag)))))
+
+(luna-define-method elmo-folder-delete-messages-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-set-flag folder numbers "\\Deleted")
+ (elmo-imap4-send-command-wait session "expunge")))
+
+(defmacro elmo-imap4-detect-search-charset (string)
+ (` (with-temp-buffer
+ (insert (, string))
+ (detect-mime-charset-region (point-min) (point-max)))))
+
+(defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
+ (let ((search-key (elmo-filter-key filter))
+ (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"))
+ charset)
+ (cond
+ ((string= "last" search-key)
+ (let ((numbers (or from-msgs (elmo-folder-list-messages folder))))
+ (nthcdr (max (- (length numbers)
+ (string-to-int (elmo-filter-value filter)))
+ 0)
+ numbers)))
+ ((string= "first" search-key)
+ (let* ((numbers (or from-msgs (elmo-folder-list-messages folder)))
+ (rest (nthcdr (string-to-int (elmo-filter-value filter) )
+ numbers)))
+ (mapcar '(lambda (x) (delete x numbers)) rest)
+ numbers))
+ ((or (string= "since" search-key)
+ (string= "before" search-key))
+ (setq search-key (concat "sent" search-key))
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait session
+ (format
+ (if elmo-imap4-use-uid
+ "uid search %s%s%s %s"
+ "search %s%s%s %s")
+ (if from-msgs
+ (concat
+ (if elmo-imap4-use-uid "uid ")
+ (cdr
+ (car
+ (elmo-imap4-make-number-set-list
+ from-msgs)))
+ " ")
+ "")
+ (if (eq (elmo-filter-type filter)
+ 'unmatch)
+ "not " "")
+ search-key
+ (elmo-date-get-description
+ (elmo-date-get-datevec
+ (elmo-filter-value filter)))))
+ 'search))
+ (t
+ (setq charset
+ (if (eq (length (elmo-filter-value filter)) 0)
+ (setq charset 'us-ascii)
+ (elmo-imap4-detect-search-charset
+ (elmo-filter-value filter))))
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait session
+ (list
+ (if elmo-imap4-use-uid "uid ")
+ "search "
+ "CHARSET "
+ (elmo-imap4-astring
+ (symbol-name charset))
+ " "
+ (if from-msgs
+ (concat
+ (if elmo-imap4-use-uid "uid ")
+ (cdr
+ (car
+ (elmo-imap4-make-number-set-list
+ from-msgs)))
+ " ")
+ "")
+ (if (eq (elmo-filter-type filter)
+ 'unmatch)
+ "not " "")
+ (format "%s%s "
+ (if (member
+ (elmo-filter-key filter)
+ imap-search-keys)
+ ""
+ "header ")
+ (elmo-filter-key filter))
+ (elmo-imap4-astring
+ (encode-mime-charset-string
+ (elmo-filter-value filter) charset))))
+ 'search)))))
+
+(defun elmo-imap4-search-internal (folder session condition from-msgs)
+ (let (result)
+ (cond
+ ((vectorp condition)
+ (setq result (elmo-imap4-search-internal-primitive
+ folder session condition from-msgs)))
+ ((eq (car condition) 'and)
+ (setq result (elmo-imap4-search-internal folder session (nth 1 condition)
+ from-msgs)
+ result (elmo-list-filter result
+ (elmo-imap4-search-internal
+ folder session (nth 2 condition)
+ from-msgs))))
+ ((eq (car condition) 'or)
+ (setq result (elmo-imap4-search-internal
+ folder session (nth 1 condition) from-msgs)
+ result (elmo-uniq-list
+ (nconc result
+ (elmo-imap4-search-internal
+ folder session (nth 2 condition) from-msgs)))
+ result (sort result '<))))))
+
+(luna-define-method elmo-folder-search ((folder elmo-imap4-folder)
+ condition &optional numbers)
+ (save-excursion
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
+ (elmo-imap4-search-internal folder session condition numbers))))
+
+(luna-define-method elmo-folder-msgdb-create
+ ((folder elmo-imap4-folder) numbers &rest args)
+ (when numbers
+ (let ((session (elmo-imap4-get-session folder))
+ (headers
+ (append
+ '("Subject" "From" "To" "Cc" "Date"
+ "Message-Id" "References" "In-Reply-To")
+ elmo-msgdb-extra-fields))
+ (total 0)
+ (length (length numbers))
+ rfc2060 set-list)
+ (setq rfc2060 (memq 'imap4rev1
+ (elmo-imap4-session-capability-internal
+ session)))
+ (message "Getting overview...")
+ (elmo-imap4-session-select-mailbox
+ session (elmo-imap4-folder-mailbox-internal folder))
+ (setq set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-overview-fetch-chop-length))
+ ;; Setup callback.
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-current-msgdb nil
+ elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
+ elmo-imap4-fetch-callback-data (cons args
+ (elmo-folder-use-flag-p
+ folder)))
+ (while set-list
+ (elmo-imap4-send-command-wait
+ session
+ ;; get overview entity from IMAP4
+ (format "%sfetch %s (%s rfc822.size flags)"
+ (if elmo-imap4-use-uid "uid " "")
+ (cdr (car set-list))
+ (if rfc2060
+ (format "body.peek[header.fields %s]" headers)
+ (format "%s" headers))))
+ (when (> length elmo-display-progress-threshold)
+ (setq total (+ total (car (car set-list))))
+ (elmo-display-progress
+ 'elmo-imap4-msgdb-create "Getting overview..."
+ (/ (* total 100) length)))
+ (setq set-list (cdr set-list)))
+ (message "Getting overview...done")
+ elmo-imap4-current-msgdb))))
+
+(luna-define-method elmo-folder-unmark-important-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Flagged" 'remove))
+
+(luna-define-method elmo-folder-mark-as-important-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Flagged"))
+
+(luna-define-method elmo-folder-unmark-read-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Seen" 'remove))
+
+(luna-define-method elmo-folder-mark-as-read-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Seen"))
+
+(luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
+ number)
+ elmo-imap4-use-cache)
+
+(luna-define-method elmo-folder-message-appendable-p ((folder elmo-imap4-folder))
+ (if (elmo-folder-plugged-p folder)
+ (not (elmo-imap4-session-read-only-internal
+ (elmo-imap4-get-session folder)))
+ elmo-enable-disconnected-operation)) ; offline refile.
+
+(luna-define-method elmo-folder-check-plugged ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder 'if-exists)))
+ (when session
+ (if (string=
+ (elmo-imap4-session-current-mailbox-internal session)
+ (elmo-imap4-folder-mailbox-internal folder))
+ (if elmo-imap4-use-select-to-update-status
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder)
+ 'force)
+ (elmo-imap4-session-check session))))))
+
+(defsubst elmo-imap4-folder-diff-plugged (folder)
+ (let ((session (elmo-imap4-get-session folder))
+ messages
+ response killed)
+;;; (elmo-imap4-commit spec)
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-status-callback nil)
+ (setq elmo-imap4-status-callback-data nil))
+ (setq response
+ (elmo-imap4-send-command-wait session
+ (list
+ "status "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ " (unseen messages)")))
+ (setq response (elmo-imap4-response-value response 'status))
+ (setq messages (elmo-imap4-response-value response 'messages))
+ (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
+ (if killed
+ (setq messages (- messages
+ (elmo-msgdb-killed-list-length
+ killed))))
+ (cons (elmo-imap4-response-value response 'unseen)
+ messages)))
+
+(luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder))
+ (elmo-imap4-folder-diff-plugged folder))
+
+(luna-define-method elmo-folder-diff-async ((folder elmo-imap4-folder)
+ &optional number-alist)
+ (setq elmo-imap4-server-diff-async-callback
+ elmo-folder-diff-async-callback)
+ (setq elmo-imap4-server-diff-async-callback-data
+ elmo-folder-diff-async-callback-data)
+ (elmo-imap4-server-diff-async folder))
+
+(luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder))
+ (if (elmo-folder-plugged-p folder)
+ (let (session mailbox msgdb response tag)
+ (condition-case err
+ (progn
+ (setq session (elmo-imap4-get-session folder)
+ mailbox (elmo-imap4-folder-mailbox-internal folder)
+ tag (elmo-imap4-send-command session
+ (list "select "
+ (elmo-imap4-mailbox
+ mailbox))))
+ (setq msgdb (elmo-msgdb-load folder))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
+ (setq response (elmo-imap4-read-response session tag)))
+ (quit
+ (if response
+ (elmo-imap4-session-set-current-mailbox-internal
+ session mailbox)
+ (and session
+ (elmo-imap4-session-set-current-mailbox-internal
+ session nil))))
+ (error
+ (if response
+ (elmo-imap4-session-set-current-mailbox-internal
+ session mailbox)
+ (and session
+ (elmo-imap4-session-set-current-mailbox-internal
+ session nil)))))
+ (elmo-folder-set-msgdb-internal folder
+ (or msgdb (elmo-msgdb-load folder))))
+ (luna-call-next-method)))
+
+;; elmo-folder-open-internal: do nothing.
+
+(luna-define-method elmo-find-fetch-strategy
+ ((folder elmo-imap4-folder) entity &optional ignore-cache)
+ (let ((number (elmo-msgdb-overview-entity-get-number entity))
+ cache-file size message-id)
+ (setq size (elmo-msgdb-overview-entity-get-size entity))
+ (setq message-id (elmo-msgdb-overview-entity-get-id entity))
+ (setq cache-file (elmo-file-cache-get message-id))
+ (if (or ignore-cache
+ (null (elmo-file-cache-status cache-file)))
+ (if (and elmo-message-fetch-threshold
+ (integerp size)
+ (>= size elmo-message-fetch-threshold)
+ (or (not elmo-message-fetch-confirm)
+ (not (prog1 (y-or-n-p
+ (format
+ "Fetch entire message at once? (%dbytes)"
+ size))
+ (message "")))))
+ ;; Fetch message as imap message.
+ (elmo-make-fetch-strategy 'section
+ nil
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path
+ cache-file))
+ ;; Don't use existing cache and fetch entire message at once.
+ (elmo-make-fetch-strategy 'entire nil
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path cache-file)))
+ ;; Cache found and use it.
+ (if (not ignore-cache)
+ (if (eq (elmo-file-cache-status cache-file) 'section)
+ ;; Fetch message with imap message.
+ (elmo-make-fetch-strategy 'section
+ t
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path
+ cache-file))
+ (elmo-make-fetch-strategy 'entire
+ t
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path
+ cache-file)))))))
+
+(luna-define-method elmo-folder-create ((folder elmo-imap4-folder))
+ (elmo-imap4-send-command-wait
+ (elmo-imap4-get-session folder)
+ (list "create "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder)))))
+
+(luna-define-method elmo-folder-append-buffer
+ ((folder elmo-imap4-folder) unread &optional number)
+ (let ((session (elmo-imap4-get-session folder))
+ send-buffer result)
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (setq send-buffer (elmo-imap4-setup-send-buffer))
+ (unwind-protect
+ (setq result
+ (elmo-imap4-send-command-wait
+ session
+ (list
+ "append "
+ (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
+ folder))
+ (if unread " " " (\\Seen) ")
+ (elmo-imap4-buffer-literal send-buffer))))
+ (kill-buffer send-buffer))
+ result))
+
+(eval-when-compile
+ (defmacro elmo-imap4-identical-system-p (folder1 folder2)
+ "Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system."
+ (` (and (string= (elmo-net-folder-server-internal (, folder1))
+ (elmo-net-folder-server-internal (, folder2)))
+ (eq (elmo-net-folder-port-internal (, folder1))
+ (elmo-net-folder-port-internal (, folder2)))
+ (string= (elmo-net-folder-user-internal (, folder1))
+ (elmo-net-folder-user-internal (, folder2)))))))
+
+(luna-define-method elmo-folder-append-messages :around
+ ((folder elmo-imap4-folder) src-folder numbers unread-marks
+ &optional same-number)
+ (if (and (eq (elmo-folder-type-internal src-folder) 'imap4)
+ (elmo-imap4-identical-system-p folder src-folder))
+ (elmo-imap4-copy-messages src-folder folder numbers)
+ (luna-call-next-method)))
+
+(luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
+ number)
+ (if (elmo-folder-plugged-p folder)
+ (not (elmo-imap4-session-read-only-internal
+ (elmo-imap4-get-session folder)))
+ elmo-enable-disconnected-operation)) ; offline refile.
+
+(luna-define-method elmo-message-fetch-unplugged
+ ((folder elmo-imap4-folder)
+ number strategy &optional section outbuf unseen)
+ (let ((cache-file (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ section)))
+ (if (and (elmo-fetch-strategy-use-cache strategy)
+ (file-exists-p cache-file))
+ (if outbuf
+ (with-current-buffer outbuf
+ (insert-file-contents-as-binary cache-file)
+ t)
+ (with-temp-buffer
+ (insert-file-contents-as-binary cache-file)
+ (buffer-string)))
+ (error "%d%s is not cached." number (if section
+ (format "(%s)" section)
+ "")))))
+
+(defsubst elmo-imap4-message-fetch (folder number strategy
+ section outbuf unseen)
+ (let ((session (elmo-imap4-get-session folder))
+ response)
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (setq response
+ (elmo-imap4-send-command-wait session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body%s[%s]"
+ "fetch %s body%s[%s]")
+ number
+ (if unseen ".peek" "")
+ (or section "")
+ )))
+ (if (setq response (elmo-imap4-response-bodydetail-text
+ (elmo-imap4-response-value-all
+ response 'fetch)))
+ (with-current-buffer outbuf
+ (erase-buffer)
+ (insert response)))))
+
+(luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
+ number strategy
+ &optional section
+ outbuf unseen)
+ (elmo-imap4-message-fetch folder number strategy section outbuf unseen))
+
(require 'product)
(product-provide (provide 'elmo-imap4) (require 'elmo-version))
;;; Code:
;;
-(require 'elmo-localdir)
-
-(defsubst elmo-internal-list-folder-subr (spec &optional nonsort)
- (let* ((directive (nth 1 spec))
- (arg (nth 2 spec))
- (flist (elmo-list-folder-by-location
- spec
- (elmo-internal-list-location directive arg)))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- numbers)
- (if nonsort
- (cons (or (elmo-max-of-list flist) 0)
- (if killed
- (- (length flist)
- (elmo-msgdb-killed-list-length killed))
- (length flist)))
- (setq numbers (sort flist '<))
- (elmo-living-messages numbers killed))))
-
-(defun elmo-internal-list-folder (spec)
- (elmo-internal-list-folder-subr spec))
-
-(defun elmo-internal-list-folder-by-location (spec location &optional msgdb)
- (let* ((path (elmo-msgdb-expand-path spec))
- (location-alist
- (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load path)))
- (i 0)
- result pair
- location-max modified)
- (setq location-max
- (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
- (when location-max
- (while location
- (if (setq pair (rassoc (car location) location-alist))
- (setq result
- (append result
- (list (cons (car pair) (car location)))))
- (setq i (1+ i))
- (setq result (append result
- (list
- (cons (+ location-max i) (car location))))))
- (setq location (cdr location))))
- (setq result (sort result '(lambda (x y)
- (< (car x)(car y)))))
- (if (not (equal result location-alist))
- (setq modified t))
- (if modified
- (elmo-msgdb-location-save path result))
- (mapcar 'car result)))
-
-(defun elmo-internal-list-location (directive arg)
- (let ((mark-alist
- (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir)))))
- result)
- (mapcar (function (lambda (x)
- (setq result (cons (car x) result))))
- mark-alist)
- (nreverse result)))
-
-(defun elmo-internal-msgdb-create-entity (number loc-alist)
- (elmo-localdir-msgdb-create-overview-entity-from-file
- number
- (elmo-cache-get-path (cdr (assq number loc-alist)))))
-
-(defun elmo-internal-msgdb-create (spec numlist new-mark
- already-mark seen-mark
- important-mark
- seen-list
- &optional msgdb)
- (when numlist
- (let* ((directive (nth 1 spec))
- (arg (nth 2 spec))
- (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec))))
- (loc-list (elmo-internal-list-location directive arg))
- overview number-alist mark-alist entity
- i percent num location pair)
- (setq num (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-internal-msgdb-create-entity
- (car numlist) loc-alist))
- (if (null entity)
- ()
- (setq overview
- (elmo-msgdb-append-element
- overview entity))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- (elmo-msgdb-overview-entity-get-number
- entity)
- (elmo-msgdb-overview-entity-get-id
- entity)))
- (setq location (cdr (assq (car numlist) loc-alist)))
- (unless (memq location seen-list)
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
- (elmo-msgdb-overview-entity-get-number
- entity)
-;;; (nth 0 entity)
- (or (elmo-msgdb-global-mark-get
- (elmo-msgdb-overview-entity-get-id
- entity))
- (if (elmo-cache-exists-p
- (elmo-msgdb-overview-entity-get-id
- entity))
- already-mark
- new-mark))))))
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-internal-msgdb-create "Creating msgdb..."
- percent))
- (setq numlist (cdr numlist)))
- (message "Creating msgdb...done")
- (list overview number-alist mark-alist loc-alist))))
-
-(defalias 'elmo-internal-msgdb-create-as-numlist 'elmo-internal-msgdb-create)
-
-(defun elmo-internal-list-folders (spec &optional hierarchy)
- ;; XXX hard cording.
- (unless (nth 1 spec) ; toplevel.
- (list (list "'cache") "'mark")))
-
-(defvar elmo-internal-mark "$")
-
-(defun elmo-internal-append-msg (spec string &optional msg no-see)
- (elmo-set-work-buf
- (insert string)
- (let* ((msgid (elmo-field-body "message-id"))
- (path (elmo-cache-get-path msgid))
- dir)
- (when path
- (setq dir (directory-file-name (file-name-directory path)))
- (if (not (file-exists-p dir))
- (elmo-make-directory dir))
- (as-binary-output-file (write-region (point-min) (point-max)
- path nil 'no-msg)))
- (elmo-msgdb-global-mark-set msgid elmo-internal-mark))))
-
-(defun elmo-internal-delete-msgs (spec msgs &optional msgdb)
- (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec)))))
- (mapcar '(lambda (msg) (elmo-internal-delete-msg spec msg
- loc-alist))
- msgs)))
-
-(defun elmo-internal-delete-msg (spec number loc-alist)
- (let ((pair (assq number loc-alist)))
- (elmo-msgdb-global-mark-delete (cdr pair))))
-
-(defun elmo-internal-read-msg (spec number outbuf &optional msgdb)
- (save-excursion
- (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec))))
- (file (elmo-cache-get-path (cdr (assq number loc-alist)))))
- (set-buffer outbuf)
- (erase-buffer)
- (when (file-exists-p file)
- (as-binary-input-file (insert-file-contents file))
- (elmo-delete-cr-get-content-type)))))
-
-(defun elmo-internal-max-of-folder (spec)
- (elmo-internal-list-folder-subr spec t))
-
-(defun elmo-internal-check-validity (spec)
- nil)
-
-(defun elmo-internal-sync-validity (spec)
- nil)
-
-(defun elmo-internal-folder-exists-p (spec)
- t)
-
-(defun elmo-internal-folder-creatable-p (spec)
- nil)
-
-(defun elmo-internal-create-folder (spec)
- nil)
-
-(defun elmo-internal-search (spec condition &optional from-msgs msgdb)
- (let* ((msgs (or from-msgs (elmo-internal-list-folder spec)))
- (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec))))
- (number-list (mapcar 'car loc-alist))
- (i 0)
- (num (length msgs))
- cache-file
- matched
- case-fold-search)
- (setq num (length msgs))
- (while msgs
- (if (and (setq cache-file (elmo-cache-get-path (cdr (assq (car msgs)
- loc-alist))))
- (file-exists-p cache-file)
- (elmo-file-field-condition-match cache-file
- condition
- (car msgs)
- number-list))
- (setq matched (nconc matched (list (car msgs)))))
- (elmo-display-progress
- 'elmo-internal-search "Searching..."
- (/ (* (setq i (1+ i)) 100) num))
- (setq msgs (cdr msgs)))
- matched))
-
-(defun elmo-internal-use-cache-p (spec number)
- nil)
-
-(defun elmo-internal-local-file-p (spec number)
- nil ;; XXXX
- )
-
-(defalias 'elmo-internal-sync-number-alist 'elmo-generic-sync-number-alist)
-(defalias 'elmo-internal-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-internal-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-internal-commit 'elmo-generic-commit)
-(defalias 'elmo-internal-folder-diff 'elmo-generic-folder-diff)
+(require 'elmo)
+
+;;; ELMO internal folder
+(luna-define-class elmo-internal-folder (elmo-folder) ())
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-internal-folder)
+ name)
+ (elmo-internal-folder-initialize folder name))
+
+(defun elmo-internal-folder-initialize (folder name)
+ (cond ((string-match "^mark" name)
+ (require 'elmo-mark)
+ (elmo-folder-initialize
+ (luna-make-entity
+ 'elmo-mark-folder
+ :type 'mark
+ :prefix (elmo-folder-prefix-internal folder)
+ :name (elmo-folder-name-internal folder)
+ :persistent (elmo-folder-persistent-internal folder))
+ name))
+ ((string-match "^cache" name)
+ (require 'elmo-cache)
+ ;; XXX FIXME: elmo-cache-folder initialization
+ folder)
+ (t folder)))
+
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-internal-folder)
+ &optional one-level)
+ (list (list "'cache") "'mark"))
(require 'product)
(product-provide (provide 'elmo-internal) (require 'elmo-version))
;;; Code:
;;
+(eval-when-compile (require 'cl))
-(require 'emu)
-(require 'std11)
-
-(eval-when-compile
- (require 'elmo-cache))
(require 'elmo-msgdb)
+(require 'elmo)
+
+(defcustom elmo-localdir-folder-path "~/Mail"
+ "*Local mail directory (MH format) path."
+ :type 'directory
+ :group 'elmo)
+
+;;; ELMO Local directory folder
+(eval-and-compile
+ (luna-define-class elmo-localdir-folder (elmo-folder)
+ (dir-name directory))
+ (luna-define-internal-accessors 'elmo-localdir-folder))
+
+;;; elmo-localdir specific methods.
+(luna-define-generic elmo-localdir-folder-path (folder)
+ "Return local directory path of the FOLDER.")
+
+(luna-define-generic elmo-localdir-folder-name (folder name)
+ "Return directory NAME for FOLDER.")
+
+(luna-define-method elmo-localdir-folder-path ((folder elmo-localdir-folder))
+ elmo-localdir-folder-path)
+
+(luna-define-method elmo-localdir-folder-name ((folder elmo-localdir-folder)
+ name)
+ name)
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-localdir-folder)
+ name)
+ (elmo-localdir-folder-set-dir-name-internal folder name)
+ (if (file-name-absolute-p name)
+ (elmo-localdir-folder-set-directory-internal
+ folder
+ (expand-file-name name))
+ (elmo-localdir-folder-set-directory-internal
+ folder
+ (expand-file-name
+ (elmo-localdir-folder-name folder name)
+ (elmo-localdir-folder-path folder))))
+ folder)
+
+;; open, check, commit, and close are generic.
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-localdir-folder))
+ (file-directory-p (elmo-localdir-folder-directory-internal folder)))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-localdir-folder))
+ (expand-file-name
+ (elmo-replace-string-as-filename
+ (elmo-localdir-folder-dir-name-internal folder))
+ (expand-file-name ;;"localdir"
+ (symbol-name (elmo-folder-type-internal folder))
+ elmo-msgdb-dir)))
+
+(luna-define-method elmo-message-file-name ((folder
+ elmo-localdir-folder)
+ number)
+ (expand-file-name (int-to-string number)
+ (elmo-localdir-folder-directory-internal folder)))
+
+(luna-define-method elmo-folder-message-file-number-p ((folder
+ elmo-localdir-folder))
+ t)
+
+(luna-define-method elmo-folder-message-file-directory ((folder
+ elmo-localdir-folder))
+ (elmo-localdir-folder-directory-internal folder))
+
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-localdir-folder))
+ t)
-(defsubst elmo-localdir-get-folder-directory (spec)
- (if (file-name-absolute-p (nth 1 spec))
- (nth 1 spec) ; already full path.
- (expand-file-name (nth 1 spec)
- (cond ((eq (car spec) 'localnews)
- elmo-localnews-folder-path)
- (t
- elmo-localdir-folder-path)))))
-
-(defun elmo-localdir-msgdb-expand-path (spec)
- (let ((fld-name (nth 1 spec)))
- (expand-file-name fld-name
- (expand-file-name "localdir"
- elmo-msgdb-dir))))
-
-(defun elmo-localdir-number-to-filename (spec dir number &optional loc-alist)
- (expand-file-name (int-to-string number) dir))
-
-(if (boundp 'nemacs-version)
- (defsubst elmo-localdir-insert-header (file)
- "Insert the header of the article (Does not work on nemacs)."
- (as-binary-input-file
- (insert-file-contents file)))
- (defsubst elmo-localdir-insert-header (file)
- "Insert the header of the article."
- (let ((beg 0)
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- format-alist)
- (when (file-exists-p file)
- ;; Read until header separator is found.
- (while (and (eq elmo-localdir-header-chop-length
- (nth 1
- (as-binary-input-file
- (insert-file-contents
- file nil beg
- (incf beg elmo-localdir-header-chop-length)))))
- (prog1 (not (search-forward "\n\n" nil t))
- (goto-char (point-max)))))))))
-
-
-(defsubst elmo-localdir-msgdb-create-overview-entity-from-file (number file)
- (save-excursion
- (let ((tmp-buffer (get-buffer-create " *ELMO LocalDir Temp*"))
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook header-end
- (attrib (file-attributes file))
- ret-val size mtime)
- (set-buffer tmp-buffer)
- (erase-buffer)
- (if (not (file-exists-p file))
- ()
- (setq size (nth 7 attrib))
- (setq mtime (timezone-make-date-arpa-standard
- (current-time-string (nth 5 attrib)) (current-time-zone)))
- ;; insert header from file.
- (catch 'done
- (condition-case nil
- (elmo-localdir-insert-header file)
- (error (throw 'done nil)))
- (goto-char (point-min))
- (setq header-end
- (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
- (point)
- (point-max)))
- (narrow-to-region (point-min) header-end)
- (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
- (kill-buffer tmp-buffer))
- ret-val
- ))))
+(luna-define-method elmo-folder-message-make-temp-files ((folder
+ elmo-localdir-folder)
+ numbers
+ &optional
+ start-number)
+ (let ((temp-dir (elmo-folder-make-temp-dir folder))
+ (cur-number (if start-number 0)))
+ (dolist (number numbers)
+ (elmo-add-name-to-file
+ (expand-file-name
+ (int-to-string number)
+ (elmo-localdir-folder-directory-internal folder))
+ (expand-file-name
+ (int-to-string (if start-number (incf cur-number) number))
+ temp-dir)))
+ temp-dir))
(defun elmo-localdir-msgdb-create-entity (dir number)
- (elmo-localdir-msgdb-create-overview-entity-from-file
+ (elmo-msgdb-create-overview-entity-from-file
number (expand-file-name (int-to-string number) dir)))
-(defun elmo-localdir-msgdb-create-as-numlist (spec numlist new-mark
- already-mark seen-mark
- important-mark seen-list)
- (when numlist
- (let ((dir (elmo-localdir-get-folder-directory spec))
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
+ numbers
+ new-mark
+ already-mark
+ seen-mark
+ important-mark
+ seen-list)
+ (when numbers
+ (let ((dir (elmo-localdir-folder-directory-internal folder))
overview number-alist mark-alist entity message-id
num seen gmark
(i 0)
- (len (length numlist)))
+ (len (length numbers)))
(message "Creating msgdb...")
- (while numlist
+ (while numbers
(setq entity
(elmo-localdir-msgdb-create-entity
- dir (car numlist)))
+ dir (car numbers)))
(if (null entity)
()
(setq num (elmo-msgdb-overview-entity-get-number entity))
message-id))
(setq seen (member message-id seen-list))
(if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
- (if (elmo-cache-exists-p message-id) ; XXX
+ (if (elmo-file-cache-exists-p message-id) ; XXX
(if seen
nil
already-mark)
(when (> len elmo-display-progress-threshold)
(setq i (1+ i))
(elmo-display-progress
- 'elmo-localdir-msgdb-create-as-numlist "Creating msgdb..."
+ 'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..."
(/ (* i 100) len)))
- (setq numlist (cdr numlist)))
+ (setq numbers (cdr numbers)))
(message "Creating msgdb...done")
(list overview number-alist mark-alist))))
-(defalias 'elmo-localdir-msgdb-create 'elmo-localdir-msgdb-create-as-numlist)
-
-(defvar elmo-localdir-list-folders-spec-string "+")
-(defvar elmo-localdir-list-folders-filter-regexp "^\\(\\.\\.?\\|[0-9]+\\)$")
-
-(defun elmo-localdir-list-folders (spec &optional hierarchy)
- (let ((folder (concat elmo-localdir-list-folders-spec-string (nth 1 spec))))
- (elmo-localdir-list-folders-subr folder hierarchy)))
-
-(defun elmo-localdir-list-folders-subr (folder &optional hierarchy)
- (let ((case-fold-search t)
- (w32-get-true-file-link-count t) ; for Meadow
- folders curdir dirent relpath abspath attr
- subprefix subfolder)
- (condition-case ()
- (progn
- (setq curdir
- (expand-file-name (nth 1 (elmo-folder-get-spec folder))
- elmo-localdir-folder-path))
- (if (string-match "^[+=$.]$" folder) ; localdir, archive, localnews
- (setq subprefix folder)
- (setq subprefix (concat folder elmo-path-sep))
- ;; include parent
- (setq folders (list folder)))
- (setq dirent (directory-files curdir))
- (catch 'done
- (while dirent
- (setq relpath (car dirent))
- (setq dirent (cdr dirent))
- (setq abspath (expand-file-name relpath curdir))
- (and
- (not (string-match
- elmo-localdir-list-folders-filter-regexp
- relpath))
- (eq (nth 0 (setq attr (file-attributes abspath))) t)
- (if (eq hierarchy 'check)
- (throw 'done (nconc folders t))
- t)
- (setq subfolder (concat subprefix relpath))
- (setq folders (nconc folders
- (if (and hierarchy
- (if elmo-have-link-count
- (< 2 (nth 1 attr))
- (cdr
- (elmo-localdir-list-folders-subr
- subfolder 'check))))
- (list (list subfolder))
- (list subfolder))))
- (or
- hierarchy
- (and elmo-have-link-count (>= 2 (nth 1 attr)))
- (setq folders
- (nconc folders (cdr (elmo-localdir-list-folders-subr
- subfolder hierarchy))))))))
- folders)
- (file-error folders))))
-
-(defsubst elmo-localdir-list-folder-subr (spec &optional nonsort)
- (let* ((dir (elmo-localdir-get-folder-directory spec))
- (flist (mapcar 'string-to-int
- (directory-files dir nil "^[0-9]+$" t)))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- numbers)
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
+ &optional one-level)
+ (mapcar
+ (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
+ (elmo-list-subdirectories
+ (elmo-localdir-folder-path folder)
+ (or (elmo-localdir-folder-dir-name-internal folder) "")
+ one-level)))
+
+(defsubst elmo-localdir-list-subr (folder &optional nonsort)
+ (let ((flist (mapcar 'string-to-int
+ (directory-files
+ (elmo-localdir-folder-directory-internal folder)
+ nil "^[0-9]+$" t)))
+ (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
(if nonsort
(cons (or (elmo-max-of-list flist) 0)
(if killed
(- (length flist)
(elmo-msgdb-killed-list-length killed))
(length flist)))
- (setq numbers (sort flist '<))
- (elmo-living-messages numbers killed))))
-
-(defun elmo-localdir-append-msg (spec string &optional msg no-see)
- (let ((dir (elmo-localdir-get-folder-directory spec))
- (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
- (next-num (or msg
- (1+ (car (elmo-localdir-max-of-folder spec)))))
- filename)
- (save-excursion
- (set-buffer tmp-buffer)
- (erase-buffer)
- (setq filename (expand-file-name (int-to-string
- next-num)
- dir))
- (unwind-protect
- (if (file-writable-p filename)
- (progn
- (insert string)
- (as-binary-output-file
- (write-region (point-min) (point-max) filename nil 'no-msg))
- t)
- nil
- )
- (kill-buffer tmp-buffer)))))
-
-(defun elmo-localdir-delete-msg (spec number)
- (let (file
- (dir (elmo-localdir-get-folder-directory spec))
- (number (int-to-string number)))
- (setq file (expand-file-name number dir))
- (if (and (string-match "[0-9]+" number) ; for safety.
- (file-exists-p file)
- (file-writable-p file)
- (not (file-directory-p file)))
- (progn (delete-file file)
- t))))
-
-(defun elmo-localdir-read-msg (spec number outbuf &optional set-mark)
- (save-excursion
- (let* ((number (int-to-string number))
- (dir (elmo-localdir-get-folder-directory spec))
- (file (expand-file-name number dir)))
- (set-buffer outbuf)
- (erase-buffer)
- (when (file-exists-p file)
- (as-binary-input-file (insert-file-contents file))
- (elmo-delete-cr-get-content-type)))))
-
-(defun elmo-localdir-delete-msgs (spec msgs)
- (mapcar '(lambda (msg) (elmo-localdir-delete-msg spec msg))
- msgs))
-
-(defun elmo-localdir-list-folder (spec); called by elmo-localdir-search()
- (elmo-localdir-list-folder-subr spec))
-
-(defun elmo-localdir-max-of-folder (spec)
- (elmo-localdir-list-folder-subr spec t))
-
-(defun elmo-localdir-check-validity (spec validity-file)
- (let* ((dir (elmo-localdir-get-folder-directory spec))
- (cur-val (nth 5 (file-attributes dir)))
- (file-val (read
- (or (elmo-get-file-string validity-file)
- "nil"))))
- (cond
- ((or (null cur-val) (null file-val)) nil)
- ((> (car cur-val) (car file-val)) nil)
- ((= (car cur-val) (car file-val))
- (if (> (cadr cur-val) (cadr file-val)) nil t)) ; t if same
- (t t))))
-
-(defun elmo-localdir-sync-validity (spec validity-file)
- (save-excursion
- (let* ((dir (elmo-localdir-get-folder-directory spec))
- (tmp-buffer (get-buffer-create " *ELMO TMP*"))
- (number-file (expand-file-name elmo-msgdb-number-filename dir)))
- (set-buffer tmp-buffer)
- (erase-buffer)
- (prin1 (nth 5 (file-attributes dir)) tmp-buffer)
- (princ "\n" tmp-buffer)
- (if (file-writable-p validity-file)
- (write-region (point-min) (point-max)
- validity-file nil 'no-msg)
- (message (format "%s is not writable." number-file)))
- (kill-buffer tmp-buffer))))
-
-(defun elmo-localdir-folder-exists-p (spec)
- (file-directory-p (elmo-localdir-get-folder-directory spec)))
-
-(defun elmo-localdir-folder-creatable-p (spec)
+ (sort flist '<))))
+
+(luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
+ unread
+ &optional number)
+ (let ((filename (elmo-message-file-name
+ folder
+ (or number
+ (1+ (car (elmo-folder-status folder)))))))
+ (if (file-writable-p filename)
+ (write-region-as-binary
+ (point-min) (point-max) filename nil 'no-msg)
+ t)))
+
+(luna-define-method elmo-folder-append-messages :around ((folder elmo-localdir-folder)
+ src-folder numbers
+ unread-marks
+ &optional same-number)
+ (if (elmo-folder-message-file-p src-folder)
+ (let ((dir (elmo-localdir-folder-directory-internal folder))
+ (succeeds numbers)
+ (next-num (1+ (car (elmo-folder-status folder)))))
+ (while numbers
+ (elmo-copy-file
+ (elmo-message-file-name src-folder (car numbers))
+ (expand-file-name
+ (int-to-string
+ (if same-number (car numbers) next-num))
+ dir))
+ (if (and (setq numbers (cdr numbers))
+ (not same-number))
+ (setq next-num
+ (if (elmo-localdir-locked-p)
+ ;; MDA is running.
+ (1+ (car (elmo-folder-status folder)))
+ (1+ next-num)))))
+ succeeds)
+ (luna-call-next-method)))
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-localdir-folder)
+ numbers)
+ (dolist (number numbers)
+ (elmo-localdir-delete-message folder number))
t)
-(defun elmo-localdir-create-folder (spec)
- (save-excursion
- (let ((dir (elmo-localdir-get-folder-directory spec)))
- (if (file-directory-p dir)
- ()
- (if (file-exists-p dir)
- (error "Create folder failed")
- (elmo-make-directory dir))
- t
- ))))
-
-(defun elmo-localdir-delete-folder (spec)
- (let* ((dir (elmo-localdir-get-folder-directory spec)))
+(defun elmo-localdir-delete-message (folder number)
+ "Delete message in the FOLDER with NUMBER."
+ (let ((filename (elmo-message-file-name folder number)))
+ (when (and (string-match "[0-9]+" filename) ; for safety.
+ (file-exists-p filename)
+ (file-writable-p filename)
+ (not (file-directory-p filename)))
+ (delete-file filename)
+ t)))
+
+(luna-define-method elmo-message-fetch ((folder elmo-localdir-folder)
+ number strategy
+ &optional section outbuf unseen)
+ ;; strategy, section, unseen is ignored.
+ (if outbuf
+ (with-current-buffer outbuf
+ (erase-buffer)
+ (when (file-exists-p (elmo-message-file-name folder number))
+ (insert-file-contents-as-binary
+ (elmo-message-file-name folder number))
+ (elmo-delete-cr-buffer))
+ t)
+ (with-temp-buffer
+ (when (file-exists-p (elmo-message-file-name folder number))
+ (insert-file-contents-as-binary (elmo-message-file-name folder number))
+ (elmo-delete-cr-buffer))
+ (buffer-string))))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-localdir-folder))
+ (elmo-localdir-list-subr folder))
+
+(luna-define-method elmo-folder-status ((folder elmo-localdir-folder))
+ (elmo-localdir-list-subr folder t))
+
+(luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder))
+ t)
+
+(luna-define-method elmo-folder-create ((folder elmo-localdir-folder))
+ (let ((dir (elmo-localdir-folder-directory-internal folder)))
+ (if (file-directory-p dir)
+ ()
+ (if (file-exists-p dir)
+ (error "Create folder failed")
+ (elmo-make-directory dir))
+ t)))
+
+(luna-define-method elmo-folder-delete ((folder elmo-localdir-folder))
+ (let ((dir (elmo-localdir-folder-directory-internal folder)))
(if (not (file-directory-p dir))
(error "No such directory: %s" dir)
(elmo-delete-directory dir t)
t)))
-(defun elmo-localdir-rename-folder (old-spec new-spec)
- (let* ((old (elmo-localdir-get-folder-directory old-spec))
- (new (elmo-localdir-get-folder-directory new-spec))
+(luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder)
+ new-folder)
+ (let* ((old (elmo-localdir-folder-directory-internal folder))
+ (new (elmo-localdir-folder-directory-internal folder))
(new-dir (directory-file-name (file-name-directory new))))
(if (not (file-directory-p old))
(error "No such directory: %s" old)
(rename-file old new)
t))))
-(defsubst elmo-localdir-field-condition-match (spec condition
- number number-list)
+(defsubst elmo-localdir-field-condition-match (folder condition
+ number number-list)
(elmo-file-field-condition-match
(expand-file-name (int-to-string number)
- (elmo-localdir-get-folder-directory spec))
- condition
- number number-list))
+ (elmo-localdir-folder-directory-internal folder))
+ condition number number-list))
-(defun elmo-localdir-search (spec condition &optional from-msgs)
- (let* ((msgs (or from-msgs (elmo-localdir-list-folder spec)))
+(luna-define-method elmo-folder-search ((folder elmo-localdir-folder)
+ condition &optional numbers)
+ (let* ((msgs (or numbers (elmo-folder-list-messages folder)))
(num (length msgs))
(i 0)
number-list case-fold-search ret-val)
(setq number-list msgs)
(while msgs
- (if (elmo-localdir-field-condition-match spec condition
+ (if (elmo-localdir-field-condition-match folder condition
(car msgs) number-list)
(setq ret-val (cons (car msgs) ret-val)))
(when (> num elmo-display-progress-threshold)
(setq msgs (cdr msgs)))
(nreverse ret-val)))
-;;; (localdir, maildir, localnews) -> localdir
-(defun elmo-localdir-copy-msgs (dst-spec msgs src-spec
- &optional loc-alist same-number)
- (let ((dst-dir
- (elmo-localdir-get-folder-directory dst-spec))
- (next-num (1+ (car (elmo-localdir-max-of-folder dst-spec)))))
- (while msgs
- (elmo-copy-file
- ;; src file
- (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
- ;; dst file
- (expand-file-name (int-to-string
- (if same-number (car msgs) next-num))
- dst-dir))
- (if (and (setq msgs (cdr msgs))
- (not same-number))
- (setq next-num
- (if (and (eq (car dst-spec) 'localdir)
- (elmo-localdir-locked-p))
- ;; MDA is running.
- (1+ (car (elmo-localdir-max-of-folder dst-spec)))
- (1+ next-num)))))
- t))
-
-(defun elmo-localdir-pack-number (spec msgdb arg)
- (let ((dir (elmo-localdir-get-folder-directory spec))
- (onum-alist (elmo-msgdb-get-number-alist msgdb))
- (omark-alist (elmo-msgdb-get-mark-alist msgdb))
- (new-number 1) ; first ordinal position in localdir
- flist onum mark new-mark-alist total)
+(luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
+ (let* ((dir (elmo-localdir-folder-directory-internal folder))
+ (msgdb (elmo-folder-msgdb folder))
+ (onum-alist (elmo-msgdb-get-number-alist msgdb))
+ (omark-alist (elmo-msgdb-get-mark-alist (elmo-folder-msgdb msgdb)))
+ (new-number 1) ; first ordinal position in localdir
+ flist onum mark new-mark-alist total)
(setq flist
(if elmo-pack-number-check-strict
- (elmo-call-func spec "list-folder") ; allow localnews
+ (elmo-folder-list-messages folder) ; allow localnews
(mapcar 'car onum-alist)))
(setq total (length flist))
(while flist
(when (> total elmo-display-progress-threshold)
(elmo-display-progress
- 'elmo-localdir-pack-number "Packing..."
+ 'elmo-folder-pack-numbers "Packing..."
(/ (* new-number 100) total)))
(setq onum (car flist))
(when (not (eq onum new-number)) ; why \=() is wrong..
(setq new-number (1+ new-number))
(setq flist (cdr flist)))
(message "Packing...done")
- (list (elmo-msgdb-get-overview msgdb)
- onum-alist
- new-mark-alist
- (elmo-msgdb-get-location msgdb)
- ;; remake hash table
- (elmo-msgdb-make-overview-hashtb (elmo-msgdb-get-overview msgdb)))))
-
-(defun elmo-localdir-use-cache-p (spec number)
- nil)
-
-(defun elmo-localdir-local-file-p (spec number)
+ (elmo-folder-set-msgdb-internal
+ folder
+ (list (elmo-msgdb-get-overview msgdb)
+ onum-alist
+ new-mark-alist
+ ;; remake hash table
+ (elmo-msgdb-make-overview-hashtb
+ (elmo-msgdb-get-overview msgdb))))))
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
t)
-(defun elmo-localdir-get-msg-filename (spec number &optional loc-alist)
+(luna-define-method elmo-message-file-name ((folder elmo-localdir-folder)
+ number)
(expand-file-name
(int-to-string number)
- (elmo-localdir-get-folder-directory spec)))
+ (elmo-localdir-folder-directory-internal folder)))
(defun elmo-localdir-locked-p ()
(if elmo-localdir-lockfile-list
(throw 'found t))
(setq lock (cdr lock)))))))
-(defalias 'elmo-localdir-sync-number-alist
- 'elmo-generic-sync-number-alist)
-(defalias 'elmo-localdir-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-localdir-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-localdir-commit 'elmo-generic-commit)
-(defalias 'elmo-localdir-folder-diff 'elmo-generic-folder-diff)
-
(require 'product)
(product-provide (provide 'elmo-localdir) (require 'elmo-version))
;;; Code:
;;
(require 'elmo-localdir)
+(luna-define-class elmo-localnews-folder (elmo-localdir-folder) ())
-(defmacro elmo-localnews-as-newsdir (&rest body)
- (` (let ((elmo-localdir-folder-path elmo-localnews-folder-path))
- (,@ body))))
+(luna-define-method elmo-localdir-folder-path ((folder elmo-localnews-folder))
+ elmo-localnews-folder-path)
-(defun elmo-localnews-msgdb-create-as-numlist (spec numlist new-mark
- already-mark seen-mark
- important-mark seen-list)
- (when numlist
- (elmo-localnews-as-newsdir
- (elmo-localdir-msgdb-create-as-numlist spec numlist new-mark
- already-mark seen-mark
- important-mark seen-list))))
-
-(defalias 'elmo-localnews-msgdb-create 'elmo-localnews-msgdb-create-as-numlist)
-
-(defun elmo-localnews-list-folders (spec &optional hierarchy)
- (let ((folder (concat "=" (nth 1 spec))))
- (elmo-localnews-as-newsdir
- (elmo-localdir-list-folders-subr folder hierarchy))))
-
-(defun elmo-localnews-append-msg (spec string &optional msg no-see)
- (elmo-localnews-as-newsdir
- (elmo-localdir-append-msg spec string)))
-
-(defun elmo-localnews-delete-msgs (dir number)
- (elmo-localnews-as-newsdir
- (elmo-localdir-delete-msgs dir number)))
-
-(defun elmo-localnews-read-msg (spec number outbuf)
- (elmo-localnews-as-newsdir
- (elmo-localdir-read-msg spec number outbuf)))
-
-(defun elmo-localnews-list-folder (spec)
- (elmo-localnews-as-newsdir
- (elmo-localdir-list-folder-subr spec)))
-
-(defun elmo-localnews-max-of-folder (spec)
- (elmo-localnews-as-newsdir
- (elmo-localdir-list-folder-subr spec t)))
-
-(defun elmo-localnews-check-validity (spec validity-file)
- (elmo-localnews-as-newsdir
- (elmo-localdir-check-validity spec validity-file)))
-
-(defun elmo-localnews-sync-validity (spec validity-file)
- (elmo-localnews-as-newsdir
- (elmo-localdir-sync-validity spec validity-file)))
-
-(defun elmo-localnews-folder-exists-p (spec)
- (elmo-localnews-as-newsdir
- (elmo-localdir-folder-exists-p spec)))
-
-(defun elmo-localnews-folder-creatable-p (spec)
- t)
-
-(defun elmo-localnews-create-folder (spec)
- (elmo-localnews-as-newsdir
- (elmo-localdir-create-folder spec)))
-
-(defun elmo-localnews-delete-folder (spec)
- (elmo-localnews-as-newsdir
- (elmo-localdir-delete-folder spec)))
-
-(defun elmo-localnews-rename-folder (old-spec new-spec)
- (elmo-localnews-as-newsdir
- (elmo-localdir-rename-folder old-spec new-spec)))
-
-(defun elmo-localnews-search (spec condition &optional from-msgs)
- (elmo-localnews-as-newsdir
- (elmo-localdir-search spec condition from-msgs)))
-
-(defun elmo-localnews-copy-msgs (dst-spec msgs src-spec
- &optional loc-alist same-number)
- (elmo-localdir-copy-msgs
- dst-spec msgs src-spec loc-alist same-number))
-
-(defun elmo-localnews-pack-number (spec msgdb arg)
- (elmo-localnews-as-newsdir
- (elmo-localdir-pack-number spec msgdb arg)))
-
-(defun elmo-localnews-use-cache-p (spec number)
- nil)
-
-(defun elmo-localnews-local-file-p (spec number)
- t)
-
-(defun elmo-localnews-get-msg-filename (spec number &optional loc-alist)
- (elmo-localnews-as-newsdir
- (elmo-localdir-get-msg-filename spec number loc-alist)))
-
-(defalias 'elmo-localnews-sync-number-alist 'elmo-generic-sync-number-alist)
-(defalias 'elmo-localnews-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-localnews-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-localnews-commit 'elmo-generic-commit)
-(defalias 'elmo-localnews-folder-diff 'elmo-generic-folder-diff)
+(luna-define-method elmo-localdir-folder-name ((folder elmo-localnews-folder)
+ name)
+ (elmo-replace-in-string name "\\." "/"))
(require 'product)
(product-provide (provide 'elmo-localnews) (require 'elmo-version))
;;
(eval-when-compile (require 'cl))
+
(require 'elmo-util)
-(require 'elmo-localdir)
-
-(defvar elmo-maildir-sequence-number-internal 0
- "Sequence number for the pid part of unique filename.
-This variable should not be used in elsewhere.")
-
-(defsubst elmo-maildir-get-folder-directory (spec)
- (if (file-name-absolute-p (nth 1 spec))
- (nth 1 spec) ; already full path.
- (expand-file-name (nth 1 spec)
- elmo-maildir-folder-path)))
-
-(defun elmo-maildir-number-to-filename (dir number loc-alist)
- (let ((location (cdr (assq number loc-alist))))
- (and location (elmo-maildir-get-filename location dir))))
-
-(defun elmo-maildir-get-filename (location dir)
- "Get a filename that is corresponded to LOCATION in DIR."
- (expand-file-name
- (let ((file (file-name-completion (symbol-name location)
- (expand-file-name "cur" dir))))
- (if (eq file t) (symbol-name location) file))
- (expand-file-name "cur" dir)))
+(require 'elmo)
+(require 'elmo-map)
+
+;;; ELMO Maildir folder
+(eval-and-compile
+ (luna-define-class elmo-maildir-folder
+ (elmo-map-folder)
+ (directory unread-locations flagged-locations))
+ (luna-define-internal-accessors 'elmo-maildir-folder))
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-maildir-folder)
+ name)
+ (if (file-name-absolute-p name)
+ (elmo-maildir-folder-set-directory-internal
+ folder
+ (expand-file-name name))
+ (elmo-maildir-folder-set-directory-internal
+ folder
+ (expand-file-name
+ name
+ elmo-maildir-folder-path)))
+ folder)
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-maildir-folder))
+ (expand-file-name
+ (elmo-replace-string-as-filename
+ (elmo-maildir-folder-directory-internal folder))
+ (expand-file-name
+ "maildir"
+ elmo-msgdb-dir)))
+
+(defun elmo-maildir-message-file-name (folder location)
+ "Get a file name of the message from FOLDER which corresponded to
+LOCATION."
+ (let ((file (file-name-completion
+ location
+ (expand-file-name
+ "cur"
+ (elmo-maildir-folder-directory-internal folder)))))
+ (if file
+ (expand-file-name
+ (if (eq file t) location file)
+ (expand-file-name
+ "cur"
+ (elmo-maildir-folder-directory-internal folder))))))
(defsubst elmo-maildir-list-location (dir &optional child-dir)
(let* ((cur-dir (expand-file-name (or child-dir "cur") dir))
(cur (directory-files cur-dir
nil "^[^.].*$" t))
- seen-list seen sym list)
- (setq list
+ unread-locations flagged-locations seen flagged sym
+ locations)
+ (setq locations
(mapcar
(lambda (x)
(if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
(progn
(setq seen nil)
(save-match-data
- (if (string-match
- "S"
- (elmo-match-string 2 x))
- (setq seen t)))
- (setq sym (intern (elmo-match-string 1 x)))
- (if seen
- (setq seen-list (cons sym seen-list)))
+ (cond
+ ((string-match "S" (elmo-match-string 2 x))
+ (setq seen t))
+ ((string-match "F" (elmo-match-string 2 x))
+ (setq flagged t))))
+ (setq sym (elmo-match-string 1 x))
+ (unless seen (setq unread-locations
+ (cons sym unread-locations)))
+ (if flagged (setq flagged-locations
+ (cons sym flagged-locations)))
sym)
- (intern x)))
+ x))
cur))
- (cons list seen-list)))
-
-(defun elmo-maildir-msgdb-create-entity (dir number loc-alist)
- (elmo-localdir-msgdb-create-overview-entity-from-file
- number
- (elmo-maildir-number-to-filename dir number loc-alist)))
+ (list locations unread-locations flagged-locations)))
+
+(luna-define-method elmo-map-folder-list-message-locations
+ ((folder elmo-maildir-folder))
+ (elmo-maildir-update-current folder)
+ (let ((locs (elmo-maildir-list-location
+ (elmo-maildir-folder-directory-internal folder))))
+ ;; 0: locations, 1: unread-locations, 2: flagged-locations
+ (elmo-maildir-folder-set-unread-locations-internal folder (nth 1 locs))
+ (elmo-maildir-folder-set-flagged-locations-internal folder (nth 2 locs))
+ (nth 0 locs)))
+
+(luna-define-method elmo-map-folder-list-unreads
+ ((folder elmo-maildir-folder))
+ (elmo-maildir-folder-unread-locations-internal folder))
+
+(luna-define-method elmo-map-folder-list-importants
+ ((folder elmo-maildir-folder))
+ (elmo-maildir-folder-flagged-locations-internal folder))
+
+(luna-define-method elmo-folder-msgdb-create
+ ((folder elmo-maildir-folder)
+ numbers new-mark already-mark seen-mark important-mark seen-list)
+ (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
+ (flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
+ (len (length numbers))
+ (i 0)
+ overview number-alist mark-alist entity
+ location pair mark)
+ (message "Creating msgdb...")
+ (dolist
+ (number numbers)
+ (setq location (elmo-map-message-location folder number))
+ (setq entity
+ (elmo-msgdb-create-overview-entity-from-file
+ number
+ (elmo-maildir-message-file-name folder location)))
+ (when entity
+ (setq overview
+ (elmo-msgdb-append-element overview entity))
+ (setq number-alist
+ (elmo-msgdb-number-add number-alist
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ (elmo-msgdb-overview-entity-get-id
+ entity)))
+ (cond
+ ((member location unread-list)
+ (setq mark new-mark)) ; unread!
+ ((member location flagged-list)
+ (setq mark important-mark)))
+ (setq mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ (or (elmo-msgdb-global-mark-get
+ (elmo-msgdb-overview-entity-get-id
+ entity))
+ mark)))
+ (when (> len elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (elmo-display-progress
+ 'elmo-maildir-msgdb-create "Creating msgdb..."
+ (/ (* i 100) len)))))
+ (message "Creating msgdb...done")
+ (elmo-msgdb-sort-by-date
+ (list overview number-alist mark-alist))))
(defun elmo-maildir-cleanup-temporal (dir)
;; Delete files in the tmp dir which are not accessed
t ; full
"^[^.].*$" t))))
-(defun elmo-maildir-update-current (spec)
+(defun elmo-maildir-update-current (folder)
"Move all new msgs to cur in the maildir."
- (let* ((maildir (elmo-maildir-get-folder-directory spec))
+ (let* ((maildir (elmo-maildir-folder-directory-internal folder))
(news (directory-files (expand-file-name "new"
maildir)
nil
(char-list-to-string flaglist)))))
;; Rescue no info file in maildir.
(rename-file filename
- (concat filename ":2," (char-to-string mark)))))
+ (concat filename ":2," (char-to-string mark))))
+ t)
(defun elmo-maildir-delete-mark (filename mark)
"Mark the FILENAME file in the maildir. MARK is a character."
(if flaglist
(char-list-to-string flaglist))))))))
-(defsubst elmo-maildir-set-mark-msgs (spec mark msgs msgdb)
- (let ((dir (elmo-maildir-get-folder-directory spec))
- (locs (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
- file)
- (while msgs
- (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
- (elmo-maildir-set-mark file mark))
- (setq msgs (cdr msgs)))))
-
-(defsubst elmo-maildir-delete-mark-msgs (spec mark msgs msgdb)
- (let ((dir (elmo-maildir-get-folder-directory spec))
- (locs (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
- file)
- (while msgs
- (if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
- (elmo-maildir-delete-mark file mark))
- (setq msgs (cdr msgs)))))
-
-(defun elmo-maildir-mark-as-important (spec msgs &optional msgdb)
- (elmo-maildir-set-mark-msgs spec ?F msgs msgdb))
+(defsubst elmo-maildir-set-mark-msgs (folder locs mark)
+ (dolist (loc locs)
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder loc)
+ mark))
+ t)
+
+(defsubst elmo-maildir-delete-mark-msgs (folder locs mark)
+ (dolist (loc locs)
+ (elmo-maildir-delete-mark
+ (elmo-maildir-message-file-name folder loc)
+ mark))
+ t)
+
+(luna-define-method elmo-map-folder-mark-as-important ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-set-mark-msgs folder locs ?F))
-(defun elmo-maildir-unmark-important (spec msgs &optional msgdb)
- (elmo-maildir-delete-mark-msgs spec ?F msgs msgdb))
-
-(defun elmo-maildir-mark-as-read (spec msgs &optional msgdb)
- (elmo-maildir-set-mark-msgs spec ?S msgs msgdb))
-
-(defun elmo-maildir-mark-as-unread (spec msgs &optional msgdb)
- (elmo-maildir-delete-mark-msgs spec ?S msgs msgdb))
-
-(defun elmo-maildir-msgdb-create (spec numlist new-mark
- already-mark seen-mark
- important-mark
- seen-list
- &optional msgdb)
- (when numlist
- (let* ((dir (elmo-maildir-get-folder-directory spec))
- (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec))))
- (loc-seen (elmo-maildir-list-location dir))
- (loc-list (car loc-seen))
- (seen-list (cdr loc-seen))
- overview number-alist mark-alist entity
- i percent num location pair)
- (setq num (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-maildir-msgdb-create-entity
- dir (car numlist) loc-alist))
- (if (null entity)
- ()
- (setq overview
- (elmo-msgdb-append-element
- overview entity))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- (elmo-msgdb-overview-entity-get-number
- entity)
- (elmo-msgdb-overview-entity-get-id
- entity)))
- (setq location (cdr (assq (car numlist) loc-alist)))
- (unless (member location seen-list)
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
- (elmo-msgdb-overview-entity-get-number
- entity)
- (or (elmo-msgdb-global-mark-get
- (elmo-msgdb-overview-entity-get-id
- entity))
- new-mark)))))
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-maildir-msgdb-create "Creating msgdb..."
- percent))
- (setq numlist (cdr numlist)))
- (message "Creating msgdb...done")
- (elmo-msgdb-sort-by-date
- (list overview number-alist mark-alist loc-alist)))))
-
-(defalias 'elmo-maildir-msgdb-create-as-numlist 'elmo-maildir-msgdb-create)
-
-(defun elmo-maildir-list-folders (spec &optional hierarchy)
- (let ((elmo-localdir-folder-path elmo-maildir-folder-path)
- (elmo-localdir-list-folders-spec-string ".")
- (elmo-localdir-list-folders-filter-regexp
- "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$")
- elmo-have-link-count folders)
- (setq folders (elmo-localdir-list-folders spec hierarchy))
- (if (eq (length (nth 1 spec)) 0) ; top
- (setq folders (append
- (list (concat elmo-localdir-list-folders-spec-string
- (nth 1 spec)))
- folders)))
- (elmo-delete-if
- (function (lambda (folder)
- (not (or (listp folder) (elmo-folder-exists-p folder)))))
- folders)))
+(luna-define-method elmo-map-folder-unmark-important ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-delete-mark-msgs folder locs ?F))
+
+(luna-define-method elmo-map-folder-mark-as-read ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-set-mark-msgs folder locs ?S))
+
+(luna-define-method elmo-map-folder-unmark-read ((folder elmo-maildir-folder)
+ locs)
+ (elmo-maildir-delete-mark-msgs folder locs ?S))
+
+(luna-define-method elmo-folder-list-subfolders
+ ((folder elmo-maildir-folder) &optional one-level)
+ (let ((elmo-list-subdirectories-ignore-regexp
+ "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$"))
+ (append
+ (list (elmo-folder-name-internal folder))
+ (mapcar
+ (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
+ (elmo-list-subdirectories
+ (elmo-maildir-folder-directory-internal folder)
+ ""
+ one-level)))))
+
+(defvar elmo-maildir-sequence-number-internal 0)
(static-cond
((>= emacs-major-version 19)
basedir)))
filename))
-(defun elmo-maildir-append-msg (spec string &optional msg no-see)
- (let ((basedir (elmo-maildir-get-folder-directory spec))
- filename)
+(luna-define-method elmo-folder-append-buffer ((folder elmo-maildir-folder)
+ unread &optional number)
+ (let ((basedir (elmo-maildir-folder-directory-internal folder))
+ (src-buf (current-buffer))
+ dst-buf filename)
(condition-case nil
(with-temp-buffer
(setq filename (elmo-maildir-temporal-filename basedir))
- (insert string)
+ (setq dst-buf (current-buffer))
+ (with-current-buffer src-buf
+ (copy-to-buffer dst-buf (point-min) (point-max)))
(as-binary-output-file
(write-region (point-min) (point-max) filename nil 'no-msg))
;; add link from new.
;; If an error occured, return nil.
(error))))
-(defun elmo-maildir-delete-msg (spec number loc-alist)
- (let ((dir (elmo-maildir-get-folder-directory spec))
- file)
- (setq file (elmo-maildir-number-to-filename dir number loc-alist))
- (if (and (file-writable-p file)
- (not (file-directory-p file)))
- (progn (delete-file file)
- t))))
+(luna-define-method elmo-folder-message-file-p ((folder elmo-maildir-folder))
+ t)
-(defun elmo-maildir-read-msg (spec number outbuf &optional msgdb)
- (save-excursion
- (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec))))
- (dir (elmo-maildir-get-folder-directory spec))
- (file (elmo-maildir-number-to-filename dir number loc-alist)))
- (set-buffer outbuf)
- (erase-buffer)
- (when (file-exists-p file)
- (as-binary-input-file (insert-file-contents file))
- (elmo-delete-cr-get-content-type)))))
-
-(defun elmo-maildir-delete-msgs (spec msgs &optional msgdb)
- (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec)))))
- (mapcar '(lambda (msg) (elmo-maildir-delete-msg spec msg
- loc-alist))
- msgs)))
-
-(defsubst elmo-maildir-list-folder-subr (spec &optional nonsort)
- (let* ((dir (elmo-maildir-get-folder-directory spec))
- (flist (elmo-list-folder-by-location
- spec
- (car (elmo-maildir-list-location dir))))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- (news (car (elmo-maildir-list-location dir "new")))
- numbers)
- (if nonsort
- (cons (+ (or (elmo-max-of-list flist) 0) (length news))
- (+ (length news)
- (if killed
- (- (length flist)
- (elmo-msgdb-killed-list-length killed))
- (length flist))))
- (setq numbers (sort flist '<))
- (elmo-living-messages numbers killed))))
-
-(defun elmo-maildir-list-folder (spec)
- (elmo-maildir-update-current spec)
- (elmo-maildir-list-folder-subr spec))
-
-(defun elmo-maildir-max-of-folder (spec)
- (elmo-maildir-list-folder-subr spec t))
-
-(defalias 'elmo-maildir-check-validity 'elmo-localdir-check-validity)
-
-(defalias 'elmo-maildir-sync-validity 'elmo-localdir-sync-validity)
-
-(defun elmo-maildir-folder-exists-p (spec)
- (let ((basedir (elmo-maildir-get-folder-directory spec)))
+(luna-define-method elmo-message-file-name ((folder elmo-maildir-folder)
+ number)
+ (elmo-maildir-message-file-name
+ folder
+ (elmo-map-message-location folder number)))
+
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-maildir-folder))
+ t)
+
+(luna-define-method elmo-folder-message-make-temp-files ((folder
+ elmo-maildir-folder)
+ numbers
+ &optional
+ start-number)
+ (let ((temp-dir (elmo-folder-make-temp-dir folder))
+ (cur-number (if start-number 0)))
+ (dolist (number numbers)
+ (elmo-copy-file
+ (elmo-message-file-name folder number)
+ (expand-file-name
+ (int-to-string (if start-number (incf cur-number) number))
+ temp-dir)))
+ temp-dir))
+
+(luna-define-method elmo-folder-append-messages :around
+ ((folder elmo-maildir-folder)
+ src-folder numbers unread-marks &optional same-number)
+ (if (elmo-folder-message-file-p src-folder)
+ (let ((dir (elmo-maildir-folder-directory-internal folder))
+ (succeeds numbers)
+ filename)
+ (setq filename (elmo-maildir-temporal-filename dir))
+ (dolist (number numbers)
+ (elmo-copy-file
+ (elmo-message-file-name src-folder number)
+ filename)
+ (elmo-add-name-to-file
+ filename
+ (expand-file-name
+ (concat "new/" (file-name-nondirectory filename))
+ dir)))
+ succeeds)
+ (luna-call-next-method)))
+
+(luna-define-method elmo-map-folder-delete-messages
+ ((folder elmo-maildir-folder) locations)
+ (let (file)
+ (dolist (location locations)
+ (setq file (elmo-maildir-message-file-name folder location))
+ (if (and file
+ (file-writable-p file)
+ (not (file-directory-p file)))
+ (delete-file file)))))
+
+(luna-define-method elmo-map-message-fetch ((folder elmo-maildir-folder)
+ location strategy &optional
+ section outbuf unseen)
+ (let ((file (elmo-maildir-message-file-name folder location)))
+ (when (file-exists-p file)
+ (if outbuf
+ (with-current-buffer outbuf
+ (erase-buffer)
+ (insert-file-contents-as-binary file)
+ (elmo-delete-cr-buffer)
+ t)
+ (with-temp-buffer
+ (insert-file-contents-as-binary file)
+ (elmo-delete-cr-buffer)
+ (buffer-string))))))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-maildir-folder))
+ (let ((basedir (elmo-maildir-folder-directory-internal folder)))
(and (file-directory-p (expand-file-name "new" basedir))
(file-directory-p (expand-file-name "cur" basedir))
(file-directory-p (expand-file-name "tmp" basedir)))))
-(defun elmo-maildir-folder-creatable-p (spec)
+(luna-define-method elmo-folder-diff ((folder elmo-maildir-folder)
+ &optional numbers)
+ (let* ((dir (elmo-maildir-folder-directory-internal folder))
+ (new-len (length (car (elmo-maildir-list-location dir "new"))))
+ (cur-len (length (car (elmo-maildir-list-location dir "cur")))))
+ (cons new-len (+ new-len cur-len))))
+
+(luna-define-method elmo-folder-creatable-p ((folder elmo-maildir-folder))
t)
-(defun elmo-maildir-create-folder (spec)
- (let ((basedir (elmo-maildir-get-folder-directory spec)))
+(luna-define-method elmo-folder-create ((folder elmo-maildir-folder))
+ (let ((basedir (elmo-maildir-folder-directory-internal folder)))
(condition-case nil
(progn
- (mapcar (function (lambda (dir)
- (setq dir (expand-file-name dir basedir))
- (or (file-directory-p dir)
- (progn
- (elmo-make-directory dir)
- (set-file-modes dir 448)))))
- '("." "new" "cur" "tmp"))
+ (dolist (dir '("." "new" "cur" "tmp"))
+ (setq dir (expand-file-name dir basedir))
+ (or (file-directory-p dir)
+ (progn
+ (elmo-make-directory dir)
+ (set-file-modes dir 448))))
t)
(error))))
-(defun elmo-maildir-delete-folder (spec)
- (let ((basedir (elmo-maildir-get-folder-directory spec)))
+(luna-define-method elmo-folder-delete ((folder elmo-maildir-folder))
+ (let ((basedir (elmo-maildir-folder-directory-internal folder)))
(condition-case nil
(let ((tmp-files (directory-files
(expand-file-name "tmp" basedir)
t "[^.].*")))
;; Delete files in tmp.
- (and tmp-files (mapcar 'delete-file tmp-files))
- (mapcar
- (function
- (lambda (dir)
- (setq dir (expand-file-name dir basedir))
- (if (not (file-directory-p dir))
- (error nil)
- (elmo-delete-directory dir t))))
- '("new" "cur" "tmp" "."))
+ (dolist (file tmp-files)
+ (delete-file file))
+ (dolist (dir '("new" "cur" "tmp" "."))
+ (setq dir (expand-file-name dir basedir))
+ (if (not (file-directory-p dir))
+ (error nil)
+ (elmo-delete-directory dir t)))
t)
(error nil))))
-(defun elmo-maildir-search (spec condition &optional from-msgs msgdb)
+(luna-define-method elmo-folder-search ((folder elmo-maildir-folder)
+ condition &optional numbers)
(save-excursion
- (let* ((msgs (or from-msgs (elmo-maildir-list-folder spec)))
- (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- spec))))
- (dir (elmo-maildir-get-folder-directory spec))
+ (let* ((msgs (or numbers (elmo-folder-list-messages folder)))
(i 0)
- case-fold-search ret-val
+ case-fold-search matches
percent num
- (num (length msgs))
+ (len (length msgs))
number-list msg-num)
(setq number-list msgs)
- (while msgs
- (setq msg-num (car msgs))
+ (dolist (number numbers)
(if (elmo-file-field-condition-match
- (elmo-maildir-number-to-filename
- dir (car msgs) loc-alist)
- condition (car msgs) number-list)
- (setq ret-val (append ret-val (list msg-num))))
+ (elmo-message-file-name folder number)
+ condition number number-list)
+ (setq matches (cons number matches)))
(setq i (1+ i))
- (setq percent (/ (* i 100) num))
(elmo-display-progress
'elmo-maildir-search "Searching..."
- percent)
- (setq msgs (cdr msgs)))
- ret-val)))
-
-;;; (maildir) -> maildir
-(defun elmo-maildir-copy-msgs (dst-spec msgs src-spec
- &optional loc-alist same-number)
- (let (srcfile)
- (while msgs
- (setq srcfile
- (elmo-maildir-get-msg-filename src-spec (car msgs) loc-alist))
- (elmo-copy-file
- ;; src file
- srcfile
- ;; dst file
- (expand-file-name
- (file-name-nondirectory srcfile)
- (concat (elmo-maildir-get-folder-directory dst-spec) "/cur")))
- (setq msgs (cdr msgs))))
- t)
-
-(defun elmo-maildir-use-cache-p (spec number)
- nil)
-
-(defun elmo-maildir-local-file-p (spec number)
- t)
-
-(defun elmo-maildir-get-msg-filename (spec number &optional loc-alist)
- (elmo-maildir-number-to-filename
- (elmo-maildir-get-folder-directory spec)
- number (or loc-alist (elmo-msgdb-location-load
- (elmo-msgdb-expand-path
- spec)))))
-
-(defun elmo-maildir-pack-number (spec msgdb arg)
- (let ((old-number-alist (elmo-msgdb-get-number-alist msgdb))
- (old-overview (elmo-msgdb-get-overview msgdb))
- (old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (old-location (elmo-msgdb-get-location msgdb))
- old-number overview number-alist mark-alist location
- mark (number 1))
- (setq overview old-overview)
- (while old-overview
- (setq old-number
- (elmo-msgdb-overview-entity-get-number (car old-overview)))
- (elmo-msgdb-overview-entity-set-number (car old-overview) number)
- (setq number-alist
- (cons (cons number (cdr (assq old-number old-number-alist)))
- number-alist))
- (when (setq mark (cadr (assq old-number old-mark-alist)))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist number mark)))
- (setq location
- (cons (cons number (cdr (assq old-number old-location)))
- location))
- (setq number (1+ number))
- (setq old-overview (cdr old-overview)))
- ;; XXX Should consider when folder is not persistent.
- (elmo-msgdb-location-save (elmo-msgdb-expand-path spec) location)
- (list overview
- (nreverse number-alist)
- (nreverse mark-alist)
- (nreverse location)
- (elmo-msgdb-make-overview-hashtb overview))))
-
-(defalias 'elmo-maildir-sync-number-alist
- 'elmo-generic-sync-number-alist)
-(defalias 'elmo-maildir-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-maildir-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-maildir-commit 'elmo-generic-commit)
-(defalias 'elmo-maildir-folder-diff 'elmo-generic-folder-diff)
+ (/ (* i 100) len)))
+ (nreverse matches))))
(require 'product)
(product-provide (provide 'elmo-maildir) (require 'elmo-version))
--- /dev/null
+;;; elmo-map.el -- A ELMO folder class with message number mapping.
+
+;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;; Folders which do not have unique message numbers but unique message names
+;; should inherit this folder.
+
+;;; Code:
+;;
+(require 'elmo)
+(require 'elmo-msgdb)
+
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ ;; location-hash: location->number mapping
+ ;; number-hash: number->location mapping
+ (luna-define-class elmo-map-folder (elmo-folder)
+ (location-alist number-max location-hash))
+ (luna-define-internal-accessors 'elmo-map-folder))
+
+(defun elmo-map-folder-numbers-to-locations (folder numbers)
+ (let (locations pair)
+ (dolist (number numbers)
+ (if (setq pair (elmo-get-hash-val
+ (concat "#" (int-to-string number))
+ (elmo-map-folder-location-hash-internal folder)))
+ (setq locations (cons (cdr pair) locations))))
+ (nreverse locations)))
+
+(defun elmo-map-folder-locations-to-numbers (folder locations)
+ (let (numbers pair)
+ (dolist (location locations)
+ (if (setq pair (elmo-get-hash-val
+ location
+ (elmo-map-folder-location-hash-internal folder)))
+ (setq numbers (cons (car pair) numbers))))
+ (nreverse numbers)))
+
+(luna-define-generic elmo-map-folder-list-message-locations (folder)
+ "Return a location list of the FOLDER.")
+
+(luna-define-generic elmo-map-folder-unmark-important (folder locations)
+ "")
+
+(luna-define-generic elmo-map-folder-mark-as-important (folder locations)
+ "")
+
+(luna-define-generic elmo-map-folder-unmark-read (folder locations)
+ "")
+
+(luna-define-generic elmo-map-folder-mark-as-read (folder locations)
+ "")
+
+(luna-define-generic elmo-map-message-fetch (folder location
+ strategy
+ &optional
+ section
+ outbuf unseen)
+ "")
+
+(luna-define-generic elmo-map-folder-list-unreads (folder)
+ "")
+
+(luna-define-generic elmo-map-folder-list-importants (folder)
+ "")
+
+(luna-define-generic elmo-map-folder-delete-messages (folder locations)
+ "")
+
+(luna-define-method elmo-folder-status ((folder elmo-map-folder))
+ (elmo-folder-open-internal folder)
+ (prog1
+ (let ((numbers (mapcar
+ 'car
+ (elmo-map-folder-location-alist-internal folder))))
+ (cons (elmo-max-of-list numbers)
+ (length numbers)))
+ ;; No save.
+ (elmo-folder-close-internal folder)))
+
+(defun elmo-map-message-number (folder location)
+ "Return number of the message in the FOLDER with LOCATION."
+ (car (elmo-get-hash-val
+ location
+ (elmo-map-folder-location-hash-internal folder))))
+
+(defun elmo-map-message-location (folder number)
+ "Return location of the message in the FOLDER with NUMBER."
+ (cdr (elmo-get-hash-val
+ (concat "#" (int-to-string number))
+ (elmo-map-folder-location-hash-internal folder))))
+
+(luna-define-method elmo-folder-pack-number ((folder elmo-map-folder))
+ (let* ((msgdb (elmo-folder-msgdb-internal folder))
+ (old-number-alist (elmo-msgdb-get-number-alist msgdb))
+ (old-overview (elmo-msgdb-get-overview msgdb))
+ (old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ (old-location (elmo-map-folder-location-alist-internal folder))
+ old-number overview number-alist mark-alist location
+ mark (number 1))
+ (setq overview old-overview)
+ (while old-overview
+ (setq old-number
+ (elmo-msgdb-overview-entity-get-number (car old-overview)))
+ (elmo-msgdb-overview-entity-set-number (car old-overview) number)
+ (setq number-alist
+ (cons (cons number (cdr (assq old-number old-number-alist)))
+ number-alist))
+ (when (setq mark (cadr (assq old-number old-mark-alist)))
+ (setq mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist number mark)))
+ (setq location
+ (cons (cons number
+ (elmo-map-message-location folder old-number))
+ location))
+ (setq number (1+ number))
+ (setq old-overview (cdr old-overview)))
+ (elmo-map-folder-location-setup folder (nreverse location))
+ (elmo-folder-set-msgdb-internal
+ folder
+ (list overview
+ (nreverse number-alist)
+ (nreverse mark-alist)
+ (elmo-msgdb-make-overview-hashtb overview)))))
+
+(defun elmo-map-folder-location-setup (folder locations)
+ (elmo-map-folder-set-location-alist-internal
+ folder
+ locations)
+ (elmo-map-folder-set-location-hash-internal
+ folder (elmo-make-hash
+ (* 2 (length locations))))
+ (elmo-map-folder-set-number-max-internal folder 0)
+ ;; Set number-max and hashtables.
+ (dolist (location-cons locations)
+ (if (< (elmo-map-folder-number-max-internal folder)
+ (car location-cons))
+ (elmo-map-folder-set-number-max-internal folder (car location-cons)))
+ (elmo-set-hash-val (cdr location-cons)
+ location-cons
+ (elmo-map-folder-location-hash-internal folder))
+ (elmo-set-hash-val (concat "#" (int-to-string (car location-cons)))
+ location-cons
+ (elmo-map-folder-location-hash-internal folder))))
+
+(defun elmo-map-folder-update-locations (folder locations)
+ ;; A subroutine to make location-alist.
+ ;; location-alist is existing location-alist.
+ ;; locations is the newest locations.
+ (let* ((location-alist (elmo-map-folder-location-alist-internal folder))
+ (locations-in-db (mapcar 'cdr location-alist))
+ new-locs new-alist deleted-locs pair i)
+ (setq new-locs
+ (elmo-delete-if (function
+ (lambda (x) (member x locations-in-db)))
+ locations))
+ (setq deleted-locs
+ (elmo-delete-if (function
+ (lambda (x) (member x locations)))
+ locations-in-db))
+ (dolist (location deleted-locs)
+ (setq location-alist
+ (delq (setq pair
+ (elmo-get-hash-val
+ location
+ (elmo-map-folder-location-hash-internal
+ folder)))
+ location-alist))
+ (elmo-clear-hash-val (concat "#" (int-to-string (car pair)))
+ (elmo-map-folder-location-hash-internal
+ folder))
+ (elmo-clear-hash-val location
+ (elmo-map-folder-location-hash-internal
+ folder)))
+ (setq i (elmo-map-folder-number-max-internal folder))
+ (dolist (location new-locs)
+ (setq i (1+ i))
+ (elmo-map-folder-set-number-max-internal folder i)
+ (setq new-alist (cons (setq pair (cons i location)) new-alist))
+ (setq new-alist (nreverse new-alist))
+ (elmo-set-hash-val (concat "#" (int-to-string i))
+ pair
+ (elmo-map-folder-location-hash-internal
+ folder))
+ (elmo-set-hash-val location
+ pair
+ (elmo-map-folder-location-hash-internal
+ folder)))
+ (setq location-alist (nconc location-alist new-alist))
+ (elmo-map-folder-set-location-alist-internal folder location-alist)))
+
+(luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
+ (elmo-map-folder-location-setup
+ folder
+ (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))
+ (elmo-map-folder-update-locations
+ folder
+ (elmo-map-folder-list-message-locations folder)))
+
+(luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
+ (when (elmo-folder-persistent-p folder)
+ (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
+ (elmo-map-folder-location-alist-internal
+ folder))))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
+ (elmo-map-folder-set-location-alist-internal folder nil)
+ (elmo-map-folder-set-location-hash-internal folder nil))
+
+(luna-define-method elmo-folder-check ((folder elmo-map-folder))
+ (elmo-map-folder-update-locations
+ folder
+ (elmo-map-folder-list-message-locations folder)))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-map-folder))
+ (mapcar 'car (elmo-map-folder-location-alist-internal folder)))
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-map-folder)
+ numbers)
+ (elmo-map-folder-unmark-important
+ folder
+ (elmo-map-folder-numbers-to-locations folder numbers)))
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-map-folder)
+ numbers)
+ (elmo-map-folder-mark-as-important
+ folder
+ (elmo-map-folder-numbers-to-locations folder numbers)))
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-map-folder)
+ numbers)
+ (elmo-map-folder-unmark-read
+ folder
+ (elmo-map-folder-numbers-to-locations folder numbers)))
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-map-folder) numbers)
+ (elmo-map-folder-mark-as-read
+ folder
+ (elmo-map-folder-numbers-to-locations folder numbers)))
+
+(luna-define-method elmo-message-fetch ((folder elmo-map-folder) number
+ strategy section outbuf unread)
+ (elmo-map-message-fetch
+ folder
+ (elmo-map-message-location folder number)
+ strategy section outbuf unread))
+
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-map-folder) unread-marks)
+ (elmo-map-folder-locations-to-numbers
+ folder
+ (elmo-map-folder-list-unreads folder)))
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-map-folder) important-mark)
+ (elmo-map-folder-locations-to-numbers
+ folder
+ (elmo-map-folder-list-importants folder)))
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder)
+ numbers)
+ (elmo-map-folder-delete-messages
+ folder
+ (elmo-map-folder-numbers-to-locations folder numbers))
+ (dolist (number numbers)
+ (elmo-map-folder-set-location-alist-internal
+ folder
+ (delq (elmo-get-hash-val
+ (concat "#" (int-to-string number))
+ (elmo-map-folder-location-hash-internal
+ folder))
+ (elmo-map-folder-location-alist-internal folder))))
+ t) ; success
+
+
+(require 'product)
+(product-provide (provide 'elmo-map) (require 'elmo-version))
+
+;;; elmo-map.el ends here
--- /dev/null
+;;; elmo-mark.el -- Global mark folder for ELMO.
+
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+
+;;; Code:
+;;
+(require 'elmo)
+(require 'elmo-map)
+
+(defcustom elmo-mark-default-mark "$"
+ "*Default global-mark for mark-folder."
+ :type 'string
+ :group 'elmo)
+
+;;; ELMO mark folder
+(eval-and-compile
+ (luna-define-class elmo-mark-folder (elmo-map-folder) (mark))
+ (luna-define-internal-accessors 'elmo-mark-folder))
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-mark-folder)
+ name)
+ (elmo-mark-folder-set-mark-internal
+ folder
+ elmo-mark-default-mark)
+ folder)
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-mark-folder))
+ (expand-file-name "mark"
+ (expand-file-name "internal"
+ elmo-msgdb-dir)))
+
+(luna-define-method elmo-map-folder-list-message-locations
+ ((folder elmo-mark-folder))
+ (elmo-mark-folder-list-message-locations folder))
+
+(defun elmo-mark-folder-list-message-locations (folder)
+ (let (result)
+ (dolist (pair (or elmo-msgdb-global-mark-alist
+ (setq elmo-msgdb-global-mark-alist
+ (elmo-object-load
+ (expand-file-name
+ elmo-msgdb-global-mark-filename
+ elmo-msgdb-dir)))))
+ (if (string= (elmo-mark-folder-mark-internal folder)
+ (cdr pair))
+ (setq result (cons (car pair) result))))
+ (nreverse result)))
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-mark-folder))
+ t)
+
+(luna-define-method elmo-message-file-name ((folder elmo-mark-folder)
+ number)
+ (elmo-file-cache-get-path
+ (elmo-map-message-location folder number)))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-mark-folder)
+ numbers new-mark
+ already-mark seen-mark
+ important-mark
+ seen-list)
+ (elmo-mark-folder-msgdb-create folder numbers new-mark already-mark
+ seen-mark important-mark))
+
+(defun elmo-mark-folder-msgdb-create (folder numbers new-mark already-mark
+ seen-mark important-mark)
+ (let ((i 0)
+ (len (length numbers))
+ overview number-alist mark-alist entity message-id
+ num)
+ (message "Creating msgdb...")
+ (while numbers
+ (setq entity
+ (elmo-msgdb-create-overview-entity-from-file
+ (car numbers) (elmo-message-file-name folder (car numbers))))
+ (if (null entity)
+ ()
+ (setq num (elmo-msgdb-overview-entity-get-number entity))
+ (setq overview
+ (elmo-msgdb-append-element
+ overview entity))
+ (setq message-id (elmo-msgdb-overview-entity-get-id entity))
+ (setq number-alist
+ (elmo-msgdb-number-add number-alist
+ num
+ message-id))
+ (setq mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist
+ num (elmo-mark-folder-mark-internal folder))))
+ (when (> len elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (elmo-display-progress
+ 'elmo-mark-folder-msgdb-create "Creating msgdb..."
+ (/ (* i 100) len)))
+ (setq numbers (cdr numbers)))
+ (message "Creating msgdb...done")
+ (list overview number-alist mark-alist)))
+
+(luna-define-method elmo-folder-append-buffer ((folder elmo-mark-folder)
+ unread &optional number)
+ (let* ((msgid (elmo-field-body "message-id"))
+ (path (elmo-file-cache-get-path msgid))
+ dir)
+ (when path
+ (setq dir (directory-file-name (file-name-directory path)))
+ (if (not (file-exists-p dir))
+ (elmo-make-directory dir))
+ (as-binary-output-file (write-region (point-min) (point-max)
+ path nil 'no-msg)))
+ (elmo-msgdb-global-mark-set msgid
+ (elmo-mark-folder-mark-internal folder))))
+
+(luna-define-method elmo-map-folder-delete-messages ((folder elmo-mark-folder)
+ locations)
+ (dolist (location locations)
+ (elmo-msgdb-global-mark-delete location)))
+
+(luna-define-method elmo-map-message-fetch ((folder elmo-mark-folder)
+ location strategy &optional
+ section outbuf unseen)
+ (elmo-mark-folder-map-message-fetch folder location strategy
+ section outbuf unseen))
+
+(defun elmo-mark-folder-map-message-fetch (folder location strategy
+ section outbuf unseen)
+ (let ((file (elmo-file-cache-get-path location)))
+ (when (file-exists-p file)
+ (if outbuf
+ (with-current-buffer outbuf
+ (erase-buffer)
+ (insert-file-contents-as-binary file)
+ (elmo-delete-cr-buffer)
+ t)
+ (with-temp-buffer
+ (insert-file-contents-as-binary file)
+ (elmo-delete-cr-buffer)
+ (buffer-string))))))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-mark-folder))
+ t)
+
+(luna-define-method elmo-folder-search ((folder elmo-mark-folder)
+ condition &optional from-msgs)
+ (let* ((msgs (or from-msgs (elmo-folder-list-messages folder)))
+ (number-list msgs)
+ (i 0)
+ (num (length msgs))
+ file
+ matched
+ case-fold-search)
+ (setq num (length msgs))
+ (while msgs
+ (if (and (setq file (elmo-message-file-name folder (car msgs)))
+ (file-exists-p file)
+ (elmo-file-field-condition-match file
+ condition
+ (car msgs)
+ number-list))
+ (setq matched (nconc matched (list (car msgs)))))
+ (elmo-display-progress
+ 'elmo-internal-folder-search "Searching..."
+ (/ (* (setq i (1+ i)) 100) num))
+ (setq msgs (cdr msgs)))
+ matched))
+
+;;; To override elmo-map-folder methods.
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-mark-folder) unread-marks)
+ t)
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-mark-folder) important-mark)
+ t)
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-mark-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-mark-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-mark-folder) numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-mark-folder) numbers)
+ t)
+
+(require 'product)
+(product-provide (provide 'elmo-mark) (require 'elmo-version))
+
+;;; elmo-mark.el ends here
--- /dev/null
+;;; elmo-mime.el -- MIME module for ELMO.
+
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+
+;;; Code:
+;;
+(require 'elmo-vars)
+(require 'mmbuffer)
+(require 'mmimap)
+(require 'mime-view)
+
+(eval-and-compile
+ (luna-define-class mime-elmo-buffer-entity (mime-buffer-entity) ())
+ (luna-define-class mime-elmo-imap-entity (mime-imap-entity) ()))
+
+;; Provide backend
+(provide 'mmelmo-imap)
+(provide 'mmelmo-buffer)
+
+(defvar elmo-message-ignored-field-list mime-view-ignored-field-list)
+(defvar elmo-message-visible-field-list mime-view-visible-field-list)
+(defvar elmo-message-sorted-field-list nil)
+
+(defcustom elmo-mime-header-max-column fill-column
+ "*Header max column number. Default is `fill-colmn'.
+If a symbol of function is specified, the function is called and its return
+value is used."
+ :type '(choice (integer :tag "Column Number")
+ (function :tag "Function"))
+ :group 'elmo)
+
+(luna-define-method initialize-instance :after ((entity mime-elmo-buffer-entity)
+ &rest init-args)
+ entity)
+
+(luna-define-method initialize-instance :around ((entity mime-elmo-imap-entity)
+ &rest init-args)
+ (luna-call-next-method))
+
+;;; Insert sorted header.
+(defsubst elmo-mime-insert-header-from-buffer (buffer
+ start end
+ &optional invisible-fields
+ visible-fields
+ sort-fields)
+ (let ((the-buf (current-buffer))
+ (mode-obj (mime-find-field-presentation-method 'wide))
+ field-decoder
+ f-b p f-e field-name field field-body
+ vf-alist (sl sort-fields))
+ (save-excursion
+ (set-buffer buffer)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (re-search-forward std11-field-head-regexp nil t)
+ (setq f-b (match-beginning 0)
+ p (match-end 0)
+ field-name (buffer-substring f-b p)
+ f-e (std11-field-end))
+ (when (mime-visible-field-p field-name
+ visible-fields invisible-fields)
+ (setq field (intern
+ (capitalize (buffer-substring f-b (1- p))))
+ field-body (buffer-substring p f-e)
+ field-decoder (inline (mime-find-field-decoder-internal
+ field mode-obj)))
+ (setq vf-alist (append (list
+ (cons field-name
+ (list field-body field-decoder)))
+ vf-alist))))
+ (and vf-alist
+ (setq vf-alist
+ (sort vf-alist
+ (function (lambda (s d)
+ (let ((n 0) re
+ (sf (car s))
+ (df (car d)))
+ (catch 'done
+ (while (setq re (nth n sl))
+ (setq n (1+ n))
+ (and (string-match re sf)
+ (throw 'done t))
+ (and (string-match re df)
+ (throw 'done nil)))
+ t)))))))
+ (with-current-buffer the-buf
+ (while vf-alist
+ (let* ((vf (car vf-alist))
+ (field-name (car vf))
+ (field-body (car (cdr vf)))
+ (field-decoder (car (cdr (cdr vf)))))
+ (insert field-name)
+ (insert (if field-decoder
+ (funcall field-decoder field-body
+ (string-width field-name)
+ (if (functionp elmo-mime-header-max-column)
+ (funcall elmo-mime-header-max-column)
+ elmo-mime-header-max-column))
+ ;; Don't decode
+ field-body))
+ (insert "\n"))
+ (setq vf-alist (cdr vf-alist)))
+ (run-hooks 'mmelmo-header-inserted-hook))))))
+
+(luna-define-generic elmo-mime-insert-sorted-header (entity
+ &optional invisible-fields
+ visible-fields
+ sorted-fields)
+ "Insert sorted header fields of the ENTITY.")
+
+(luna-define-method elmo-mime-insert-sorted-header ((entity
+ mime-elmo-buffer-entity)
+ &optional invisible-fields
+ visible-fields
+ sorted-fields)
+ (elmo-mime-insert-header-from-buffer
+ (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity)
+ invisible-fields visible-fields sorted-fields))
+
+(luna-define-method elmo-mime-insert-sorted-header ((entity
+ mime-elmo-imap-entity)
+ &optional invisible-fields
+ visible-fields
+ sorted-fields)
+ (let ((the-buf (current-buffer))
+ buf p-min p-max)
+ (with-temp-buffer
+ (insert (mime-imap-entity-header-string entity))
+ (setq buf (current-buffer)
+ p-min (point-min)
+ p-max (point-max))
+ (set-buffer the-buf)
+ (elmo-mime-insert-header-from-buffer buf p-min p-max
+ invisible-fields visible-fields))))
+
+(luna-define-method mime-insert-text-content :around
+ ((entity mime-elmo-buffer-entity))
+ (luna-call-next-method)
+ (run-hooks 'elmo-message-text-content-inserted-hook))
+
+(luna-define-method mime-insert-text-content :around
+ ((entity mime-elmo-imap-entity))
+ (luna-call-next-method)
+ (run-hooks 'elmo-message-text-content-inserted-hook))
+
+(defun elmo-mime-insert-header (entity situation)
+ (elmo-mime-insert-sorted-header
+ entity
+ elmo-message-ignored-field-list
+ elmo-message-visible-field-list
+ elmo-message-sorted-field-list)
+ (run-hooks 'elmo-message-header-inserted-hook))
+
+(defun elmo-make-mime-message-location (folder number strategy rawbuf unseen)
+;; Return the MIME message location structure.
+;; FOLDER is the ELMO folder structure.
+;; NUMBER is the number of the message in the FOLDER.
+;; STRATEGY is the message fetching strategy.
+;; RAWBUF is the output buffer for original message.
+;; If second optional argument UNSEEN is non-nil, message is not marked
+;; as read.
+ (if (and strategy
+ (eq (elmo-fetch-strategy-entireness strategy) 'section))
+ (luna-make-entity
+ 'mime-elmo-imap-location
+ :folder folder
+ :number number
+ :rawbuf rawbuf
+ :strategy strategy)
+ (with-current-buffer rawbuf
+ (let (buffer-read-only)
+ (erase-buffer)
+ (if strategy
+ (elmo-message-fetch folder number strategy
+ nil (current-buffer)
+ unseen))))
+ rawbuf))
+
+(defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode
+ &optional ignore-cache)
+ "Display MIME message.
+A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
+VIEWBUF is a view buffer and RAWBUF is a raw buffer.
+ORIGINAL is the major mode of RAWBUF.
+If optional argument IGNORE-CACHE is specified, existing cache is ignored.
+Return non-nil if not entire message was fetched."
+ (let (mime-display-header-hook ; Do nothing.
+ entity strategy)
+ (setq entity (elmo-msgdb-overview-get-entity number
+ (elmo-folder-msgdb-internal
+ folder)))
+ (setq strategy (elmo-find-fetch-strategy folder entity
+ ignore-cache))
+ (mime-display-message
+ (mime-open-entity
+ (if (and strategy
+ (eq (elmo-fetch-strategy-entireness strategy) 'section))
+ 'elmo-imap
+ 'elmo-buffer)
+ (elmo-make-mime-message-location
+ folder number strategy rawbuf nil))
+ viewbuf nil nil original-mode)
+ (if strategy
+ (or (elmo-fetch-strategy-use-cache strategy)
+ (eq (elmo-fetch-strategy-entireness strategy)
+ 'section)))))
+
+(defun elmo-mime-display-as-is (folder number viewbuf rawbuf original-mode
+ &optional ignore-cache)
+ "Display MIME message.
+A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
+VIEWBUF is a view buffer and RAWBUF is a raw buffer.
+ORIGINAL is the major mode of RAWBUF.
+If optional argument IGNORE-CACHE is specified, existing cache is ignored.
+Return non-nil if cache is used."
+ (let ((entity (elmo-msgdb-overview-get-entity number
+ (elmo-folder-msgdb-internal
+ folder)))
+ mime-display-header-hook ; Do nothing.
+ cache-file strategy use-cache)
+ (setq cache-file (elmo-file-cache-get
+ (elmo-msgdb-overview-entity-get-id entity)))
+ (setq use-cache (eq (elmo-file-cache-status cache-file) 'entire))
+ (setq strategy (elmo-make-fetch-strategy
+ 'entire use-cache (elmo-message-use-cache-p folder number)
+ (elmo-file-cache-path
+ cache-file)))
+ (elmo-mime-display-as-is-internal
+ (mime-open-entity
+ 'elmo-buffer
+ (elmo-make-mime-message-location
+ folder number strategy rawbuf nil))
+ viewbuf nil nil original-mode)
+ (elmo-fetch-strategy-use-cache strategy)))
+
+;; Replacement of mime-display-message.
+(defun elmo-mime-display-as-is-internal (message
+ &optional preview-buffer
+ mother default-keymap-or-function
+ original-major-mode keymap)
+ (mime-maybe-hide-echo-buffer)
+ (let ((win-conf (current-window-configuration)))
+ (or preview-buffer
+ (setq preview-buffer
+ (concat "*Preview-" (mime-entity-name message) "*")))
+ (or original-major-mode
+ (setq original-major-mode major-mode))
+ (let ((inhibit-read-only t))
+ (set-buffer (get-buffer-create preview-buffer))
+ (widen)
+ (erase-buffer)
+ (if mother
+ (setq mime-mother-buffer mother))
+ (setq mime-preview-original-window-configuration win-conf)
+ (setq major-mode 'mime-view-mode)
+ (setq mode-name "MIME-View")
+
+ (mime-insert-entity message)
+ ;(insert (mime-entity-body message))
+ ;(insert (mime-entity-body message))
+
+ (decode-coding-region (point-min) (point-max) 'undecided)
+
+ (save-restriction
+ (std11-narrow-to-header)
+ (run-hooks 'elmo-message-header-inserted-hook))
+; (mime-display-entity message nil
+; `((entity-button . invisible)
+; (header . visible)
+; (major-mode . ,original-major-mode))
+; preview-buffer)
+
+ (use-local-map
+ (or keymap
+ (if default-keymap-or-function
+ (mime-view-define-keymap default-keymap-or-function)
+ mime-view-mode-default-map)))
+ (let ((point
+ (next-single-property-change (point-min) 'mime-view-entity)))
+ (if point
+ (goto-char point)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)))
+ (run-hooks 'mime-view-mode-hook)
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ preview-buffer)))
+
+(require 'product)
+(product-provide (provide 'elmo-mime) (require 'elmo-version))
+
+;; elmo-mime.el ends here
\ No newline at end of file
(require 'std11)
(require 'elmo-cache)
-(defun elmo-msgdb-expand-path (folder)
- "Expand msgdb path for FOLDER.
-FOLDER should be a sring of folder name or folder spec."
- (convert-standard-filename
- (let* ((spec (if (stringp folder)
- (elmo-folder-get-spec folder)
- folder))
- (type (car spec))
- fld)
- (cond
- ((eq type 'imap4)
- (setq fld (elmo-imap4-spec-mailbox spec))
- (if (string= "inbox" (downcase fld))
- (setq fld "inbox"))
- (if (eq (string-to-char fld) ?/)
- (setq fld (substring fld 1 (length fld))))
- (expand-file-name
- fld
- (expand-file-name (or (elmo-imap4-spec-username spec) "nobody")
- (expand-file-name (or
- (elmo-imap4-spec-hostname spec)
- "nowhere")
- (expand-file-name
- "imap"
- elmo-msgdb-dir)))))
- ((eq type 'nntp)
- (expand-file-name
- (elmo-nntp-spec-group spec)
- (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere")
- (expand-file-name "nntp"
- elmo-msgdb-dir))))
- ((eq type 'maildir)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "maildir"
- elmo-msgdb-dir)))
- ((eq type 'folder)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "folder"
- elmo-msgdb-dir)))
- ((eq type 'multi)
- (setq fld (concat "*" (mapconcat 'identity (cdr spec) ",")))
- (expand-file-name (elmo-safe-filename fld)
- (expand-file-name "multi"
- elmo-msgdb-dir)))
- ((eq type 'filter)
- (expand-file-name
- (elmo-replace-msgid-as-filename folder)
- (expand-file-name "filter"
- elmo-msgdb-dir)))
- ((eq type 'archive)
- (expand-file-name
- (directory-file-name
- (concat
- (elmo-replace-in-string
- (elmo-replace-in-string
- (elmo-replace-in-string
- (nth 1 spec)
- "/" "_")
- ":" "__")
- "~" "___")
- "/" (nth 3 spec)))
- (expand-file-name (concat (symbol-name type) "/"
- (symbol-name (nth 2 spec)))
- elmo-msgdb-dir)))
- ((eq type 'pop3)
- (expand-file-name
- (elmo-safe-filename (elmo-pop3-spec-username spec))
- (expand-file-name (elmo-pop3-spec-hostname spec)
- (expand-file-name
- "pop"
- elmo-msgdb-dir))))
- ((eq type 'localnews)
- (expand-file-name
- (elmo-replace-in-string (nth 1 spec) "/" ".")
- (expand-file-name "localnews"
- elmo-msgdb-dir)))
- ((eq type 'internal)
- (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec))
- (nth 2 spec)))
- (expand-file-name "internal"
- elmo-msgdb-dir)))
- ((eq type 'cache)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "internal/cache"
- elmo-msgdb-dir)))
- (t ; local dir or undefined type
- ;; absolute path
- (setq fld (nth 1 spec))
- (if (file-name-absolute-p fld)
- (setq fld (elmo-safe-filename fld)))
- (expand-file-name fld
- (expand-file-name (symbol-name type)
- elmo-msgdb-dir)))))))
-
(defsubst elmo-msgdb-append-element (list element)
(if list
;;; (append list (list element))
(cadr msgdb))
(defsubst elmo-msgdb-get-mark-alist (msgdb)
(caddr msgdb))
-(defsubst elmo-msgdb-get-location (msgdb)
- (cadddr msgdb))
+;(defsubst elmo-msgdb-get-location (msgdb)
+; (cadddr msgdb))
(defsubst elmo-msgdb-get-overviewht (msgdb)
- (nth 4 msgdb))
+ (nth 3 msgdb))
;;
;; number <-> Message-ID handling
elmo-msgdb-global-mark-filename
elmo-msgdb-dir)))))))
-;;
-;; number <-> location handling
-;;
-(defsubst elmo-msgdb-location-load (dir)
- (elmo-object-load
- (expand-file-name
- elmo-msgdb-location-filename
- dir)))
-
-(defsubst elmo-msgdb-location-add (alist number location)
- (let ((ret-val alist))
- (setq ret-val
- (elmo-msgdb-append-element ret-val (cons number location)))
- ret-val))
-
-(defsubst elmo-msgdb-location-save (dir alist)
- (elmo-object-save
- (expand-file-name
- elmo-msgdb-location-filename
- dir) alist))
-
-(defun elmo-list-folder-by-location (spec locations &optional msgdb)
- (let* ((path (elmo-msgdb-expand-path spec))
- (location-alist (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load path)))
- (locations-in-db (mapcar 'cdr location-alist))
- result new-locs new-alist deleted-locs i
- modified)
- (setq new-locs
- (elmo-delete-if (function
- (lambda (x) (member x locations-in-db)))
- locations))
- (setq deleted-locs
- (elmo-delete-if (function
- (lambda (x) (member x locations)))
- locations-in-db))
- (setq modified new-locs)
- (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
- (mapcar
- (function
- (lambda (x)
- (setq location-alist
- (delq (rassoc x location-alist) location-alist))))
- deleted-locs)
- (while new-locs
- (setq i (1+ i))
- (setq new-alist (cons (cons i (car new-locs)) new-alist))
- (setq new-locs (cdr new-locs)))
- (setq result (nconc location-alist new-alist))
- (setq result (sort result (lambda (x y) (< (car x)(car y)))))
- (if modified (elmo-msgdb-location-save path result))
- (mapcar 'car result)))
-
;;;
;; persistent mark handling
;; (for each folder)
(expand-file-name elmo-msgdb-mark-filename dir)
obj))
+(defun elmo-msgdb-change-mark (msgdb before after)
+ "Set the BEFORE marks to AFTER."
+ (let ((mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ entity)
+ (while mark-alist
+ (setq entity (car mark-alist))
+ (when (string= (cadr entity) before)
+ (setcar (cdr entity) after))
+ (setq mark-alist (cdr mark-alist)))))
+
(defsubst elmo-msgdb-seen-save (dir obj)
(elmo-object-save
(expand-file-name elmo-msgdb-seen-filename dir)
(elmo-msgdb-search-internal-primitive
(nth 2 condition) entity number-list)))))
-(defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
- "Delete MSGS from FOLDER in MSGDB.
+(defun elmo-msgdb-delete-msgs (folder msgs)
+ "Delete MSGS from msgdb for FOLDER.
content of MSGDB is changed."
(save-excursion
- (let* ((msg-list msgs)
- (dir (elmo-msgdb-expand-path folder))
- (overview (or (car msgdb)
- (elmo-msgdb-overview-load dir)))
- (number-alist (or (cadr msgdb)
- (elmo-msgdb-number-load dir)))
- (mark-alist (or (caddr msgdb)
- (elmo-msgdb-mark-load dir)))
- (loc-alist (or (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load dir)))
- (hashtb (or (elmo-msgdb-get-overviewht msgdb)
- (elmo-msgdb-make-overview-hashtb overview)))
- (newmsgdb (list overview number-alist mark-alist (nth 3 msgdb) hashtb))
- ov-entity message-id)
+ (let* ((msgdb (elmo-folder-msgdb-internal folder))
+ (overview (car msgdb))
+ (number-alist (cadr msgdb))
+ (mark-alist (caddr msgdb))
+ (hashtb (elmo-msgdb-get-overviewht msgdb))
+ (newmsgdb (list overview number-alist mark-alist hashtb))
+ ov-entity)
;; remove from current database.
- (while msg-list
- (setq message-id (cdr (assq (car msg-list) number-alist)))
- (if (and (not reserve-cache) message-id)
- (elmo-cache-delete message-id
- folder (car msg-list)))
+ (while msgs
+ ;(setq message-id (cdr (assq (car msg-list) number-alist)))
+ ;(if (and (not reserve-cache) message-id)
+ ; (elmo-cache-delete message-id))
;;; This is no good!!!!
;;; (setq overview (delete (assoc message-id overview) overview))
(setq overview
(delq
(setq ov-entity
- (elmo-msgdb-overview-get-entity (car msg-list) newmsgdb))
+ (elmo-msgdb-overview-get-entity (car msgs) newmsgdb))
overview))
(when (and elmo-use-overview-hashtb hashtb)
(elmo-msgdb-clear-overview-hashtb ov-entity hashtb))
(setq number-alist
- (delq (assq (car msg-list) number-alist) number-alist))
- (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
- (setq loc-alist (delq (assq (car msg-list) loc-alist) loc-alist))
- ;; XXX Should consider when folder is not persistent.
- ;; (elmo-msgdb-location-save dir loc-alist)
- (setq msg-list (cdr msg-list)))
+ (delq (assq (car msgs) number-alist) number-alist))
+ (setq mark-alist (delq (assq (car msgs) mark-alist) mark-alist))
+ (setq msgs (cdr msgs)))
+ (elmo-folder-set-message-modified-internal folder t)
(setcar msgdb overview)
(setcar (cdr msgdb) number-alist)
(setcar (cddr msgdb) mark-alist)
- (setcar (nthcdr 4 msgdb) hashtb))
+ (setcar (nthcdr 3 msgdb) hashtb))
t)) ;return value
(defsubst elmo-msgdb-set-overview (msgdb overview)
(elmo-number-set-append killed-list msg))
(defun elmo-msgdb-append-to-killed-list (folder msgs)
- (let ((dir (elmo-msgdb-expand-path folder)))
- (elmo-msgdb-killed-list-save
- dir
- (elmo-number-set-append-list
- (elmo-msgdb-killed-list-load dir)
- msgs))))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (elmo-number-set-append-list
+ (elmo-folder-killed-list-internal folder)
+ msgs)))
(defun elmo-msgdb-killed-list-length (killed-list)
(let ((killed killed-list)
elmo-msgdb-dir)
finfo elmo-mime-charset))
-(defun elmo-msgdb-flist-load (folder)
+(defun elmo-msgdb-flist-load (fname)
(let ((flist-file (expand-file-name
elmo-msgdb-flist-filename
- (elmo-msgdb-expand-path (list 'folder folder)))))
+ (expand-file-name
+ (elmo-safe-filename fname)
+ (expand-file-name "folder" elmo-msgdb-dir)))))
(elmo-object-load flist-file nil t)))
-(defun elmo-msgdb-flist-save (folder flist)
+(defun elmo-msgdb-flist-save (fname flist)
(let ((flist-file (expand-file-name
elmo-msgdb-flist-filename
- (elmo-msgdb-expand-path (list 'folder folder)))))
+ (expand-file-name
+ (elmo-safe-filename fname)
+ (expand-file-name "folder" elmo-msgdb-dir)))))
(elmo-object-save flist-file flist)))
(defun elmo-crosspost-alist-load ()
elmo-msgdb-dir)
alist))
+(defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb unread-marks seen-list)
+ ;; Add to seen list.
+ (let* ((number-alist (elmo-msgdb-get-number-alist msgdb))
+ (mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ ent)
+ (while msgs
+ (if (setq ent (assq (car msgs) mark-alist))
+ (unless (member (cadr ent) unread-marks) ;; not unread mark
+ (setq seen-list
+ (cons (cdr (assq (car msgs) number-alist)) seen-list)))
+ ;; no mark ... seen...
+ (setq seen-list
+ (cons (cdr (assq (car msgs) number-alist)) seen-list)))
+ (setq msgs (cdr msgs)))
+ seen-list))
+
+(defun elmo-msgdb-get-message-id-from-buffer ()
+ (or (elmo-field-body "message-id")
+ ;; no message-id, so put dummy msgid.
+ (concat (timezone-make-date-sortable
+ (elmo-field-body "date"))
+ (nth 1 (eword-extract-address-components
+ (or (elmo-field-body "from") "nobody"))))))
+
(defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
"Create overview entity from current buffer.
Header region is supposed to be narrowed."
message-id references from subject to cc date
extra field-body)
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq message-id (elmo-field-body "message-id"))
+ (setq message-id (elmo-msgdb-get-message-id-from-buffer))
(setq references
(or (elmo-msgdb-get-last-message-id
(elmo-field-body "in-reply-to"))
from subject date to cc
size extra))
)))
+
+(defun elmo-msgdb-copy-overview-entity (entity)
+ (cons (car entity)
+ (copy-sequence (cdr entity))))
+
+(static-if (boundp 'nemacs-version)
+ (defsubst elmo-localdir-insert-header (file)
+ "Insert the header of the article (Does not work on nemacs)."
+ (as-binary-input-file
+ (insert-file-contents file)))
+ (defsubst elmo-localdir-insert-header (file)
+ "Insert the header of the article."
+ (let ((beg 0)
+ insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook
+ format-alist)
+ (when (file-exists-p file)
+ ;; Read until header separator is found.
+ (while (and (eq elmo-localdir-header-chop-length
+ (nth 1
+ (insert-file-contents-as-binary
+ file nil beg
+ (incf beg elmo-localdir-header-chop-length)))))
+ (prog1 (not (search-forward "\n\n" nil t))
+ (goto-char (point-max))))))))
+
+(defsubst elmo-msgdb-create-overview-entity-from-file (number file)
+ (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook header-end
+ (attrib (file-attributes file))
+ ret-val size mtime)
+ (with-temp-buffer
+ (if (not (file-exists-p file))
+ ()
+ (setq size (nth 7 attrib))
+ (setq mtime (timezone-make-date-arpa-standard
+ (current-time-string (nth 5 attrib)) (current-time-zone)))
+ ;; insert header from file.
+ (catch 'done
+ (condition-case nil
+ (elmo-localdir-insert-header file)
+ (error (throw 'done nil)))
+ (goto-char (point-min))
+ (setq header-end
+ (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
+ (point)
+ (point-max)))
+ (narrow-to-region (point-min) header-end)
+ (elmo-msgdb-create-overview-from-buffer number size mtime))))))
(defun elmo-msgdb-overview-sort-by-date (overview)
(sort overview
(let ((overview (elmo-msgdb-get-overview msgdb)))
(setq overview (elmo-msgdb-overview-sort-by-date overview))
(message "Sorting...done")
- (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb))))
+ (list overview (nth 1 msgdb)(nth 2 msgdb))))
(defun elmo-msgdb-clear-overview-hashtb (entity hashtb)
(let (number)
(nconc (car msgdb) (car msgdb-append))
(nconc (cadr msgdb) (cadr msgdb-append))
(nconc (caddr msgdb) (caddr msgdb-append))
- (nconc (cadddr msgdb) (cadddr msgdb-append))
(and set-hash
- (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 4 msgdb)))))
+ (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 3 msgdb)))))
(defsubst elmo-msgdb-clear (&optional msgdb)
(if msgdb
(setcar msgdb nil)
(setcar (cdr msgdb) nil)
(setcar (cddr msgdb) nil)
- (setcar (cdddr msgdb) nil)
- (setcar (nthcdr 4 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
- (list nil nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
-
-(defun elmo-msgdb-delete-path (folder &optional spec)
- (let ((path (elmo-msgdb-expand-path (or spec folder))))
- (if (file-directory-p path)
- (elmo-delete-directory path t))))
-
-(defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec)
- (let* ((old (directory-file-name (elmo-msgdb-expand-path old-spec)))
- (new (directory-file-name (elmo-msgdb-expand-path new-spec)))
- (new-dir (directory-file-name (file-name-directory new))))
- (if (not (file-directory-p old))
- ()
- (if (file-exists-p new)
- (error "Already exists directory: %s" new)
- (if (not (file-exists-p new-dir))
- (elmo-make-directory new-dir))
- (rename-file old new)))))
-
-(defun elmo-generic-folder-diff (spec folder &optional number-list)
- (let ((cached-in-db-max (elmo-folder-get-info-max folder))
- (in-folder (elmo-call-func folder "max-of-folder"))
- (in-db t)
- unsync messages
- in-db-max)
- (if (or number-list (not cached-in-db-max))
- (let ((number-list (or number-list
- (mapcar 'car
- (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder))))))
- ;; No info-cache.
- (setq in-db (sort number-list '<))
- (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
- 0))
- (if (not number-list)
- (elmo-folder-set-info-hashtb folder in-db-max nil)))
- (setq in-db-max cached-in-db-max))
- (setq unsync (if (and in-db
- (car in-folder))
- (- (car in-folder) in-db-max)
- (if (and in-folder
- (null in-db))
- (cdr in-folder)
- (if (null (car in-folder))
- nil))))
- (setq messages (cdr in-folder))
- (if (and unsync messages (> unsync messages))
- (setq unsync messages))
- (cons (or unsync 0) (or messages 0))))
-
-(defun elmo-generic-list-folder-unread (spec number-alist mark-alist
- unread-marks)
- (delq nil
- (mapcar
- (function (lambda (x)
- (if (member (cadr (assq (car x) mark-alist)) unread-marks)
- (car x))))
- mark-alist)))
+ (setcar (nthcdr 3 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
+ (list nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
(defsubst elmo-folder-get-info (folder &optional hashtb)
(elmo-get-hash-val folder
info-alist)
(setq elmo-folder-info-hashtb hashtb)))
+(defsubst elmo-msgdb-location-load (dir)
+ (elmo-object-load
+ (expand-file-name
+ elmo-msgdb-location-filename
+ dir)))
+
+(defsubst elmo-msgdb-location-add (alist number location)
+ (let ((ret-val alist))
+ (setq ret-val
+ (elmo-msgdb-append-element ret-val (cons number location)))
+ ret-val))
+
+(defsubst elmo-msgdb-location-save (dir alist)
+ (elmo-object-save
+ (expand-file-name
+ elmo-msgdb-location-filename
+ dir) alist))
+
(require 'product)
(product-provide (provide 'elmo-msgdb) (require 'elmo-version))
;;; Code:
;;
-(require 'elmo-msgdb)
-(require 'elmo-vars)
-(require 'elmo2)
+(require 'elmo)
+(require 'luna)
+;;; ELMO Multi folder
+(eval-and-compile
+ (luna-define-class elmo-multi-folder (elmo-folder)
+ (children divide-number))
+ (luna-define-internal-accessors 'elmo-multi-folder))
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-multi-folder)
+ name)
+ (elmo-multi-folder-set-children-internal
+ folder
+ (mapcar 'elmo-make-folder (split-string name ",")))
+ (elmo-multi-folder-set-divide-number-internal
+ folder
+ elmo-multi-divide-number)
+ folder)
+
+(luna-define-method elmo-folder-open-internal ((folder elmo-multi-folder))
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-open-internal fld)))
+
+(luna-define-method elmo-folder-check ((folder elmo-multi-folder))
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-check fld)))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-multi-folder))
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-close-internal fld)))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-multi-folder))
+ (expand-file-name (elmo-replace-string-as-filename
+ (elmo-folder-name-internal folder))
+ (expand-file-name "multi"
+ elmo-msgdb-dir)))
+
+(luna-define-method elmo-folder-get-primitive-list ((folder elmo-multi-folder))
+ (elmo-flatten
+ (mapcar
+ 'elmo-folder-get-primitive-list
+ (elmo-multi-folder-children-internal folder))))
+
+(luna-define-method elmo-folder-contains-type ((folder elmo-multi-folder) type)
+ (let ((children (elmo-multi-folder-children-internal folder))
+ match)
+ (while children
+ (when (elmo-folder-contains-type (car children) type)
+ (setq match t)
+ (setq children nil))
+ (setq children (cdr children)))
+ match))
+
+(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder)
+ number)
+ (elmo-message-use-cache-p
+ (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
+ (elmo-multi-folder-children-internal folder))
+ (% number (elmo-multi-folder-divide-number-internal folder))))
+
+(luna-define-method elmo-message-folder ((folder elmo-multi-folder)
+ number)
+ (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
+ (elmo-multi-folder-children-internal folder)))
(defun elmo-multi-msgdb (msgdb base)
(list (mapcar (function
(+ base (car x))
(cdr x)))) (nth 2 msgdb))))
-(defun elmo-multi-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- (when numlist
- (let* ((flds (cdr spec))
- overview number-alist mark-alist entity
- one-list-list
- cur-number
- i percent num
- ret-val)
- (setq one-list-list (elmo-multi-get-intlist-list numlist))
- (setq cur-number 0)
- (while (< cur-number (length flds))
- (setq ret-val
- (elmo-msgdb-append
- ret-val
- (elmo-multi-msgdb
- (elmo-msgdb-create-as-numlist (nth cur-number flds)
- (nth cur-number one-list-list)
- new-mark already-mark
+(defun elmo-multi-split-numbers (folder numlist &optional as-is)
+ (let ((numbers (sort numlist '<))
+ (divider (elmo-multi-folder-divide-number-internal folder))
+ (cur-number 0)
+ one-list numbers-list)
+ (while numbers
+ (setq cur-number (+ cur-number 1))
+ (setq one-list nil)
+ (while (and numbers
+ (eq 0
+ (/ (- (car numbers)
+ (* divider cur-number))
+ divider)))
+ (setq one-list (nconc
+ one-list
+ (list
+ (if as-is
+ (car numbers)
+ (% (car numbers)
+ (* divider cur-number))))))
+ (setq numbers (cdr numbers)))
+ (setq numbers-list (nconc numbers-list (list one-list))))
+ numbers-list))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-multi-folder)
+ numbers new-mark already-mark
seen-mark important-mark
seen-list)
- (* elmo-multi-divide-number (1+ cur-number)))))
- (setq cur-number (1+ cur-number)))
- (elmo-msgdb-sort-by-date ret-val))))
-
-;; returns append-msgdb
-(defun elmo-multi-delete-crossposts (already-msgdb append-msgdb)
+ (let* ((folders (elmo-multi-folder-children-internal folder))
+ overview number-alist mark-alist entity
+ numbers-list
+ cur-number
+ i percent num
+ msgdb)
+ (setq numbers-list (elmo-multi-split-numbers folder numbers))
+ (setq cur-number 0)
+ (while (< cur-number (length folders))
+ (if (nth cur-number numbers-list)
+ (setq msgdb
+ (elmo-msgdb-append
+ msgdb
+ (elmo-multi-msgdb
+ (elmo-folder-msgdb-create (nth cur-number folders)
+ (nth cur-number numbers-list)
+ new-mark already-mark
+ seen-mark important-mark
+ seen-list)
+ (* (elmo-multi-folder-divide-number-internal folder)
+ (1+ cur-number))))))
+ (setq cur-number (1+ cur-number)))
+ (elmo-msgdb-sort-by-date msgdb)))
+
+(defsubst elmo-multi-folder-append-msgdb (folder append-msgdb)
(let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
- (dummy (copy-sequence (append
- number-alist
- (elmo-msgdb-get-number-alist already-msgdb))))
+ (all-alist (copy-sequence (append
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder))
+ number-alist)))
(cur number-alist)
to-be-deleted
- overview mark-alist
- same)
+ mark-alist same)
(while cur
- (setq dummy (delq (car cur) dummy))
- (if (setq same (rassoc (cdr (car cur)) dummy)) ;; same message id is remained
- (unless (= (/ (car (car cur)) elmo-multi-divide-number)
- (/ (car same) elmo-multi-divide-number))
+ (setq all-alist (delq (car cur) all-alist))
+ ;; same message id exists.
+ (if (setq same (rassoc (cdr (car cur)) all-alist))
+ (unless (= (/ (car (car cur))
+ (elmo-multi-folder-divide-number-internal folder))
+ (/ (car same)
+ (elmo-multi-folder-divide-number-internal folder)))
;; base is also same...delete it!
(setq to-be-deleted (append to-be-deleted (list (car cur))))))
(setq cur (cdr cur)))
- (setq overview (elmo-delete-if
- (function
- (lambda (x)
- (assq
- (elmo-msgdb-overview-entity-get-number x)
- to-be-deleted)))
- (elmo-msgdb-get-overview append-msgdb)))
(setq mark-alist (elmo-delete-if
(function
(lambda (x)
- (assq
- (car x) to-be-deleted)))
+ (assq (car x) to-be-deleted)))
(elmo-msgdb-get-mark-alist append-msgdb)))
- ;; keep number-alist untouched for folder diff!!
- (cons (and to-be-deleted (length to-be-deleted))
- (list overview number-alist mark-alist))))
-
-(defun elmo-multi-msgdb-create (spec numlist new-mark already-mark
- seen-mark important-mark seen-list)
- (when numlist
- (let* ((flds (cdr spec))
- overview number-alist mark-alist entity
- one-list-list
- cur-number
- i percent num
- ret-val)
- (setq one-list-list (elmo-multi-get-intlist-list numlist))
- (setq cur-number 0)
- (while (< cur-number (length flds))
- (setq ret-val
- (elmo-msgdb-append
- ret-val
- (elmo-multi-msgdb
- (elmo-msgdb-create (nth cur-number flds)
- (nth cur-number one-list-list)
- new-mark already-mark
- seen-mark important-mark
- seen-list)
- (* elmo-multi-divide-number (1+ cur-number)))))
- (setq cur-number (1+ cur-number)))
- (elmo-msgdb-sort-by-date ret-val))))
-
-(defun elmo-multi-list-folders (spec &optional hierarchy)
- ;; not implemented.
- nil)
-
-(defun elmo-multi-append-msg (spec string)
- (error "Cannot append messages to multi folder"))
-
-(defun elmo-multi-read-msg (spec number outbuf)
- (let* ((flds (cdr spec))
- (folder (nth (- (/ number elmo-multi-divide-number) 1) flds))
- (number (% number elmo-multi-divide-number)))
- (elmo-call-func folder "read-msg" number outbuf)))
-
-(defun elmo-multi-delete-msgs (spec msgs)
- (let ((flds (cdr spec))
+ (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
+ (elmo-folder-set-msgdb-internal folder
+ (elmo-msgdb-append
+ (elmo-folder-msgdb-internal folder)
+ append-msgdb t))
+ (length to-be-deleted)))
+
+(luna-define-method elmo-folder-append-msgdb ((folder elmo-multi-folder)
+ append-msgdb)
+ (elmo-multi-folder-append-msgdb folder append-msgdb))
+
+(defmacro elmo-multi-real-folder-number (folder number)
+ "Returns a cons cell of real FOLDER and NUMBER."
+ (` (cons (nth (-
+ (/ (, number)
+ (elmo-multi-folder-divide-number-internal (, folder)))
+ 1) (elmo-multi-folder-children-internal (, folder)))
+ (% (, number) (elmo-multi-folder-divide-number-internal
+ (, folder))))))
+
+(defsubst elmo-multi-find-fetch-strategy (folder entity ignore-cache)
+ (if entity
+ (let ((pair (elmo-multi-real-folder-number
+ folder
+ (elmo-msgdb-overview-entity-get-number entity)))
+ (new-entity (elmo-msgdb-copy-overview-entity entity)))
+ (setq new-entity
+ (elmo-msgdb-overview-entity-set-number new-entity (cdr pair)))
+ (elmo-find-fetch-strategy (car pair) new-entity ignore-cache))
+ (elmo-make-fetch-strategy 'entire)))
+
+(luna-define-method elmo-find-fetch-strategy
+ ((folder elmo-multi-folder)
+ entity &optional ignore-cache)
+ (elmo-multi-find-fetch-strategy folder entity ignore-cache))
+
+(luna-define-method elmo-message-fetch ((folder elmo-multi-folder)
+ number strategy
+ &optional section outbuf unseen)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-fetch (car pair) (cdr pair) strategy section outbuf unseen)))
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-multi-folder)
+ numbers)
+ (let ((flds (elmo-multi-folder-children-internal folder))
one-list-list
(cur-number 0))
- (setq one-list-list (elmo-multi-get-intlist-list msgs))
+ (setq one-list-list (elmo-multi-split-numbers folder numbers))
(while (< cur-number (length flds))
- (elmo-delete-msgs (nth cur-number flds)
- (nth cur-number one-list-list))
+ (elmo-folder-delete-messages (nth cur-number flds)
+ (nth cur-number one-list-list))
(setq cur-number (+ 1 cur-number)))
t))
-(defun elmo-multi-folder-diff (spec folder &optional number-list)
- (let ((flds (cdr spec))
- (num-alist-list
- (elmo-multi-split-number-alist
- (elmo-msgdb-number-load (elmo-msgdb-expand-path spec))))
+(luna-define-method elmo-folder-diff ((folder elmo-multi-folder)
+ &optional numbers)
+ (elmo-multi-folder-diff folder numbers))
+
+(defun elmo-multi-folder-diff (folder numbers)
+ (let ((flds (elmo-multi-folder-children-internal folder))
+ (numbers (mapcar 'car
+ (elmo-msgdb-number-load
+ (elmo-folder-msgdb-path folder))))
+ (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
(count 0)
(unsync 0)
(messages 0)
+ num-list
diffs)
+ (setq num-list
+ (elmo-multi-split-numbers folder
+ (elmo-uniq-list
+ (nconc
+ (elmo-number-set-to-number-list killed)
+ numbers))))
(while flds
(setq diffs (nconc diffs (list (elmo-folder-diff
(car flds)
- (mapcar 'car
- (nth count num-alist-list))))))
+ (car num-list)))))
(setq count (+ 1 count))
+ (setq num-list (cdr num-list))
(setq flds (cdr flds)))
(while diffs
(and (car (car diffs))
(setq unsync (+ unsync (car (car diffs)))))
(setq messages (+ messages (cdr (car diffs))))
(setq diffs (cdr diffs)))
- (elmo-folder-set-info-hashtb folder
- nil messages)
+ (elmo-folder-set-info-hashtb folder nil messages)
(cons unsync messages)))
-(defun elmo-multi-split-mark-alist (mark-alist)
+(defun elmo-multi-split-mark-alist (folder mark-alist)
(let ((cur-number 0)
(alist (sort (copy-sequence mark-alist)
(lambda (pair1 pair2)
(while (and alist
(eq 0
(/ (- (car (car alist))
- (* elmo-multi-divide-number cur-number))
- elmo-multi-divide-number)))
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number))
+ (elmo-multi-folder-divide-number-internal folder))))
(setq one-alist (nconc
one-alist
(list
(list (% (car (car alist))
- (* elmo-multi-divide-number cur-number))
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number))
(cadr (car alist))))))
(setq alist (cdr alist)))
(setq result (nconc result (list one-alist))))
result))
-(defun elmo-multi-split-number-alist (number-alist)
- (let ((alist (sort (copy-sequence number-alist)
- (lambda (pair1 pair2)
- (< (car pair1)(car pair2)))))
- (cur-number 0)
- one-alist split num)
- (while alist
- (setq cur-number (+ cur-number 1))
- (setq one-alist nil)
- (while (and alist
- (eq 0
- (/ (- (setq num (car (car alist)))
- (* elmo-multi-divide-number cur-number))
- elmo-multi-divide-number)))
- (setq one-alist (nconc
- one-alist
- (list
- (cons
- (% num (* elmo-multi-divide-number cur-number))
- (cdr (car alist))))))
- (setq alist (cdr alist)))
- (setq split (nconc split (list one-alist))))
- split))
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-multi-folder) unread-marks)
+ (elmo-multi-folder-list-unreads-internal folder unread-marks))
-(defun elmo-multi-list-folder-unread (spec number-alist mark-alist
- unread-marks)
- (let ((folders (cdr spec))
+(defun elmo-multi-folder-list-unreads-internal (folder unread-marks)
+ (let ((folders (elmo-multi-folder-children-internal folder))
+ (mark-alists (elmo-multi-split-mark-alist
+ folder
+ (elmo-msgdb-get-mark-alist
+ (elmo-folder-msgdb-internal folder))))
(cur-number 0)
- (split-mark-alist (elmo-multi-split-mark-alist mark-alist))
- (split-number-alist (elmo-multi-split-number-alist number-alist))
- unreads)
+ unreads
+ all-unreads)
(while folders
- (setq cur-number (+ cur-number 1)
- unreads (append
- unreads
- (mapcar
- (function
- (lambda (x)
- (+
- (* elmo-multi-divide-number cur-number) x)))
- (elmo-list-folder-unread (car folders)
- (car split-number-alist)
- (car split-mark-alist)
- unread-marks)))
- split-number-alist (cdr split-number-alist)
- split-mark-alist (cdr split-mark-alist)
+ (setq cur-number (+ cur-number 1))
+ (unless (listp (setq unreads
+ (elmo-folder-list-unreads-internal
+ (car folders) unread-marks)))
+ (setq unreads (delq nil
+ (mapcar
+ (lambda (x)
+ (if (member (cadr x) unread-marks)
+ (car x)))
+ (car mark-alists)))))
+ (setq all-unreads
+ (nconc all-unreads
+ (mapcar
+ (lambda (x)
+ (+ x
+ (* cur-number
+ (elmo-multi-folder-divide-number-internal
+ folder))))
+ unreads)))
+ (setq mark-alists (cdr mark-alists)
folders (cdr folders)))
- unreads))
-
-(defun elmo-multi-list-folder-important (spec number-alist)
- (let ((folders (cdr spec))
+ all-unreads))
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-multi-folder) important-mark)
+ (let ((folders (elmo-multi-folder-children-internal folder))
+ (mark-alists (elmo-multi-split-mark-alist
+ folder
+ (elmo-msgdb-get-mark-alist
+ (elmo-folder-msgdb-internal folder))))
(cur-number 0)
- (split-number-alist (elmo-multi-split-number-alist number-alist))
- importants)
+ importants
+ all-importants)
(while folders
- (setq cur-number (+ cur-number 1)
- importants (nconc
- importants
- (mapcar
- (function
- (lambda (x)
- (+ (* elmo-multi-divide-number cur-number) x)))
- (elmo-list-folder-important
- (car folders)
- (car split-number-alist))))
+ (setq cur-number (+ cur-number 1))
+ (unless (listp (setq importants
+ (elmo-folder-list-importants-internal
+ (car folders) important-mark)))
+ (setq importants (delq nil
+ (mapcar
+ (lambda (x)
+ (if (string= (cadr x) important-mark)
+ (car x)))
+ (car mark-alists)))))
+ (setq all-importants
+ (nconc all-importants
+ (mapcar
+ (lambda (x)
+ (+ x
+ (* cur-number
+ (elmo-multi-folder-divide-number-internal
+ folder))))
+ importants)))
+ (setq mark-alists (cdr mark-alists)
folders (cdr folders)))
- importants))
+ all-importants))
-(defun elmo-multi-list-folder (spec)
- (let* ((flds (cdr spec))
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-multi-folder))
+ (let* ((flds (elmo-multi-folder-children-internal folder))
(cur-number 0)
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
numbers)
(while flds
(setq cur-number (+ cur-number 1))
(function
(lambda (x)
(+
- (* elmo-multi-divide-number cur-number) x)))
- (elmo-list-folder (car flds)))))
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number) x)))
+ (elmo-folder-list-messages-internal (car flds)))))
(setq flds (cdr flds)))
- (elmo-living-messages numbers killed)))
+ numbers))
-(defun elmo-multi-folder-exists-p (spec)
- (let* ((flds (cdr spec)))
+(luna-define-method elmo-folder-exists-p ((folder elmo-multi-folder))
+ (let ((flds (elmo-multi-folder-children-internal folder)))
(catch 'exists
(while flds
(unless (elmo-folder-exists-p (car flds))
(setq flds (cdr flds)))
t)))
-(defun elmo-multi-folder-creatable-p (spec)
- (let* ((flds (cdr spec)))
+(luna-define-method elmo-folder-creatable-p ((folder elmo-multi-folder))
+ (let ((flds (elmo-multi-folder-children-internal folder)))
(catch 'creatable
(while flds
- (when (and (elmo-call-func (car flds) "folder-creatable-p")
+ (when (and (elmo-folder-creatable-p (car flds))
(not (elmo-folder-exists-p (car flds))))
- ;; If folder already exists, don't to `creatable'.
- ;; Because this function is called, when folder doesn't exists.
+ ;; If folder already exists, don't to `creatable'.
+ ;; Because this function is called, when folder doesn't exists.
(throw 'creatable t))
(setq flds (cdr flds)))
nil)))
-(defun elmo-multi-create-folder (spec)
- (let* ((flds (cdr spec)))
+(luna-define-method elmo-folder-create ((folder elmo-multi-folder))
+ (let ((flds (elmo-multi-folder-children-internal folder)))
(catch 'create
(while flds
(unless (or (elmo-folder-exists-p (car flds))
- (elmo-create-folder (car flds)))
+ (elmo-folder-create (car flds)))
(throw 'create nil))
(setq flds (cdr flds)))
t)))
-(defun elmo-multi-search (spec condition &optional numlist)
- (let* ((flds (cdr spec))
+(luna-define-method elmo-folder-search ((folder elmo-multi-folder)
+ condition &optional numlist)
+ (let* ((flds (elmo-multi-folder-children-internal folder))
(cur-number 0)
numlist-list cur-numlist ; for filtered search.
ret-val)
(if numlist
(setq numlist-list
- (elmo-multi-get-intlist-list numlist t)))
+ (elmo-multi-split-numbers folder numlist t)))
(while flds
(setq cur-number (+ cur-number 1))
(when numlist
(function
(lambda (x)
(+
- (* elmo-multi-divide-number cur-number) x)))
- (elmo-call-func
- (car flds) "search" condition)))))
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number) x)))
+ (elmo-folder-search
+ (car flds) condition)))))
(when numlist
(setq numlist-list (cdr numlist-list)))
(setq flds (cdr flds)))
ret-val))
-(defun elmo-multi-use-cache-p (spec number)
- (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
- (cdr spec))
- "use-cache-p"
- (% number elmo-multi-divide-number)))
-
-(defun elmo-multi-local-file-p (spec number)
- (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
- (cdr spec))
- "local-file-p"
- (% number elmo-multi-divide-number)))
-
-(defun elmo-multi-commit (spec)
- (mapcar 'elmo-commit (cdr spec)))
-
-(defun elmo-multi-plugged-p (spec)
- (let* ((flds (cdr spec)))
+(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder)
+ number)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-use-cache-p (car pair) (cdr pair))))
+
+(luna-define-method elmo-message-file-p ((folder elmo-multi-folder) number)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-file-p (car pair) (cdr pair))))
+
+(luna-define-method elmo-message-file-name ((folder elmo-multi-folder) number)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-file-name (car pair) (cdr pair))))
+
+(luna-define-method elmo-folder-plugged-p ((folder elmo-multi-folder))
+ (let ((flds (elmo-multi-folder-children-internal folder)))
(catch 'plugged
(while flds
(unless (elmo-folder-plugged-p (car flds))
(setq flds (cdr flds)))
t)))
-(defun elmo-multi-set-plugged (spec plugged add)
- (let* ((flds (cdr spec)))
- (while flds
- (elmo-folder-set-plugged (car flds) plugged add)
- (setq flds (cdr flds)))))
-
-(defun elmo-multi-get-msg-filename (spec number &optional loc-alist)
- (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
- (cdr spec))
- "get-msg-filename"
- (% number elmo-multi-divide-number)
- loc-alist))
-
-(defun elmo-multi-sync-number-alist (spec number-alist)
- (let ((folder-list (cdr spec))
- (number-alist-list
- (elmo-multi-split-number-alist number-alist))
- (multi-base 0)
- append-alist result-alist)
- (while folder-list
- (incf multi-base)
- (setq append-alist
- (elmo-call-func (nth (- multi-base 1) (cdr spec)) ;; folder name
- "sync-number-alist"
- (nth (- multi-base 1) number-alist-list)))
- (mapcar
- (function
- (lambda (x)
- (setcar x
- (+ (* elmo-multi-divide-number multi-base) (car x)))))
- append-alist)
- (setq result-alist (nconc result-alist append-alist))
- (setq folder-list (cdr folder-list)))
- result-alist))
+(luna-define-method elmo-folder-set-plugged ((folder elmo-multi-folder)
+ plugged add)
+ (let ((flds (elmo-multi-folder-children-internal folder)))
+ (dolist (fld flds)
+ (elmo-folder-set-plugged fld plugged add))))
+
+(defun elmo-multi-folder-numbers-list-assoc (folder folder-numbers)
+ (let (ent)
+ (while folder-numbers
+ (when (string= (elmo-folder-name-internal (car (car folder-numbers)))
+ (elmo-folder-name-internal folder))
+ (setq ent (car folder-numbers)
+ folder-numbers nil))
+ (setq folder-numbers (cdr folder-numbers)))
+ ent))
+
+(defun elmo-multi-make-folder-numbers-list (folder msgs)
+ (let ((msg-list msgs)
+ pair fld-list
+ ret-val)
+ (while msg-list
+ (when (and (numberp (car msg-list))
+ (> (car msg-list) 0))
+ (setq pair (elmo-multi-real-folder-number folder (car msg-list)))
+ (if (setq fld-list (elmo-multi-folder-numbers-list-assoc
+ (car pair)
+ ret-val))
+ (setcdr fld-list (cons (cdr pair) (cdr fld-list)))
+ (setq ret-val (cons (cons (car pair) (list (cdr pair))) ret-val))))
+ (setq msg-list (cdr msg-list)))
+ ret-val))
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-multi-folder)
+ numbers)
+ (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
+ (elmo-folder-mark-as-important (car folder-numbers)
+ (cdr folder-numbers)))
+ t)
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-multi-folder)
+ numbers)
+ (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
+ (elmo-folder-unmark-important (car folder-numbers)
+ (cdr folder-numbers)))
+ t)
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-multi-folder)
+ numbers)
+ (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
+ (elmo-folder-mark-as-read (car folder-numbers)
+ (cdr folder-numbers)))
+ t)
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-multi-folder)
+ numbers)
+ (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
+ (elmo-folder-unmark-read (car folder-numbers)
+ (cdr folder-numbers)))
+ t)
(require 'product)
(product-provide (provide 'elmo-multi) (require 'elmo-version))
;;; Commentary:
;;
-(require 'luna)
+(eval-when-compile (require 'cl))
+
(require 'elmo-util)
+(require 'elmo-dop)
(require 'elmo-vars)
+(require 'elmo)
+
+;;; Code:
+;;
+
+;;; ELMO net folder
+(eval-and-compile
+ (luna-define-class elmo-net-folder
+ (elmo-folder)
+ (user auth server port stream-type))
+ (luna-define-internal-accessors 'elmo-net-folder))
+;;; Session
(eval-and-compile
(autoload 'starttls-negotiate "starttls")
(autoload 'sasl-find-mechanism "sasl")
;;
(eval-and-compile
(luna-define-class elmo-network-session () (name
- host
+ server
port
user
auth
(elmo-network-session-name-internal session)
(elmo-network-session-user-internal session)
(elmo-network-session-auth-internal session)
- (elmo-network-session-host-internal session)
+ (elmo-network-session-server-internal session)
(elmo-network-session-port-internal session)))
(defvar elmo-network-session-cache nil)
(defvar elmo-network-session-name-prefix nil)
-(defsubst elmo-network-session-cache-key (name host port user auth stream-type)
- "Returns session cache key."
+(defsubst elmo-network-session-cache-key (name folder)
+ "Returns session cache key for NAME and FOLDER."
(format "%s:%s/%s@%s:%d%s"
(concat elmo-network-session-name-prefix name)
- user auth host port (or stream-type "")))
+ (elmo-net-folder-user-internal folder)
+ (elmo-net-folder-auth-internal folder)
+ (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-port-internal folder)
+ (or
+ (elmo-network-stream-type-spec-string
+ (elmo-net-folder-stream-type-internal folder)) "")))
(defun elmo-network-clear-session-cache ()
"Clear session cache."
(interactive)
- (mapcar (lambda (pair)
- (elmo-network-close-session (cdr pair)))
- elmo-network-session-cache)
+ (dolist (pair elmo-network-session-cache)
+ (elmo-network-close-session (cdr pair)))
(setq elmo-network-session-cache nil))
(defmacro elmo-network-session-buffer (session)
(` (process-buffer (elmo-network-session-process-internal
(, session)))))
-(defun elmo-network-get-session (class name host port user auth stream-type
- &optional if-exists)
+(defun elmo-network-get-session (class name folder &optional if-exists)
"Get network session from session cache or a new network session.
CLASS is the class name of the session.
NAME is the name of the process.
-HOST is the name of the server host.
-PORT is the port number of the service.
-USER is the user-id for the authenticate.
-AUTH is the authenticate method name (symbol).
-STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
+FOLDER is the ELMO folder structure.
Returns a `elmo-network-session' instance.
If optional argument IF-EXISTS is non-nil, it does not return session
if there is no session cache.
if making session failed, returns nil."
(let (pair session key)
- (if (not (elmo-plugged-p host port))
+ (if (not (elmo-plugged-p
+ (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-port-internal folder)))
(error "Unplugged"))
- (setq pair (assoc (setq key (elmo-network-session-cache-key
- name host port user auth stream-type))
+ (setq pair (assoc (setq key (elmo-network-session-cache-key name folder))
elmo-network-session-cache))
(when (and pair
(not (memq (process-status
(cdr pair) ; connection cache exists.
(unless if-exists
(setq session
- (elmo-network-open-session class name
- host port user auth stream-type))
+ (elmo-network-open-session
+ class
+ name
+ (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-user-internal folder)
+ (elmo-net-folder-auth-internal folder)
+ (elmo-net-folder-stream-type-internal folder)))
(setq elmo-network-session-cache
(cons (cons key session)
elmo-network-session-cache))
session))))
-(defun elmo-network-open-session (class name host port user auth
+(defun elmo-network-open-session (class name server port user auth
stream-type)
"Open an authenticated network session.
CLASS is the class name of the session.
NAME is the name of the process.
-HOST is the name of the server host.
+SERVER is the name of the server server.
PORT is the port number of the service.
USER is the user-id for the authenticate.
AUTH is the authenticate method name (symbol).
(let ((session
(luna-make-entity class
:name name
- :host host
+ :server server
:port port
:user user
:auth auth
(buffer (format " *%s session for %s@%s:%d%s"
(concat elmo-network-session-name-prefix name)
user
- host
+ server
port
(or (elmo-network-stream-type-spec-string stream-type)
"")))
session
(setq process (elmo-open-network-stream
(elmo-network-session-name-internal session)
- buffer host port stream-type)))
+ buffer server port stream-type)))
(when process
(elmo-network-initialize-session session)
(elmo-network-authenticate-session session)
(signal (car error)(cdr error))))
session))
-(defun elmo-open-network-stream (name buffer host service stream-type)
+(defun elmo-open-network-stream (name buffer server service stream-type)
(let ((auto-plugged (and elmo-auto-change-plugged
(> elmo-auto-change-plugged 0)))
process)
(setq process
(if stream-type
(funcall (elmo-network-stream-type-function stream-type)
- name buffer host service)
- (open-network-stream name buffer host service)))))
+ name buffer server service)
+ (open-network-stream name buffer server service)))))
(error
(when auto-plugged
- (elmo-set-plugged nil host service (current-time))
- (message "Auto plugged off at %s:%d" host service)
+ (elmo-set-plugged nil server service stream-type (current-time))
+ (message "Auto plugged off at %s:%d" server service)
(sit-for 1))
(signal (car err) (cdr err))))
(when process
(process-kill-without-query process)
(when auto-plugged
- (elmo-set-plugged t host service))
+ (elmo-set-plugged t server service stream-type))
process)))
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-net-folder)
+ name)
+ ;; user and auth should be set in subclass.
+ (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name)
+ (if (match-beginning 1)
+ (elmo-net-folder-set-server-internal
+ folder
+ (elmo-match-substring 1 name 1)))
+ (if (match-beginning 2)
+ (elmo-net-folder-set-port-internal
+ folder
+ (string-to-int (elmo-match-substring 2 name 1))))
+ (if (match-beginning 3)
+ (elmo-net-folder-set-stream-type-internal
+ folder
+ (assoc (elmo-match-string 3 name)
+ elmo-network-stream-type-alist)))
+ (substring name 0 (match-beginning 0))))
+
+(defun elmo-net-port-info (folder)
+ (list (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-port-internal folder)
+ (elmo-network-stream-type-symbol
+ (elmo-net-folder-stream-type-internal folder))))
+
+(defun elmo-net-port-label (folder)
+ (concat
+ (symbol-name (elmo-folder-type-internal folder))
+ (if (elmo-net-folder-stream-type-internal folder)
+ (concat "!" (symbol-name
+ (elmo-network-stream-type-symbol
+ (elmo-net-folder-stream-type-internal
+ folder)))))))
+
+(luna-define-method elmo-folder-plugged-p ((folder elmo-net-folder))
+ (apply 'elmo-plugged-p
+ (append (elmo-net-port-info folder)
+ (list nil (quote (elmo-net-port-label folder))))))
+
+(luna-define-method elmo-folder-set-plugged ((folder elmo-net-folder)
+ plugged &optional add)
+ (apply 'elmo-set-plugged plugged
+ (append (elmo-net-port-info folder)
+ (list nil nil (quote (elmo-net-port-label folder)) add))))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-net-folder))
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-exists-p-plugged)
+ t)) ; If unplugged, assume the folder exists.
+
+(luna-define-method elmo-folder-status ((folder elmo-net-folder))
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-status-plugged)
+ (elmo-folder-send folder 'elmo-folder-status-unplugged)))
+
+(luna-define-method elmo-folder-status-unplugged
+ ((folder elmo-net-folder))
+ (if elmo-enable-disconnected-operation
+ (progn
+ (elmo-dop-folder-status folder))
+ (error "Unplugged")))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-net-folder))
+ (elmo-net-folder-list-messages-internal folder))
+
+(defun elmo-net-folder-list-messages-internal (folder)
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-list-messages-plugged)
+ (elmo-folder-send folder 'elmo-folder-list-messages-unplugged)))
+
+(luna-define-method elmo-folder-list-messages-plugged
+ ((folder elmo-net-folder))
+ t)
+
+;; XXX
+;; Should consider offline append and removal.
+(luna-define-method elmo-folder-list-messages-unplugged
+ ((folder elmo-net-folder))
+ (if elmo-enable-disconnected-operation
+ t
+ (error "Unplugged")))
+
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-net-folder) unread-marks)
+ (if (and (elmo-folder-plugged-p folder)
+ (elmo-folder-use-flag-p folder))
+ (elmo-folder-send folder 'elmo-folder-list-unreads-plugged)
+ t))
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-net-folder) important-mark)
+ (if (and (elmo-folder-plugged-p folder)
+ (elmo-folder-use-flag-p folder))
+ (elmo-folder-send folder 'elmo-folder-list-importants-plugged)
+ t))
+
+(luna-define-method elmo-folder-list-unreads-plugged
+ ((folder elmo-net-folder))
+ t)
+
+(luna-define-method elmo-folder-list-importants-plugged
+ ((folder elmo-net-folder))
+ t)
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-net-folder)
+ numbers)
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers)
+ (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers)))
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-net-folder)
+ numbers)
+ (if (elmo-folder-use-flag-p folder)
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-unmark-important-plugged
+ numbers)
+ (elmo-folder-send folder
+ 'elmo-folder-unmark-important-unplugged numbers))
+ t))
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-net-folder)
+ numbers)
+ (if (elmo-folder-use-flag-p folder)
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-mark-as-important-plugged
+ numbers)
+ (elmo-folder-send folder 'elmo-folder-mark-as-important-unplugged
+ numbers))
+ t))
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-net-folder)
+ numbers)
+ (if (elmo-folder-use-flag-p folder)
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-unmark-read-plugged numbers)
+ (elmo-folder-send folder 'elmo-folder-unmark-read-unplugged numbers))
+ t))
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-net-folder)
+ numbers)
+ (if (elmo-folder-use-flag-p folder)
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-mark-as-read-plugged numbers)
+ (elmo-folder-send
+ folder 'elmo-folder-mark-as-read-unplugged numbers))
+ t))
+
+(luna-define-method elmo-message-fetch ((folder elmo-net-folder)
+ number strategy
+ &optional section
+ outbuf
+ unseen)
+ (if (elmo-folder-plugged-p folder)
+ (let ((cache-file (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ section)))
+ (if (and (elmo-fetch-strategy-use-cache strategy)
+ (file-exists-p cache-file))
+ (if outbuf
+ (with-current-buffer outbuf
+ (insert-file-contents-as-binary cache-file)
+ t)
+ (with-temp-buffer
+ (insert-file-contents-as-binary cache-file)
+ (buffer-string)))
+ (if outbuf
+ (with-current-buffer outbuf
+ (elmo-folder-send folder 'elmo-message-fetch-plugged
+ number strategy section
+ (current-buffer) unseen)
+ (elmo-delete-cr-buffer)
+ (when (elmo-fetch-strategy-save-cache strategy)
+ (elmo-file-cache-save
+ (elmo-fetch-strategy-cache-path strategy)
+ section))
+ t)
+ (with-temp-buffer
+ (elmo-folder-send folder 'elmo-message-fetch-plugged
+ number strategy section
+ (current-buffer) unseen)
+ (elmo-delete-cr-buffer)
+ (when (elmo-fetch-strategy-save-cache strategy)
+ (elmo-file-cache-save
+ (elmo-fetch-strategy-cache-path strategy)
+ section))
+ (buffer-string)))))
+ (elmo-folder-send folder 'elmo-message-fetch-unplugged
+ number strategy section outbuf unseen)))
+
+(luna-define-method elmo-message-fetch-unplugged
+ ((folder elmo-net-folder) number strategy &optional section outbuf unseen)
+ (if (elmo-fetch-strategy-use-cache strategy)
+ (if outbuf
+ (with-current-buffer outbuf
+ (insert-file-contents-as-binary
+ (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ section))
+ t)
+ (with-temp-buffer
+ (insert-file-contents-as-binary
+ (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ section))
+ (buffer-string)))
+ (error "Unplugged")))
+
+(luna-define-method elmo-folder-check ((folder elmo-net-folder))
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-check-plugged)))
+
+(luna-define-method elmo-folder-close :after ((folder elmo-net-folder))
+ (if (elmo-folder-plugged-p folder)
+ (elmo-folder-send folder 'elmo-folder-check-plugged)))
+
+(luna-define-method elmo-folder-diff :around ((folder elmo-net-folder)
+ &optional numbers)
+ (if (and (elmo-folder-use-flag-p folder)
+ (elmo-folder-plugged-p folder))
+ (elmo-folder-send folder 'elmo-folder-diff-plugged)
+ (luna-call-next-method)))
+
+(luna-define-method elmo-folder-local-p ((folder elmo-net-folder))
+ nil)
+
+(luna-define-method elmo-quit ((folder elmo-net-folder))
+ (elmo-network-clear-session-cache))
+
(require 'product)
(product-provide (provide 'elmo-net) (require 'elmo-version))
--- /dev/null
+;;; elmo-nmz.el -- Namazu interface for ELMO.
+
+;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+
+;;; Code:
+;;
+(require 'elmo)
+(require 'elmo-map)
+
+(defcustom elmo-nmz-default-index-path "~/Mail"
+ "*Default index path for namazu."
+ :type 'directory
+ :group 'elmo)
+
+(defcustom elmo-nmz-prog "namazu"
+ "*Program name of namazu."
+ :type 'string
+ :group 'elmo)
+
+(defcustom elmo-nmz-charset 'iso-2022-jp
+ "*Charset for namazu argument."
+ :type 'symbol
+ :group 'elmo)
+
+(defcustom elmo-nmz-args '("--all" "--list" "--early")
+ "*Argument list for namazu to list matched files."
+ :type '(repeat string)
+ :group 'elmo)
+
+;;; "namazu search"
+(eval-and-compile
+ (luna-define-class elmo-nmz-folder
+ (elmo-map-folder) (pattern index-path))
+ (luna-define-internal-accessors 'elmo-nmz-folder))
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-nmz-folder)
+ name)
+ (with-temp-buffer
+ (insert "[" name)
+ (goto-char (point-min))
+ (forward-sexp)
+ (elmo-nmz-folder-set-pattern-internal folder
+ (buffer-substring
+ (+ 1 (point-min))
+ (- (point) 1)))
+ (elmo-nmz-folder-set-index-path-internal folder
+ (buffer-substring (point)
+ (point-max)))
+ (if (eq (length (elmo-nmz-folder-index-path-internal folder)) 0)
+ (elmo-nmz-folder-set-index-path-internal folder
+ elmo-nmz-default-index-path))
+ folder))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-nmz-folder))
+ (expand-file-name
+ (elmo-replace-string-as-filename
+ (elmo-folder-name-internal folder))
+ (expand-file-name "nmz" elmo-msgdb-dir)))
+
+(defun elmo-nmz-msgdb-create-entity (folder number)
+ "Create msgdb entity for the message in the FOLDER with NUMBER."
+ (elmo-msgdb-create-overview-entity-from-file
+ number
+ (elmo-map-message-location folder number)))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-nmz-folder)
+ numlist new-mark
+ already-mark seen-mark
+ important-mark
+ seen-list)
+ (let* (overview number-alist mark-alist entity
+ i percent num pair)
+ (setq num (length numlist))
+ (setq i 0)
+ (message "Creating msgdb...")
+ (while numlist
+ (setq entity
+ (elmo-nmz-msgdb-create-entity
+ folder (car numlist)))
+ (when entity
+ (setq overview
+ (elmo-msgdb-append-element
+ overview entity))
+ (setq number-alist
+ (elmo-msgdb-number-add number-alist
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ (elmo-msgdb-overview-entity-get-id
+ entity)))
+ (setq mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ (or (elmo-msgdb-global-mark-get
+ (elmo-msgdb-overview-entity-get-id
+ entity))
+ new-mark))))
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-folder-msgdb-create "Creating msgdb..."
+ percent))
+ (setq numlist (cdr numlist)))
+ (message "Creating msgdb...done.")
+ (list overview number-alist mark-alist)))
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-nmz-folder))
+ t)
+
+(luna-define-method elmo-message-file-name ((folder elmo-nmz-folder)
+ number)
+ (elmo-map-message-location folder number))
+
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-nmz-folder))
+ t)
+
+(luna-define-method elmo-folder-diff ((folder elmo-nmz-folder)
+ &optional numbers)
+ (cons nil nil))
+
+(luna-define-method elmo-folder-message-make-temp-files ((folder
+ elmo-nmz-folder)
+ numbers
+ &optional
+ start-number)
+ (let ((temp-dir (elmo-folder-make-temp-dir folder))
+ (cur-number (if start-number 0)))
+ (dolist (number numbers)
+ (elmo-add-name-to-file
+ (elmo-message-file-name folder number)
+ (expand-file-name
+ (int-to-string (if start-number (incf cur-number) number))
+ temp-dir)))
+ temp-dir))
+
+(luna-define-method elmo-map-message-fetch ((folder elmo-nmz-folder)
+ location strategy &optional
+ section outbuf unseen)
+ (if outbuf
+ (with-current-buffer outbuf
+ (erase-buffer)
+ (when (file-exists-p location)
+ (insert-file-contents-as-binary location)
+ (elmo-delete-cr-buffer)
+ t))
+ (with-temp-buffer
+ (insert-file-contents-as-binary location)
+ (elmo-delete-cr-buffer)
+ (buffer-string))))
+
+(luna-define-method elmo-map-folder-list-message-locations
+ ((folder elmo-nmz-folder))
+ (let (bol locations)
+ (with-temp-buffer
+ (apply 'call-process elmo-nmz-prog nil t t
+ (append elmo-nmz-args
+ (list
+ (encode-mime-charset-string
+ (elmo-nmz-folder-pattern-internal folder)
+ elmo-nmz-charset)
+ (expand-file-name
+ (elmo-nmz-folder-index-path-internal folder)))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (beginning-of-line)
+ (setq bol (point))
+ (end-of-line)
+ (setq locations (cons (buffer-substring bol (point)) locations))
+ (forward-line 1))
+ locations)))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-nmz-folder))
+ t)
+
+(luna-define-method elmo-folder-search ((folder elmo-nmz-folder)
+ condition &optional from-msgs)
+ (let* ((msgs (or from-msgs (elmo-folder-list-messages folder)))
+ (orig msgs)
+ (i 0)
+ case-fold-search matches
+ percent num
+ (num (length msgs)))
+ (while msgs
+ (if (elmo-file-field-condition-match
+ (elmo-map-message-location folder (car msgs))
+ condition
+ (car msgs)
+ orig)
+ (setq matches (cons (car msgs) matches)))
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-nmz-search "Searching..."
+ percent)
+ (setq msgs (cdr msgs)))
+ matches))
+
+;;; To override elmo-map-folder methods.
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-nmz-folder) unread-marks)
+ t)
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-nmz-folder) important-mark)
+ t)
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-nmz-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-nmz-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-nmz-folder) numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-nmz-folder) numbers)
+ t)
+
+(require 'product)
+(product-provide (provide 'elmo-nmz) (require 'elmo-version))
+
+;;; elmo-nmz.el ends here
\ No newline at end of file
;;; Code:
;;
+(require 'elmo-vars)
+(require 'elmo-util)
+(require 'elmo-date)
(require 'elmo-msgdb)
-(eval-when-compile
- (require 'elmo-cache)
- (require 'elmo-util))
+(require 'elmo-cache)
+(require 'elmo)
(require 'elmo-net)
+;;; ELMO NNTP folder
+(eval-and-compile
+ (luna-define-class elmo-nntp-folder (elmo-net-folder)
+ (group))
+ (luna-define-internal-accessors 'elmo-nntp-folder))
+
+(luna-define-method elmo-folder-initialize :around ((folder
+ elmo-nntp-folder)
+ name)
+ (let ((elmo-network-stream-type-alist
+ (if elmo-nntp-stream-type-alist
+ (setq elmo-network-stream-type-alist
+ (append elmo-nntp-stream-type-alist
+ elmo-network-stream-type-alist))
+ elmo-network-stream-type-alist)))
+ (setq name (luna-call-next-method))
+ (when (string-match
+ "^\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?"
+ name)
+ (elmo-nntp-folder-set-group-internal
+ folder
+ (if (match-beginning 1)
+ (elmo-match-string 1 name)))
+ ;; Setup slots for elmo-net-folder
+ (elmo-net-folder-set-user-internal folder
+ (if (match-beginning 2)
+ (elmo-match-substring 2 folder 1)
+ elmo-default-nntp-user))
+ (unless (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-set-server-internal folder
+ elmo-default-nntp-server))
+ (unless (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-set-port-internal folder
+ elmo-default-nntp-port))
+ (unless (elmo-net-folder-stream-type-internal folder)
+ (elmo-net-folder-set-stream-type-internal
+ folder
+ elmo-default-nntp-stream-type))
+ folder)))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder))
+ (convert-standard-filename
+ (expand-file-name
+ (elmo-nntp-folder-group-internal folder)
+ (expand-file-name (or (elmo-net-folder-server-internal folder) "nowhere")
+ (expand-file-name "nntp"
+ elmo-msgdb-dir)))))
+
+;;; NNTP Session
(eval-and-compile
(luna-define-class elmo-nntp-session (elmo-network-session)
(current-group))
(list-active . 2)))
(defmacro elmo-nntp-get-server-command (session)
- (` (assoc (cons (elmo-network-session-host-internal (, session))
+ (` (assoc (cons (elmo-network-session-server-internal (, session))
(elmo-network-session-port-internal (, session)))
elmo-nntp-server-command-alist)))
(nconc elmo-nntp-server-command-alist
(list (cons
(cons
- (elmo-network-session-host-internal (, session))
+ (elmo-network-session-server-internal (, session))
(elmo-network-session-port-internal (, session)))
(setq entry
(vector
elmo-default-nntp-stream-type)
(elmo-network-stream-type-spec-string type))))
-(defun elmo-nntp-get-session (spec &optional if-exists)
+(defun elmo-nntp-get-session (folder &optional if-exists)
(elmo-network-get-session
'elmo-nntp-session
"NNTP"
- (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-port spec)
- (elmo-nntp-spec-username spec)
- nil ; auth type
- (elmo-nntp-spec-stream-type spec)
+ folder
if-exists))
(luna-define-method elmo-network-initialize-session ((session
(with-current-buffer outbuf
(erase-buffer)
(insert-buffer-substring (elmo-network-session-buffer session)
- start (- end 3))
- (elmo-delete-cr-get-content-type)))))
+ start (- end 3))))))
(defun elmo-nntp-select-group (session group &optional force)
(let (response)
msgdb
(nconc number-alist (list (cons max-number nil)))))))
-(defun elmo-nntp-list-folders (spec &optional hierarchy)
- (let ((session (elmo-nntp-get-session spec))
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-nntp-folder)
+ &optional one-level)
+ (elmo-nntp-folder-list-subfolders folder one-level))
+
+(defun elmo-nntp-folder-list-subfolders (folder one-level)
+ (let ((session (elmo-nntp-get-session folder))
response ret-val top-ng append-serv use-list-active start)
(with-temp-buffer
- (if (and (elmo-nntp-spec-group spec)
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec)))
+ (if (and (elmo-nntp-folder-group-internal folder)
+ (elmo-nntp-select-group
+ session
+ (elmo-nntp-folder-group-internal folder)))
;; add top newsgroups
- (setq ret-val (list (elmo-nntp-spec-group spec))))
+ (setq ret-val (list (elmo-nntp-folder-group-internal folder))))
(unless (setq response (elmo-nntp-list-folders-get-cache
- (elmo-nntp-spec-group spec)(current-buffer)))
+ (elmo-nntp-folder-group-internal folder)
+ (current-buffer)))
(when (setq use-list-active (elmo-nntp-list-active-p session))
(elmo-nntp-send-command
session
(concat "list"
- (if (and (elmo-nntp-spec-group spec)
- (null (string= (elmo-nntp-spec-group spec) "")))
+ (if (and (elmo-nntp-folder-group-internal folder)
+ (null (string= (elmo-nntp-folder-group-internal
+ folder) "")))
(concat " active"
- (format " %s.*" (elmo-nntp-spec-group spec)
+ (format " %s.*"
+ (elmo-nntp-folder-group-internal folder)
"")))))
(if (elmo-nntp-read-response session t)
(if (null (setq response (elmo-nntp-read-contents session)))
(error "NNTP List folders failed")
(when elmo-nntp-list-folders-use-cache
(setq elmo-nntp-list-folders-cache
- (list (current-time) (elmo-nntp-spec-group spec)
+ (list (current-time)
+ (elmo-nntp-folder-group-internal folder)
response)))
(erase-buffer)
(insert response))
(setq start nil)
(while (string-match (concat "^"
(regexp-quote
- (or (elmo-nntp-spec-group spec)
- "")) ".*$")
+ (or
+ (elmo-nntp-folder-group-internal
+ folder)
+ "")) ".*$")
response start)
(insert (match-string 0 response) "\n")
(setq start (match-end 0)))))
(goto-char (point-min))
(let ((len (count-lines (point-min) (point-max)))
(i 0) regexp)
- (if hierarchy
+ (if one-level
(progn
(setq regexp
(format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
- (if (and (elmo-nntp-spec-group spec)
- (null (string=
- (elmo-nntp-spec-group spec) "")))
- (concat (elmo-nntp-spec-group spec)
+ (if (and
+ (elmo-nntp-folder-group-internal folder)
+ (null (string=
+ (elmo-nntp-folder-group-internal
+ folder) "")))
+ (concat (elmo-nntp-folder-group-internal
+ folder)
"\\.") "")))
(while (looking-at regexp)
(setq top-ng (elmo-match-buffer 1))
(when (> len elmo-display-progress-threshold)
(elmo-display-progress
'elmo-nntp-list-folders "Parsing active..." 100))))
- (unless (string= (elmo-nntp-spec-hostname spec)
+ (unless (string= (elmo-net-folder-server-internal folder)
elmo-default-nntp-server)
- (setq append-serv (concat "@" (elmo-nntp-spec-hostname spec))))
- (unless (eq (elmo-nntp-spec-port spec) elmo-default-nntp-port)
+ (setq append-serv (concat "@" (elmo-net-folder-server-internal
+ folder))))
+ (unless (eq (elmo-net-folder-port-internal folder) elmo-default-nntp-port)
(setq append-serv (concat append-serv
":" (int-to-string
- (elmo-nntp-spec-port spec)))))
+ (elmo-net-folder-port-internal folder)))))
(unless (eq (elmo-network-stream-type-symbol
- (elmo-nntp-spec-stream-type spec))
+ (elmo-net-folder-stream-type-internal folder))
elmo-default-nntp-stream-type)
(setq append-serv
(concat append-serv
(elmo-network-stream-type-spec-string
- (elmo-nntp-spec-stream-type spec)))))
+ (elmo-net-folder-stream-type-internal folder)))))
(mapcar '(lambda (fld)
(if (consp fld)
(list (concat "-" (car fld)
- (and (elmo-nntp-spec-username spec)
+ (and (elmo-net-folder-user-internal folder)
(concat
- ":" (elmo-nntp-spec-username spec)))
+ ":"
+ (elmo-net-folder-user-internal folder)))
(and append-serv
(concat append-serv))))
(concat "-" fld
- (and (elmo-nntp-spec-username spec)
- (concat ":" (elmo-nntp-spec-username spec)))
+ (and (elmo-net-folder-user-internal folder)
+ (concat ":" (elmo-net-folder-user-internal
+ folder)))
(and append-serv
(concat append-serv)))))
ret-val)))
(goto-char (point-min))
(read (current-buffer)))))
-(defun elmo-nntp-list-folder (spec)
- (let ((session (elmo-nntp-get-session spec))
- (group (elmo-nntp-spec-group spec))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
+(luna-define-method elmo-folder-list-messages-internal ((folder
+ elmo-nntp-folder))
+ (let ((session (elmo-nntp-get-session folder))
+ (group (elmo-nntp-folder-group-internal folder))
response numbers use-listgroup)
(save-excursion
(when (setq use-listgroup (elmo-nntp-listgroup-p session))
(setq numbers (elmo-nntp-make-msglist
(elmo-match-string 2 response)
(elmo-match-string 3 response)))))
- (elmo-living-messages numbers killed))))
+ numbers)))
+
+(luna-define-method elmo-folder-status ((folder elmo-nntp-folder))
+ (elmo-nntp-folder-status folder))
-(defun elmo-nntp-max-of-folder (spec)
- (let ((killed-list (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
+(defun elmo-nntp-folder-status (folder)
+ (let ((killed-list (elmo-msgdb-killed-list-load
+ (elmo-folder-msgdb-path folder)))
end-num entry)
(if elmo-nntp-groups-async
(if (setq entry
(elmo-get-hash-val
- (concat (elmo-nntp-spec-group spec)
+ (concat (elmo-nntp-folder-group-internal folder)
(elmo-nntp-folder-postfix
- (elmo-nntp-spec-username spec)
- (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-port spec)
- (elmo-nntp-spec-stream-type spec)))
+ (elmo-net-folder-user-internal folder)
+ (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-stream-type-internal folder)))
elmo-nntp-groups-hashtb))
(progn
(setq end-num (nth 2 entry))
- (when (and killed-list elmo-use-killed-list
+ (when(and killed-list
(elmo-number-set-member end-num killed-list))
;; Max is killed.
(setq end-num nil))
(cons end-num (car entry)))
- (error "No such newsgroup \"%s\"" (elmo-nntp-spec-group spec)))
- (let ((session (elmo-nntp-get-session spec))
+ (error "No such newsgroup \"%s\""
+ (elmo-nntp-folder-group-internal folder)))
+ (let ((session (elmo-nntp-get-session folder))
response e-num)
(if (null session)
(error "Connection failed"))
(save-excursion
(elmo-nntp-send-command session
- (format "group %s"
- (elmo-nntp-spec-group spec)))
+ (format
+ "group %s"
+ (elmo-nntp-folder-group-internal folder)))
(setq response (elmo-nntp-read-response session))
(if (and response
(string-match
(elmo-match-string 3 response)))
(setq e-num (string-to-int
(elmo-match-string 1 response)))
- (when (and killed-list elmo-use-killed-list
+ (when (and killed-list
(elmo-number-set-member end-num killed-list))
;; Max is killed.
(setq end-num nil))
(cons end-num e-num))
(if (null response)
(error "Selecting newsgroup \"%s\" failed"
- (elmo-nntp-spec-group spec))
+ (elmo-nntp-folder-group-internal folder))
nil)))))))
(defconst elmo-nntp-overview-index
("xref" . 8)))
(defun elmo-nntp-create-msgdb-from-overview-string (str
- folder
new-mark
already-mark
seen-mark
(setq message-id (aref ov-entity 4))
(setq seen (member message-id seen-list))
(if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
- (if (elmo-cache-exists-p message-id);; XXX
+ (if (elmo-file-cache-status
+ (elmo-file-cache-get message-id))
(if seen
nil
already-mark)
(setq ov-list (cdr ov-list)))
(list overview number-alist mark-alist)))
-(defun elmo-nntp-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- "Create msgdb for SPEC for NUMLIST."
- (elmo-nntp-msgdb-create spec numlist new-mark already-mark
- seen-mark important-mark seen-list
- t))
-
-(defun elmo-nntp-msgdb-create (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list &optional as-num)
- (when numlist
- (let ((filter numlist)
- (session (elmo-nntp-get-session spec))
- beg-num end-num cur length
- ret-val ov-str use-xover dir)
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec))
- (when (setq use-xover (elmo-nntp-xover-p session))
- (setq beg-num (car numlist)
- cur beg-num
- end-num (nth (1- (length numlist)) numlist)
- length (+ (- end-num beg-num) 1))
- (message "Getting overview...")
- (while (<= cur end-num)
- (elmo-nntp-send-command
- session
- (format
- "xover %s-%s"
- (int-to-string cur)
- (int-to-string
- (+ cur
- elmo-nntp-overview-fetch-chop-length))))
- (with-current-buffer (elmo-network-session-buffer session)
- (if ov-str
- (setq ret-val
- (elmo-msgdb-append
- ret-val
- (elmo-nntp-create-msgdb-from-overview-string
- ov-str
- (elmo-nntp-spec-group spec)
- new-mark
- already-mark
- seen-mark
- important-mark
- seen-list
- filter
- )))))
- (if (null (elmo-nntp-read-response session t))
- (progn
- (setq cur end-num);; exit while loop
- (elmo-nntp-set-xover session nil)
- (setq use-xover nil))
- (if (null (setq ov-str (elmo-nntp-read-contents session)))
- (error "Fetching overview failed")))
- (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
- (when (> length elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create "Getting overview..."
- (/ (* (+ (- (min cur end-num)
- beg-num) 1) 100) length))))
- (when (> length elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create "Getting overview..." 100)))
- (if (not use-xover)
- (setq ret-val (elmo-nntp-msgdb-create-by-header
- session numlist
- new-mark already-mark seen-mark seen-list))
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder)
+ numbers new-mark already-mark
+ seen-mark important-mark
+ seen-list)
+ (elmo-nntp-folder-msgdb-create folder numbers new-mark already-mark
+ seen-mark important-mark
+ seen-list))
+
+(defun elmo-nntp-folder-msgdb-create (folder numbers new-mark already-mark
+ seen-mark important-mark
+ seen-list)
+ (let ((filter numbers)
+ (session (elmo-nntp-get-session folder))
+ beg-num end-num cur length
+ ret-val ov-str use-xover dir)
+ (elmo-nntp-select-group session (elmo-nntp-folder-group-internal
+ folder))
+ (when (setq use-xover (elmo-nntp-xover-p session))
+ (setq beg-num (car numbers)
+ cur beg-num
+ end-num (nth (1- (length numbers)) numbers)
+ length (+ (- end-num beg-num) 1))
+ (message "Getting overview...")
+ (while (<= cur end-num)
+ (elmo-nntp-send-command
+ session
+ (format
+ "xover %s-%s"
+ (int-to-string cur)
+ (int-to-string
+ (+ cur
+ elmo-nntp-overview-fetch-chop-length))))
(with-current-buffer (elmo-network-session-buffer session)
(if ov-str
(setq ret-val
ret-val
(elmo-nntp-create-msgdb-from-overview-string
ov-str
- (elmo-nntp-spec-group spec)
new-mark
already-mark
seen-mark
important-mark
seen-list
- filter))))))
- (when elmo-use-killed-list
- (setq dir (elmo-msgdb-expand-path spec))
- (elmo-msgdb-killed-list-save
- dir
- (nconc
- (elmo-msgdb-killed-list-load dir)
- (car (elmo-list-diff
- numlist
- (mapcar 'car
- (elmo-msgdb-get-number-alist
- ret-val)))))))
- ;; If there are canceled messages, overviews are not obtained
- ;; to max-number(inn 2.3?).
- (when (and (elmo-nntp-max-number-precedes-list-active-p)
- (elmo-nntp-list-active-p session))
- (elmo-nntp-send-command session
- (format "list active %s"
- (elmo-nntp-spec-group spec)))
- (if (null (elmo-nntp-read-response session))
+ filter
+ )))))
+ (if (null (elmo-nntp-read-response session t))
(progn
- (elmo-nntp-set-list-active session nil)
- (error "NNTP list command failed")))
- (elmo-nntp-catchup-msgdb
- ret-val
- (nth 1 (read (concat "(" (elmo-nntp-read-contents
- session) ")")))))
- ret-val)))
-
-(defun elmo-nntp-sync-number-alist (spec number-alist)
+ (setq cur end-num);; exit while loop
+ (elmo-nntp-set-xover session nil)
+ (setq use-xover nil))
+ (if (null (setq ov-str (elmo-nntp-read-contents session)))
+ (error "Fetching overview failed")))
+ (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
+ (when (> length elmo-display-progress-threshold)
+ (elmo-display-progress
+ 'elmo-nntp-msgdb-create "Getting overview..."
+ (/ (* (+ (- (min cur end-num)
+ beg-num) 1) 100) length))))
+ (when (> length elmo-display-progress-threshold)
+ (elmo-display-progress
+ 'elmo-nntp-msgdb-create "Getting overview..." 100)))
+ (if (not use-xover)
+ (setq ret-val (elmo-nntp-msgdb-create-by-header
+ session numbers
+ new-mark already-mark seen-mark seen-list))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (if ov-str
+ (setq ret-val
+ (elmo-msgdb-append
+ ret-val
+ (elmo-nntp-create-msgdb-from-overview-string
+ ov-str
+ new-mark
+ already-mark
+ seen-mark
+ important-mark
+ seen-list
+ filter))))))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (nconc
+ (elmo-folder-killed-list-internal folder)
+ (car (elmo-list-diff
+ numbers
+ (mapcar 'car
+ (elmo-msgdb-get-number-alist
+ ret-val))))))
+ ;; If there are canceled messages, overviews are not obtained
+ ;; to max-number(inn 2.3?).
+ (when (and (elmo-nntp-max-number-precedes-list-active-p)
+ (elmo-nntp-list-active-p session))
+ (elmo-nntp-send-command session
+ (format "list active %s"
+ (elmo-nntp-folder-group-internal
+ folder)))
+ (if (null (elmo-nntp-read-response session))
+ (progn
+ (elmo-nntp-set-list-active session nil)
+ (error "NNTP list command failed")))
+ (elmo-nntp-catchup-msgdb
+ ret-val
+ (nth 1 (read (concat "(" (elmo-nntp-read-contents
+ session) ")")))))
+ ret-val))
+
+(luna-define-method elmo-folder-update-number ((folder elmo-nntp-folder))
(if (elmo-nntp-max-number-precedes-list-active-p)
- (let ((session (elmo-nntp-get-session spec)))
+ (let ((session (elmo-nntp-get-session folder))
+ (number-alist (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder))))
(if (elmo-nntp-list-active-p session)
(let (msgdb-max max-number)
;; If there are canceled messages, overviews are not obtained
;; to max-number(inn 2.3?).
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec))
+ (elmo-nntp-select-group session
+ (elmo-nntp-folder-group-internal folder))
(elmo-nntp-send-command session
(format "list active %s"
- (elmo-nntp-spec-group spec)))
+ (elmo-nntp-folder-group-internal
+ folder)))
(if (null (elmo-nntp-read-response session))
(error "NNTP list command failed"))
(setq max-number
(if (or (and number-alist (not msgdb-max))
(and msgdb-max max-number
(< msgdb-max max-number)))
- (nconc number-alist
- (list (cons max-number nil)))
- number-alist))
- number-alist))))
+ (elmo-msgdb-set-number-alist
+ (elmo-folder-msgdb-internal folder)
+ (nconc number-alist
+ (list (cons max-number nil))))))))))
-(defun elmo-nntp-msgdb-create-by-header (session numlist
+(defun elmo-nntp-msgdb-create-by-header (session numbers
new-mark already-mark
seen-mark seen-list)
(with-temp-buffer
- (elmo-nntp-retrieve-headers session (current-buffer) numlist)
+ (elmo-nntp-retrieve-headers session (current-buffer) numbers)
(elmo-nntp-msgdb-create-message
- (length numlist) new-mark already-mark seen-mark seen-list)))
+ (length numbers) new-mark already-mark seen-mark seen-list)))
(defun elmo-nntp-parse-xhdr-response (string)
(let (response)
(with-current-buffer (elmo-network-session-buffer session)
(std11-field-body "Newsgroups")))))
-(defun elmo-nntp-read-msg (spec number outbuf)
- (let ((session (elmo-nntp-get-session spec)))
+(luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
+ number strategy
+ &optional section outbuf
+ unseen)
+ (elmo-nntp-message-fetch folder number strategy section outbuf unseen))
+
+(defun elmo-nntp-message-fetch (folder number strategy section outbuf unseen)
+ (let ((session (elmo-nntp-get-session folder)))
(with-current-buffer (elmo-network-session-buffer session)
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec))
+ (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))
(elmo-nntp-send-command session (format "article %s" number))
(if (null (elmo-nntp-read-response session t))
(progn
(replace-match "")
(forward-line))))))))
-;;(defun elmo-msgdb-nntp-overview-create-range (spec beg end mark)
-;; (elmo-nntp-overview-create-range hostname beg end mark folder)))
-
-;;(defun elmo-msgdb-nntp-max-of-folder (spec)
-;; (elmo-nntp-max-of-folder hostname folder)))
-
-(defun elmo-nntp-append-msg (spec string &optional msg no-see))
-
(defun elmo-nntp-post (hostname content-buf)
(let ((session (elmo-nntp-get-session
- (list 'nntp nil elmo-default-nntp-user
- hostname elmo-default-nntp-port
- elmo-default-nntp-stream-type)))
+ (luna-make-entity
+ 'elmo-nntp-folder
+ :user elmo-default-nntp-user
+ :server hostname
+ :port elmo-default-nntp-port
+ :stream-type elmo-default-nntp-stream-type)))
response has-message-id)
(save-excursion
(set-buffer content-buf)
(unless (eq (forward-line 1) 0) (setq data-continue nil))
(elmo-nntp-send-data-line session line)))))
-(defun elmo-nntp-delete-msgs (spec msgs)
- "MSGS on FOLDER at SERVER pretended as Deleted. Returns nil if failed."
- (if elmo-use-killed-list
- (let* ((dir (elmo-msgdb-expand-path spec))
- (killed-list (elmo-msgdb-killed-list-load dir)))
- (mapcar '(lambda (msg)
- (setq killed-list
- (elmo-msgdb-set-as-killed killed-list msg)))
- msgs)
- (elmo-msgdb-killed-list-save dir killed-list)))
- t)
+(luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
+ numbers)
+ (elmo-nntp-folder-delete-messages folder numbers))
-(defun elmo-nntp-check-validity (spec validity-file)
- t)
-(defun elmo-nntp-sync-validity (spec validity-file)
+(defun elmo-nntp-folder-delete-messages (folder numbers)
+ (let ((killed-list (elmo-folder-killed-list-internal folder)))
+ (dolist (number numbers)
+ (setq killed-list
+ (elmo-msgdb-set-as-killed killed-list number)))
+ (elmo-folder-set-killed-list-internal folder killed-list))
t)
-(defun elmo-nntp-folder-exists-p (spec)
- (let ((session (elmo-nntp-get-session spec)))
- (if (elmo-nntp-plugged-p spec)
+(luna-define-method elmo-folder-exists-p ((folder elmo-nntp-folder))
+ (let ((session (elmo-nntp-get-session folder)))
+ (if (elmo-folder-plugged-p folder)
(progn
- (elmo-nntp-send-command session
- (format "group %s"
- (elmo-nntp-spec-group spec)))
+ (elmo-nntp-send-command
+ session
+ (format "group %s"
+ (elmo-nntp-folder-group-internal folder)))
(elmo-nntp-read-response session))
t)))
-(defun elmo-nntp-folder-creatable-p (spec)
- nil)
-
-(defun elmo-nntp-create-folder (spec)
- nil) ; noop
-
(defun elmo-nntp-retrieve-field (spec field from-msgs)
"Retrieve FIELD values from FROM-MSGS.
Returns a list of cons cells like (NUMBER . VALUE)"
(let ((session (elmo-nntp-get-session spec)))
(if (elmo-nntp-xhdr-p session)
(progn
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec))
+ (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec))
(elmo-nntp-send-command session
(format "xhdr %s %s"
field
(let ((search-key (elmo-filter-key condition)))
(cond
((string= "last" search-key)
- (let ((numbers (or from-msgs (elmo-nntp-list-folder spec))))
+ (let ((numbers (or from-msgs (elmo-folder-list-messages spec))))
(nthcdr (max (- (length numbers)
(string-to-int (elmo-filter-value condition)))
0)
numbers)))
((string= "first" search-key)
- (let* ((numbers (or from-msgs (elmo-nntp-list-folder spec)))
+ (let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
(rest (nthcdr (string-to-int (elmo-filter-value condition) )
numbers)))
(mapcar '(lambda (x) (delete x numbers)) rest)
(elmo-list-filter from-msgs result)
result))))))
-(defun elmo-nntp-search (spec condition &optional from-msgs)
+(luna-define-method elmo-folder-search ((folder elmo-nntp-folder)
+ condition &optional from-msgs)
(let (result)
(cond
((vectorp condition)
(setq result (elmo-nntp-search-primitive
- spec condition from-msgs)))
+ folder condition from-msgs)))
((eq (car condition) 'and)
- (setq result (elmo-nntp-search spec (nth 1 condition) from-msgs)
+ (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
result (elmo-list-filter result
- (elmo-nntp-search
- spec (nth 2 condition)
+ (elmo-folder-search
+ folder (nth 2 condition)
from-msgs))))
((eq (car condition) 'or)
- (setq result (elmo-nntp-search spec (nth 1 condition) from-msgs)
+ (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
result (elmo-uniq-list
(nconc result
- (elmo-nntp-search spec (nth 2 condition)
- from-msgs)))
+ (elmo-folder-search folder (nth 2 condition)
+ from-msgs)))
result (sort result '<))))))
-(defun elmo-nntp-get-folders-info-prepare (spec session-keys)
+(defun elmo-nntp-get-folders-info-prepare (folder session-keys)
(condition-case ()
- (let ((session (elmo-nntp-get-session spec))
+ (let ((session (elmo-nntp-get-session folder))
key count)
(with-current-buffer (elmo-network-session-buffer session)
(unless (setq key (assoc session session-keys))
(erase-buffer)
(setq key (cons session
(vector 0
- (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-username spec)
- (elmo-nntp-spec-port spec)
- (elmo-nntp-spec-stream-type spec))))
+ (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-user-internal folder)
+ (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-stream-type-internal
+ folder))))
(setq session-keys (nconc session-keys (list key))))
(elmo-nntp-send-command session
(format "group %s"
- (elmo-nntp-spec-group spec))
+ (elmo-nntp-folder-group-internal
+ folder))
'noerase)
(if elmo-nntp-get-folders-securely
(accept-process-output
(replace-match "" t t))
(copy-to-buffer outbuf (point-min) (point-max)))))
-(defun elmo-nntp-make-groups-hashtb (folders &optional size)
+(defun elmo-nntp-make-groups-hashtb (groups &optional size)
(let ((hashtb (or elmo-nntp-groups-hashtb
(setq elmo-nntp-groups-hashtb
- (elmo-make-hash (or size (length folders)))))))
+ (elmo-make-hash (or size (length groups)))))))
(mapcar
- '(lambda (fld)
- (or (elmo-get-hash-val fld hashtb)
- (elmo-set-hash-val fld nil hashtb)))
- folders)
+ '(lambda (group)
+ (or (elmo-get-hash-val group hashtb)
+ (elmo-set-hash-val group nil hashtb)))
+ groups)
hashtb))
;; from nntp.el [Gnus]
(setq seen (member message-id seen-list))
(if (setq gmark
(or (elmo-msgdb-global-mark-get message-id)
- (if (elmo-cache-exists-p message-id);; XXX
+ (if (elmo-file-cache-status
+ (elmo-file-cache-get message-id))
(if seen
nil
already-mark)
'elmo-nntp-msgdb-create-message "Creating msgdb..." 100))
(list overview number-alist mark-alist))))
-(defun elmo-nntp-use-cache-p (spec number)
+(luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
elmo-nntp-use-cache)
-(defun elmo-nntp-local-file-p (spec number)
- nil)
-
-(defun elmo-nntp-port-label (spec)
- (concat "nntp"
- (if (elmo-nntp-spec-stream-type spec)
- (concat "!" (symbol-name
- (elmo-network-stream-type-symbol
- (elmo-nntp-spec-stream-type spec)))))))
-
-(defsubst elmo-nntp-portinfo (spec)
- (list (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-port spec)))
-
-(defun elmo-nntp-plugged-p (spec)
- (apply 'elmo-plugged-p
- (append (elmo-nntp-portinfo spec)
- (list nil (quote (elmo-nntp-port-label spec))))))
-
-(defun elmo-nntp-set-plugged (spec plugged add)
- (apply 'elmo-set-plugged plugged
- (append (elmo-nntp-portinfo spec)
- (list nil nil (quote (elmo-nntp-port-label spec)) add))))
-
-(defalias 'elmo-nntp-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-nntp-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-nntp-commit 'elmo-generic-commit)
-(defalias 'elmo-nntp-folder-diff 'elmo-generic-folder-diff)
+(luna-define-method elmo-folder-append-msgdb :around
+ ((folder elmo-nntp-folder) append-msgdb)
+ ;; IMPLEMENT ME: Process crosspost here instead of following.
+ (luna-call-next-method))
(require 'product)
(product-provide (provide 'elmo-nntp) (require 'elmo-version))
;;; Code:
;;
-(require 'elmo-msgdb)
-
-(defalias 'elmo-pipe-msgdb-create 'elmo-pipe-msgdb-create-as-numlist)
-
-(defun elmo-pipe-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- (elmo-msgdb-create-as-numlist (elmo-pipe-spec-dst spec)
- numlist new-mark already-mark
- seen-mark important-mark seen-list))
-
-(defun elmo-pipe-list-folders (spec &optional hierarchy)
- nil)
-
-(defun elmo-pipe-append-msg (spec string &optional msg no-see)
- (elmo-append-msg (elmo-pipe-spec-dst spec) string))
-
-(defun elmo-pipe-read-msg (spec number outbuf)
- (elmo-call-func (elmo-pipe-spec-dst spec)
- "read-msg"
- number outbuf))
-
-(defun elmo-pipe-delete-msgs (spec msgs)
- (elmo-delete-msgs (elmo-pipe-spec-dst spec) msgs))
+(require 'elmo)
+
+;;; ELMO pipe folder
+(eval-and-compile
+ (luna-define-class elmo-pipe-folder (elmo-folder)
+ (src dst))
+ (luna-define-internal-accessors 'elmo-pipe-folder))
+
+(luna-define-method elmo-folder-initialize ((folder elmo-pipe-folder)
+ name)
+ (when (string-match "^\\([^|]*\\)|\\(.*\\)$" name)
+ (elmo-pipe-folder-set-src-internal folder
+ (elmo-make-folder
+ (elmo-match-string 1 name)))
+ (elmo-pipe-folder-set-dst-internal folder
+ (elmo-make-folder
+ (elmo-match-string 2 name))))
+ folder)
+
+(luna-define-method elmo-folder-get-primitive-list ((folder elmo-pipe-folder))
+ (elmo-flatten
+ (mapcar
+ 'elmo-folder-get-primitive-list
+ (list (elmo-pipe-folder-src-internal folder)
+ (elmo-pipe-folder-dst-internal folder)))))
+
+(luna-define-method elmo-folder-contains-type ((folder elmo-pipe-folder)
+ type)
+ (or (elmo-folder-contains-type (elmo-pipe-folder-src-internal folder) type)
+ (elmo-folder-contains-type (elmo-pipe-folder-dst-internal folder) type)))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-pipe-folder)
+ numlist new-mark already-mark
+ seen-mark important-mark
+ seen-list)
+ (elmo-folder-msgdb-create (elmo-pipe-folder-dst-internal folder)
+ numlist new-mark already-mark
+ seen-mark important-mark seen-list))
+
+(luna-define-method elmo-folder-append-messages ((folder elmo-pipe-folder)
+ src-folder numbers
+ unread-marks
+ &optional same-number)
+ (elmo-folder-append-messages (elmo-pipe-folder-dst-internal folder)
+ src-folder numbers
+ unread-marks
+ same-number))
+
+(luna-define-method elmo-folder-append-buffer ((folder elmo-pipe-folder)
+ unread &optional number)
+ (elmo-folder-append-buffer (elmo-pipe-folder-dst-internal folder)
+ unread number))
+
+(luna-define-method elmo-message-fetch ((folder elmo-pipe-folder)
+ number strategy
+ &optional section outbuf unseen)
+ (elmo-message-fetch (elmo-pipe-folder-dst-internal folder)
+ number strategy section outbuf unseen))
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-pipe-folder)
+ numbers)
+ (elmo-folder-delete-messages (elmo-pipe-folder-dst-internal folder)
+ numbers))
(defvar elmo-pipe-drained-hook nil "A hook called when the pipe is flushed.")
(let (elmo-nntp-use-cache
elmo-imap4-use-cache
elmo-pop3-use-cache ; Inhibit caching while moving messages.
- elmo-pop3-use-uidl) ; No need to use UIDL
- (message "Checking %s..." src)
- (let ((srclist (elmo-list-folder src))
- (msgdb (elmo-msgdb-load src)))
- (elmo-move-msgs src srclist dst msgdb)
- ;; Don't save msgdb here.
- ;; Because summary view of original folder is not updated yet.
- ;; (elmo-msgdb-save src msgdb)
- (elmo-commit src))
- (run-hooks 'elmo-pipe-drained-hook)))
-
-(defun elmo-pipe-list-folder (spec)
- (elmo-pipe-drain (elmo-pipe-spec-src spec)
- (elmo-pipe-spec-dst spec))
- (let ((killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- numbers)
- (setq numbers (elmo-list-folder (elmo-pipe-spec-dst spec)))
- (elmo-living-messages numbers killed)))
-
-(defun elmo-pipe-list-folder-unread (spec number-alist mark-alist unread-marks)
- (elmo-list-folder-unread (elmo-pipe-spec-dst spec)
- number-alist mark-alist unread-marks))
+ (elmo-pop3-inhibit-uidl t)) ; No need to use UIDL
+ (message "Checking %s..." (elmo-folder-name-internal src))
+ (elmo-folder-open-internal src)
+ (elmo-folder-move-messages src (elmo-folder-list-messages src) dst))
+ ;; All of the msgdb entry is nil.
+ ;; But it is ok because all messages are drained.
+ (elmo-folder-close src)
+ (run-hooks 'elmo-pipe-drained-hook))
+
+(luna-define-method elmo-folder-open-internal ((folder elmo-pipe-folder))
+ (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder))
+ (elmo-pipe-drain (elmo-pipe-folder-src-internal folder)
+ (elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-pipe-folder))
+ (elmo-folder-close-internal(elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-pipe-folder))
+ (elmo-folder-list-messages-internal (elmo-pipe-folder-dst-internal
+ folder)))
+
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-pipe-folder) unread-marks)
+ (elmo-folder-list-unreads-internal (elmo-pipe-folder-dst-internal folder)
+ unread-marks))
-(defun elmo-pipe-list-folder-important (spec number-alist)
- (elmo-list-folder-important (elmo-pipe-spec-dst spec) number-alist))
-
-(defun elmo-pipe-max-of-folder (spec)
- (let* (elmo-pop3-use-uidl
- (src-length (length (elmo-list-folder (elmo-pipe-spec-src spec))))
- (dst-list (elmo-list-folder (elmo-pipe-spec-dst spec))))
- (cons (+ src-length (elmo-max-of-list dst-list))
- (+ src-length (length dst-list)))))
-
-(defun elmo-pipe-folder-exists-p (spec)
- (and (elmo-folder-exists-p (elmo-pipe-spec-src spec))
- (elmo-folder-exists-p (elmo-pipe-spec-dst spec))))
-
-(defun elmo-pipe-folder-creatable-p (spec)
- (or (elmo-folder-creatable-p (elmo-pipe-spec-src spec))
- (elmo-folder-creatable-p (elmo-pipe-spec-dst spec))))
-
-(defun elmo-pipe-create-folder (spec)
- (if (and (not (elmo-folder-exists-p (elmo-pipe-spec-src spec)))
- (elmo-folder-creatable-p (elmo-pipe-spec-src spec)))
- (elmo-create-folder (elmo-pipe-spec-src spec)))
- (if (and (not (elmo-folder-exists-p (elmo-pipe-spec-dst spec)))
- (elmo-folder-creatable-p (elmo-pipe-spec-dst spec)))
- (elmo-create-folder (elmo-pipe-spec-dst spec))))
-
-(defun elmo-pipe-search (spec condition &optional numlist)
- (elmo-search (elmo-pipe-spec-dst spec) condition numlist))
-
-(defun elmo-pipe-use-cache-p (spec number)
- (elmo-use-cache-p (elmo-pipe-spec-dst spec) number))
-
-(defun elmo-pipe-commit (spec)
- (elmo-commit (elmo-pipe-spec-src spec))
- (elmo-commit (elmo-pipe-spec-dst spec)))
-
-(defun elmo-pipe-plugged-p (spec)
- (and (elmo-folder-plugged-p (elmo-pipe-spec-src spec))
- (elmo-folder-plugged-p (elmo-pipe-spec-dst spec))))
-
-(defun elmo-pipe-set-plugged (spec plugged add)
- (elmo-folder-set-plugged (elmo-pipe-spec-src spec) plugged add)
- (elmo-folder-set-plugged (elmo-pipe-spec-dst spec) plugged add))
-
-(defun elmo-pipe-local-file-p (spec number)
- (elmo-local-file-p (elmo-pipe-spec-dst spec) number))
-
-(defun elmo-pipe-get-msg-filename (spec number &optional loc-alist)
- (elmo-get-msg-filename (elmo-pipe-spec-dst spec) number loc-alist))
-
-(defun elmo-pipe-sync-number-alist (spec number-alist)
- (elmo-call-func (elmo-pipe-spec-src spec)
- "sync-number-alist" number-alist)) ; ??
-
-(defun elmo-pipe-server-diff (spec)
- nil)
-
-(defalias 'elmo-pipe-folder-diff 'elmo-generic-folder-diff)
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-pipe-folder) important-mark)
+ (elmo-folder-list-importants-internal (elmo-pipe-folder-dst-internal folder)
+ important-mark))
+
+(luna-define-method elmo-folder-status ((folder elmo-pipe-folder))
+ (elmo-folder-open-internal (elmo-pipe-folder-src-internal folder))
+ (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder))
+ (let* ((elmo-pop3-inhibit-uidl t)
+ (src-length (length (elmo-folder-list-messages
+ (elmo-pipe-folder-src-internal folder))))
+ (dst-list (elmo-folder-list-messages
+ (elmo-pipe-folder-dst-internal folder))))
+ (prog1 (cons (+ src-length (elmo-max-of-list dst-list))
+ (+ src-length (length dst-list)))))
+ ;; No save.
+ (elmo-folder-close-internal (elmo-pipe-folder-src-internal folder))
+ (elmo-folder-close-internal (elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-pipe-folder))
+ (and (elmo-folder-exists-p (elmo-pipe-folder-src-internal folder))
+ (elmo-folder-exists-p (elmo-pipe-folder-dst-internal folder))))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-pipe-folder))
+ ;; Share with destination...OK?
+ (elmo-folder-expand-msgdb-path (elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-creatable-p ((folder elmo-pipe-folder))
+ (and (elmo-folder-creatable-p (elmo-pipe-folder-src-internal folder))
+ (elmo-folder-creatable-p (elmo-pipe-folder-dst-internal folder))))
+
+(luna-define-method elmo-folder-create ((folder elmo-pipe-folder))
+ (if (and (not (elmo-folder-exists-p (elmo-pipe-folder-src-internal folder)))
+ (elmo-folder-creatable-p (elmo-pipe-folder-src-internal folder)))
+ (elmo-folder-create (elmo-pipe-folder-src-internal folder)))
+ (if (and (not (elmo-folder-exists-p (elmo-pipe-folder-dst-internal folder)))
+ (elmo-folder-creatable-p (elmo-pipe-folder-dst-internal folder)))
+ (elmo-folder-create (elmo-pipe-folder-dst-internal folder))))
+
+(luna-define-method elmo-folder-search ((folder elmo-pipe-folder)
+ condition &optional numlist)
+ (elmo-folder-search (elmo-pipe-folder-dst-internal folder)
+ condition numlist))
+
+(luna-define-method elmo-message-use-cache-p ((folder elmo-pipe-folder) number)
+ (elmo-message-use-cache-p (elmo-pipe-folder-dst-internal folder) number))
+
+(luna-define-method elmo-folder-check ((folder elmo-pipe-folder))
+ (elmo-folder-close-internal folder)
+ (elmo-folder-open-internal folder))
+
+(luna-define-method elmo-folder-plugged-p ((folder elmo-pipe-folder))
+ (and (elmo-folder-plugged-p (elmo-pipe-folder-src-internal folder))
+ (elmo-folder-plugged-p (elmo-pipe-folder-dst-internal folder))))
+
+(luna-define-method elmo-message-file-p ((folder elmo-pipe-folder) number)
+ (elmo-message-file-p (elmo-pipe-folder-dst-internal folder) number))
+
+(luna-define-method elmo-message-file-name ((folder elmo-pipe-folder) number)
+ (elmo-message-file-name (elmo-pipe-folder-dst-internal folder) number))
+
+(luna-define-method elmo-folder-message-file-number-p ((folder
+ elmo-pipe-folder))
+ (elmo-folder-message-file-number-p (elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-message-file-directory ((folder
+ elmo-pipe-folder))
+ (elmo-folder-message-file-directory
+ (elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-localdir-folder))
+ (elmo-folder-message-make-temp-file-p
+ (elmo-pipe-folder-dst-internal folder)))
+
+(luna-define-method elmo-folder-message-make-temp-files ((folder
+ elmo-pipe-folder)
+ numbers
+ &optional
+ start-number)
+ (elmo-folder-message-make-temp-files
+ (elmo-pipe-folder-dst-internal folder) numbers start-number))
(require 'product)
(product-provide (provide 'elmo-pipe) (require 'elmo-version))
(eval-and-compile
(autoload 'md5 "md5"))
-(defvar elmo-pop3-use-uidl t
- "*If non-nil, use UIDL.")
+;; POP3
+(defvar elmo-default-pop3-user (or (getenv "USER")
+ (getenv "LOGNAME")
+ (user-login-name))
+ "*Default username for POP3.")
+(defvar elmo-default-pop3-server "localhost"
+ "*Default POP3 server.")
+(defvar elmo-default-pop3-authenticate-type 'user
+ "*Default Authentication type for POP3.")
+(defvar elmo-default-pop3-port 110
+ "*Default POP3 port.")
+(defvar elmo-default-pop3-stream-type nil
+ "*Default stream type for POP3.
+Any symbol value of `elmo-network-stream-type-alist'.")
+
+
+(defvar elmo-pop3-stream-type-alist nil
+ "*Stream bindings for POP3.
+This is taken precedence over `elmo-network-stream-type-alist'.")
+
+
+(defvar elmo-pop3-default-use-uidl t
+ "If non-nil, use UIDL on POP3.")
+
+(defvar elmo-pop3-use-uidl-internal t
+ "(Internal switch for using UIDL on POP3).")
+(defvar elmo-pop3-inhibit-uidl nil
+ "(Internal switch for using UIDL on POP3).")
(defvar elmo-pop3-exists-exactly t)
-(luna-define-class elmo-pop3-session (elmo-network-session))
+;;; ELMO POP3 folder
+(eval-and-compile
+ (luna-define-class elmo-pop3-folder (elmo-net-folder)
+ (use-uidl location-alist))
+ (luna-define-internal-accessors 'elmo-pop3-folder))
+
+(luna-define-method elmo-folder-initialize :around ((folder
+ elmo-pop3-folder)
+ name)
+ (let ((elmo-network-stream-type-alist
+ (if elmo-pop3-stream-type-alist
+ (append elmo-pop3-stream-type-alist
+ elmo-network-stream-type-alist)
+ elmo-network-stream-type-alist)))
+ (setq name (luna-call-next-method))
+ ;; Setup slots for elmo-net-folder
+ (when (string-match "^\\([^:/!]*\\)\\(/[^/:@!]+\\)?\\(:[^/:@!]+\\)?" name)
+ (elmo-net-folder-set-user-internal folder
+ (if (match-beginning 1)
+ (elmo-match-string 1 name)))
+ (if (eq (length (elmo-net-folder-user-internal folder)) 0)
+ (elmo-net-folder-set-user-internal folder
+ elmo-default-pop3-user))
+ (elmo-net-folder-set-auth-internal
+ folder
+ (if (match-beginning 2)
+ (intern (elmo-match-substring 2 name 1))
+ elmo-default-pop3-authenticate-type))
+ (elmo-pop3-folder-set-use-uidl-internal
+ folder
+ (if (match-beginning 3)
+ (string= (elmo-match-substring 3 name 1) "uidl")
+ elmo-pop3-default-use-uidl)))
+ (unless (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-set-server-internal folder
+ elmo-default-pop3-server))
+ (unless (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-set-port-internal folder
+ elmo-default-pop3-port))
+ (unless (elmo-net-folder-stream-type-internal folder)
+ (elmo-net-folder-set-stream-type-internal
+ folder
+ elmo-default-pop3-stream-type))
+ folder))
+
+;;; POP3 session
+(luna-define-class elmo-pop3-session (elmo-network-session) ())
;; buffer-local
(defvar elmo-pop3-read-point nil)
(when (memq (process-status
(elmo-network-session-process-internal session))
'(open run))
- (elmo-pop3-send-command (elmo-network-session-process-internal session)
- "quit")
- (or (elmo-pop3-read-response
- (elmo-network-session-process-internal session) t)
- (error "POP error: QUIT failed")))
+ (let ((buffer (process-buffer
+ (elmo-network-session-process-internal session))))
+ (elmo-pop3-send-command (elmo-network-session-process-internal session)
+ "quit")
+ ;; process is dead.
+ (or (elmo-pop3-read-response
+ (elmo-network-session-process-internal session)
+ t buffer)
+ (error "POP error: QUIT failed"))))
(kill-buffer (process-buffer
(elmo-network-session-process-internal session)))
(delete-process (elmo-network-session-process-internal session))))
-(defun elmo-pop3-get-session (spec &optional if-exists)
- (elmo-network-get-session
- 'elmo-pop3-session
- "POP3"
- (elmo-pop3-spec-hostname spec)
- (elmo-pop3-spec-port spec)
- (elmo-pop3-spec-username spec)
- (elmo-pop3-spec-auth spec)
- (elmo-pop3-spec-stream-type spec)
- if-exists))
+(defun elmo-pop3-get-session (folder &optional if-exists)
+ (let ((elmo-pop3-use-uidl-internal (if elmo-pop3-inhibit-uidl
+ nil
+ (elmo-pop3-folder-use-uidl-internal
+ folder))))
+ (elmo-network-get-session 'elmo-pop3-session "POP3" folder if-exists)))
(defun elmo-pop3-send-command (process command &optional no-erase)
(with-current-buffer (process-buffer process)
(process-send-string process command)
(process-send-string process "\r\n")))
-(defun elmo-pop3-read-response (process &optional not-command)
- (with-current-buffer (process-buffer process)
+(defun elmo-pop3-read-response (process &optional not-command buffer)
+ ;; buffer is in case for process is dead.
+ (with-current-buffer (or buffer (process-buffer process))
(let ((case-fold-search nil)
(response-string nil)
(response-continue t)
mechanism
(elmo-network-session-user-internal session)
"pop"
- (elmo-network-session-host-internal session)))
+ (elmo-network-session-server-internal session)))
;;; (if elmo-pop3-auth-user-realm
;;; (sasl-client-set-property client 'realm elmo-pop3-auth-user-realm))
(setq name (sasl-mechanism-name mechanism))
;; POP server always returns a sequence of serial numbers.
(setq count (elmo-pop3-parse-list-response response))
;; UIDL
- (when elmo-pop3-use-uidl
+ (when elmo-pop3-use-uidl-internal
(setq elmo-pop3-uidl-number-hash (elmo-make-hash (* count 2)))
(setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2)))
;; UIDL
(buffer-substring elmo-pop3-read-point
(- match-end 3))))))
-;; dummy functions
-(defun elmo-pop3-list-folders (spec &optional hierarchy) nil)
-(defun elmo-pop3-append-msg (spec string) nil nil)
-(defun elmo-pop3-folder-creatable-p (spec) nil)
-(defun elmo-pop3-create-folder (spec) nil)
+(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-pop3-folder))
+ (convert-standard-filename
+ (expand-file-name
+ (elmo-safe-filename (elmo-net-folder-user-internal folder))
+ (expand-file-name (elmo-net-folder-server-internal folder)
+ (expand-file-name
+ "pop"
+ elmo-msgdb-dir)))))
-(defun elmo-pop3-folder-exists-p (spec)
+(luna-define-method elmo-folder-exists-p ((folder elmo-pop3-folder))
(if (and elmo-pop3-exists-exactly
- (elmo-pop3-plugged-p spec))
+ (elmo-folder-plugged-p folder))
(save-excursion
- (let (elmo-auto-change-plugged ; don't change plug status.
- elmo-pop3-use-uidl ; No need to use uidl.
+ (let (elmo-auto-change-plugged ; don't change plug status.
+ elmo-pop3-inhibit-uidl ; No need to use uidl.
session)
(prog1
- (setq session (elmo-pop3-get-session spec))
+ (setq session (elmo-pop3-get-session folder))
(if session
(elmo-network-close-session session)))))
t))
(setq elmo-pop3-list-done t))
count)))
-(defun elmo-pop3-list-location (spec)
+(defun elmo-pop3-list-location (folder)
(with-current-buffer (process-buffer
(elmo-network-session-process-internal
- (elmo-pop3-get-session spec)))
+ (elmo-pop3-get-session folder)))
(let (list)
(if elmo-pop3-uidl-done
(progn
(nreverse list))
(error "POP3: Error in UIDL")))))
-(defun elmo-pop3-list-by-uidl-subr (spec &optional nonsort)
- (let ((flist (elmo-list-folder-by-location
- spec
- (elmo-pop3-list-location spec))))
+(defun elmo-pop3-list-folder-by-location (folder locations)
+ (let* ((location-alist (elmo-pop3-folder-location-alist-internal folder))
+ (locations-in-db (mapcar 'cdr location-alist))
+ result new-locs new-alist deleted-locs i)
+ (setq new-locs
+ (elmo-delete-if (function
+ (lambda (x) (member x locations-in-db)))
+ locations))
+ (setq deleted-locs
+ (elmo-delete-if (function
+ (lambda (x) (member x locations)))
+ locations-in-db))
+ (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
+ (mapcar
+ (function
+ (lambda (x)
+ (setq location-alist
+ (delq (rassoc x location-alist) location-alist))))
+ deleted-locs)
+ (while new-locs
+ (setq i (1+ i))
+ (setq new-alist (cons (cons i (car new-locs)) new-alist))
+ (setq new-locs (cdr new-locs)))
+ (setq result (nconc location-alist new-alist))
+ (setq result (sort result (lambda (x y) (< (car x)(car y)))))
+ (elmo-pop3-folder-set-location-alist-internal folder result)
+ (mapcar 'car result)))
+
+(defun elmo-pop3-list-by-uidl-subr (folder &optional nonsort)
+ (let ((flist (elmo-pop3-list-folder-by-location
+ folder
+ (elmo-pop3-list-location folder))))
(if nonsort
(cons (elmo-max-of-list flist) (length flist))
(sort flist '<))))
-(defun elmo-pop3-list-by-list (spec)
+(defun elmo-pop3-list-by-list (folder)
(with-current-buffer (process-buffer
(elmo-network-session-process-internal
- (elmo-pop3-get-session spec)))
+ (elmo-pop3-get-session folder)))
(let (list)
(if elmo-pop3-list-done
(progn
(sort list '<))
(error "POP3: Error in list")))))
-(defun elmo-pop3-list-folder (spec)
- (let ((killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- numbers)
- (elmo-pop3-commit spec)
- (setq numbers (if elmo-pop3-use-uidl
- (progn
- (elmo-pop3-list-by-uidl-subr spec))
- (elmo-pop3-list-by-list spec)))
- (elmo-living-messages numbers killed)))
-
-(defun elmo-pop3-max-of-folder (spec)
- (elmo-pop3-commit spec)
- (if elmo-pop3-use-uidl
- (elmo-pop3-list-by-uidl-subr spec 'nonsort)
+(defsubst elmo-pop3-folder-list-messages (folder)
+ (if (and (not elmo-pop3-inhibit-uidl)
+ (elmo-pop3-folder-use-uidl-internal folder))
+ (elmo-pop3-list-by-uidl-subr folder)
+ (elmo-pop3-list-by-list folder)))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-pop3-folder))
+ (elmo-pop3-folder-list-messages folder))
+
+(luna-define-method elmo-folder-status ((folder elmo-pop3-folder))
+ (elmo-folder-check folder)
+ (if (elmo-pop3-folder-use-uidl-internal folder)
+ (elmo-pop3-list-by-uidl-subr folder 'nonsort)
(let* ((process
(elmo-network-session-process-internal
- (elmo-pop3-get-session spec)))
+ (elmo-pop3-get-session folder)))
(total 0)
response)
(with-current-buffer (process-buffer process)
(replace-match "\n"))
(copy-to-buffer tobuffer (point-min) (point-max)))))
-(defalias 'elmo-pop3-msgdb-create 'elmo-pop3-msgdb-create-as-numlist)
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-pop3-folder)
+ numlist new-mark
+ already-mark seen-mark
+ important-mark seen-list)
+ (let ((process (elmo-network-session-process-internal
+ (elmo-pop3-get-session folder))))
+ (with-current-buffer (process-buffer process)
+ (elmo-pop3-sort-msgdb-by-original-number
+ folder
+ (elmo-pop3-msgdb-create-by-header
+ process
+ numlist
+ new-mark already-mark
+ seen-mark seen-list
+ (if (elmo-pop3-folder-use-uidl-internal folder)
+ (elmo-pop3-folder-location-alist-internal folder)))))))
(defun elmo-pop3-sort-overview-by-original-number (overview loc-alist)
(if loc-alist
loc-alist))))))
overview))
-(defun elmo-pop3-sort-msgdb-by-original-number (msgdb)
+(defun elmo-pop3-sort-msgdb-by-original-number (folder msgdb)
(message "Sorting...")
(let ((overview (elmo-msgdb-get-overview msgdb)))
+ (current-buffer)
(setq overview (elmo-pop3-sort-overview-by-original-number
overview
- (elmo-msgdb-get-location msgdb)))
+ (elmo-pop3-folder-location-alist-internal folder)))
(message "Sorting...done")
- (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb))))
-
-(defun elmo-pop3-msgdb-create-as-numlist (spec numlist new-mark
- already-mark seen-mark
- important-mark seen-list
- &optional msgdb)
- (when numlist
- (let ((process (elmo-network-session-process-internal
- (elmo-pop3-get-session spec)))
- loc-alist)
- (if elmo-pop3-use-uidl
- (setq loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load
- (elmo-msgdb-expand-path spec)))))
- (with-current-buffer (process-buffer process)
- (elmo-pop3-sort-msgdb-by-original-number
- (elmo-pop3-msgdb-create-by-header process numlist
- new-mark already-mark
- seen-mark seen-list
- loc-alist))))))
+ (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb))))
(defun elmo-pop3-uidl-to-number (uidl)
(string-to-number (elmo-get-hash-val uidl
(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-cache-exists-p
- message-id) ; XXX
+ (if (elmo-file-cache-status
+ (elmo-file-cache-get message-id))
(if seen
nil
already-mark)
(elmo-display-progress
'elmo-pop3-msgdb-create-message "Creating msgdb..."
(/ (* i 100) num)))))
- (list overview number-alist mark-alist loc-alist))))
+ (list overview number-alist mark-alist))))
(defun elmo-pop3-read-body (process outbuf)
(with-current-buffer (process-buffer process)
(setq end (point))
(with-current-buffer outbuf
(erase-buffer)
- (insert-buffer-substring (process-buffer process) start (- end 3))
- (elmo-delete-cr-get-content-type)))))
-
-(defun elmo-pop3-read-msg (spec number outbuf &optional msgdb)
- (let* ((loc-alist (if elmo-pop3-use-uidl
- (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load
- (elmo-msgdb-expand-path spec)))))
+ (insert-buffer-substring (process-buffer process) start (- end 3))))))
+
+(luna-define-method elmo-folder-open-internal ((folder elmo-pop3-folder))
+ (if (elmo-pop3-folder-use-uidl-internal folder)
+ (elmo-pop3-folder-set-location-alist-internal
+ folder (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))))
+
+(luna-define-method elmo-folder-commit :after ((folder elmo-pop3-folder))
+ (when (elmo-folder-persistent-p folder)
+ (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
+ (elmo-pop3-folder-location-alist-internal
+ folder))))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-pop3-folder))
+ (elmo-pop3-folder-set-location-alist-internal folder nil)
+ (elmo-folder-check folder))
+
+(luna-define-method elmo-message-fetch-plugged ((folder elmo-pop3-folder)
+ number strategy
+ &optional section
+ outbuf unseen)
+ (let* ((loc-alist (elmo-pop3-folder-location-alist-internal folder))
(process (elmo-network-session-process-internal
- (elmo-pop3-get-session spec)))
+ (elmo-pop3-get-session folder)))
response errmsg msg)
(with-current-buffer (process-buffer process)
(if loc-alist
(error "Deleting message failed")))
(error "Deleting message failed")))))
-(defun elmo-pop3-delete-msgs (spec msgs &optional msgdb)
- (let ((loc-alist (if elmo-pop3-use-uidl
- (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load
- (elmo-msgdb-expand-path spec)))))
+(luna-define-method elmo-folder-delete-messages ((folder elmo-pop3-folder)
+ msgs)
+ (let ((loc-alist (elmo-pop3-folder-location-alist-internal folder))
(process (elmo-network-session-process-internal
- (elmo-pop3-get-session spec))))
+ (elmo-pop3-get-session folder))))
(mapcar '(lambda (msg) (elmo-pop3-delete-msg
process msg loc-alist))
msgs)))
-(defun elmo-pop3-search (spec condition &optional numlist)
- (error "Searching in pop3 folder is not implemented yet"))
-
-(defun elmo-pop3-use-cache-p (spec number)
+(luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number)
elmo-pop3-use-cache)
-(defun elmo-pop3-local-file-p (spec number)
- nil)
-
-(defun elmo-pop3-port-label (spec)
- (concat "pop3"
- (if (elmo-pop3-spec-stream-type spec)
- (concat "!" (symbol-name
- (elmo-network-stream-type-symbol
- (elmo-pop3-spec-stream-type spec)))))))
-
-(defsubst elmo-pop3-portinfo (spec)
- (list (elmo-pop3-spec-hostname spec)
- (elmo-pop3-spec-port spec)))
-
-(defun elmo-pop3-plugged-p (spec)
- (apply 'elmo-plugged-p
- (append (elmo-pop3-portinfo spec)
- (list nil (quote (elmo-pop3-port-label spec))))))
-
-(defun elmo-pop3-set-plugged (spec plugged add)
- (apply 'elmo-set-plugged plugged
- (append (elmo-pop3-portinfo spec)
- (list nil nil (quote (elmo-pop3-port-label spec)) add))))
-
-(defalias 'elmo-pop3-sync-number-alist
- 'elmo-generic-sync-number-alist)
-(defalias 'elmo-pop3-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-pop3-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-pop3-folder-diff 'elmo-generic-folder-diff)
-
-(defun elmo-pop3-commit (spec)
- (if (elmo-pop3-plugged-p spec)
- (let ((session (elmo-pop3-get-session spec 'if-exists)))
+(luna-define-method elmo-folder-persistent-p ((folder elmo-pop3-folder))
+ (and (elmo-folder-persistent-internal folder)
+ (elmo-pop3-folder-use-uidl-internal folder)))
+
+
+(luna-define-method elmo-folder-check ((folder elmo-pop3-folder))
+ (if (elmo-folder-plugged-p folder)
+ (let ((session (elmo-pop3-get-session folder 'if-exists)))
(and session
(elmo-network-close-session session)))))
-
(require 'product)
(product-provide (provide 'elmo-pop3) (require 'elmo-version))
;;; Code:
;;
+(eval-when-compile (require 'cl))
(require 'elmo-vars)
(require 'elmo-date)
-(eval-when-compile (require 'cl))
(require 'std11)
(require 'eword-decode)
(require 'utf7)
(filename newname &optional ok-if-already-exists)
(copy-file filename newname ok-if-already-exists t)))
-(defsubst elmo-call-func (folder func-name &rest args)
- (let* ((spec (if (stringp folder)
- (elmo-folder-get-spec folder)
- folder))
- (type (symbol-name (car spec)))
- (backend-str (concat "elmo-" type))
- (backend-sym (intern backend-str)))
- (unless (featurep backend-sym)
- (require backend-sym))
- (apply (intern (format "%s-%s" backend-str func-name))
- spec
- args)))
-
;; Nemacs's `read' is different.
(static-if (fboundp 'nemacs-version)
(defun elmo-read (obj)
(erase-buffer)
(,@ body))))
-(defmacro elmo-match-substring (pos string from)
- "Substring of POSth matched string of STRING."
- (` (substring (, string)
- (+ (match-beginning (, pos)) (, from))
- (match-end (, pos)))))
-
-(defmacro elmo-match-string (pos string)
- "Substring POSth matched STRING."
- (` (substring (, string) (match-beginning (, pos)) (match-end (, pos)))))
-
-(defmacro elmo-match-buffer (pos)
- "Substring POSth matched from the current buffer."
- (` (buffer-substring-no-properties
- (match-beginning (, pos)) (match-end (, pos)))))
-
(defmacro elmo-bind-directory (dir &rest body)
"Set current directory DIR and execute BODY."
(` (let ((default-directory (file-name-as-directory (, dir))))
(,@ body))))
-(defmacro elmo-folder-get-type (folder)
- "Get type of FOLDER."
- (` (and (stringp (, folder))
- (cdr (assoc (string-to-char (, folder)) elmo-spec-alist)))))
-
(defun elmo-object-load (filename &optional mime-charset no-err)
"Load OBJECT from the file specified by FILENAME.
File content is decoded with MIME-CHARSET."
;;;(princ "\n" (current-buffer))
(elmo-save-buffer filename mime-charset)))
-(defsubst elmo-imap4-decode-folder-string (string)
- (if elmo-imap4-use-modified-utf7
- (utf7-decode-string string 'imap)
- string))
-
-(defsubst elmo-imap4-encode-folder-string (string)
- (if elmo-imap4-use-modified-utf7
- (utf7-encode-string string 'imap)
- string))
-
(defun elmo-get-network-stream-type (stream-type stream-type-alist)
(catch 'found
(while stream-type-alist
(throw 'found (car stream-type-alist)))
(setq stream-type-alist (cdr stream-type-alist)))))
-(defun elmo-network-get-spec (folder server port stream-type stream-type-alist)
- (setq stream-type (elmo-get-network-stream-type
- stream-type stream-type-alist))
- (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" folder)
- (if (match-beginning 1)
- (setq server (elmo-match-substring 1 folder 1)))
- (if (match-beginning 2)
- (setq port (string-to-int (elmo-match-substring 2 folder 1))))
- (if (match-beginning 3)
- (setq stream-type (assoc (elmo-match-string 3 folder)
- stream-type-alist)))
- (setq folder (substring folder 0 (match-beginning 0))))
- (cons folder (list server port stream-type)))
-
-(defun elmo-imap4-get-spec (folder)
- (let ((default-user elmo-default-imap4-user)
- (default-server elmo-default-imap4-server)
- (default-port elmo-default-imap4-port)
- (default-stream-type elmo-default-imap4-stream-type)
- (stream-type-alist elmo-network-stream-type-alist)
- spec mailbox user auth)
- (when (string-match "\\(.*\\)@\\(.*\\)" default-server)
- ;; case: default-imap4-server is specified like
- ;; "hoge%imap.server@gateway".
- (setq default-user (elmo-match-string 1 default-server))
- (setq default-server (elmo-match-string 2 default-server)))
- (if elmo-imap4-stream-type-alist
- (setq stream-type-alist
- (append elmo-imap4-stream-type-alist stream-type-alist)))
- (setq spec (elmo-network-get-spec
- folder default-server default-port default-stream-type
- stream-type-alist))
- (setq folder (car spec))
- (when (string-match
- "^\\(%\\)\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?"
- folder)
- (progn
- (setq mailbox (if (match-beginning 2)
- (elmo-match-string 2 folder)
- elmo-default-imap4-mailbox))
- (setq user (if (match-beginning 3)
- (elmo-match-substring 3 folder 1)
- default-user))
- (setq auth (if (match-beginning 4)
- (intern (elmo-match-substring 4 folder 1))
- elmo-default-imap4-authenticate-type))
- (setq auth (or auth 'clear))
- (append (list 'imap4
- (elmo-imap4-encode-folder-string mailbox)
- user auth)
- (cdr spec))))))
-
-(defsubst elmo-imap4-spec-mailbox (spec)
- (nth 1 spec))
-
-(defsubst elmo-imap4-spec-username (spec)
- (nth 2 spec))
-
-(defsubst elmo-imap4-spec-auth (spec)
- (nth 3 spec))
-
-(defsubst elmo-imap4-spec-hostname (spec)
- (nth 4 spec))
-
-(defsubst elmo-imap4-spec-port (spec)
- (nth 5 spec))
-
-(defsubst elmo-imap4-spec-stream-type (spec)
- (nth 6 spec))
-
-(defalias 'elmo-imap4-spec-folder 'elmo-imap4-spec-mailbox)
-(make-obsolete 'elmo-imap4-spec-folder 'elmo-imap4-spec-mailbox)
-
-(defsubst elmo-imap4-connection-get-process (conn)
- (nth 1 conn))
-
-(defsubst elmo-imap4-connection-get-buffer (conn)
- (nth 0 conn))
-
-(defsubst elmo-imap4-connection-get-cwf (conn)
- (nth 2 conn))
-
-(defun elmo-nntp-get-spec (folder)
- (let ((stream-type-alist elmo-network-stream-type-alist)
- spec group user)
- (if elmo-nntp-stream-type-alist
- (setq stream-type-alist
- (append elmo-nntp-stream-type-alist stream-type-alist)))
- (setq spec (elmo-network-get-spec folder
- elmo-default-nntp-server
- elmo-default-nntp-port
- elmo-default-nntp-stream-type
- stream-type-alist))
- (setq folder (car spec))
- (when (string-match
- "^\\(-\\)\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?"
- folder)
- (setq group
- (if (match-beginning 2)
- (elmo-match-string 2 folder)))
- (setq user
- (if (match-beginning 3)
- (elmo-match-substring 3 folder 1)
- elmo-default-nntp-user))
- (append (list 'nntp group user)
- (cdr spec)))))
-
-(defsubst elmo-nntp-spec-group (spec)
- (nth 1 spec))
-
-(defsubst elmo-nntp-spec-username (spec)
- (nth 2 spec))
-
-;; future use?
-;; (defsubst elmo-nntp-spec-auth (spec))
-
-(defsubst elmo-nntp-spec-hostname (spec)
- (nth 3 spec))
-
-(defsubst elmo-nntp-spec-port (spec)
- (nth 4 spec))
-
-(defsubst elmo-nntp-spec-stream-type (spec)
- (nth 5 spec))
-
-(defun elmo-localdir-get-spec (folder)
- (let (fld-name path)
- (when (string-match
- "^\\(\\+\\)\\(.*\\)$"
- folder)
- (if (eq (length (setq fld-name
- (elmo-match-string 2 folder))) 0)
- (setq fld-name "")
- )
- (if (file-name-absolute-p fld-name)
- (setq path (expand-file-name fld-name))
-;;; (setq path (expand-file-name fld-name
-;;; elmo-localdir-folder-path))
- (setq path fld-name))
- (list (if (elmo-folder-maildir-p folder)
- 'maildir
- 'localdir) path))))
-
-(defun elmo-maildir-get-spec (folder)
- (let (fld-name path)
- (when (string-match
- "^\\(\\.\\)\\(.*\\)$"
- folder)
- (if (eq (length (setq fld-name
- (elmo-match-string 2 folder))) 0)
- (setq fld-name ""))
- (if (file-name-absolute-p fld-name)
- (setq path (expand-file-name fld-name))
- (setq path fld-name))
- (list 'maildir path))))
-
-(defun elmo-folder-maildir-p (folder)
- (catch 'found
- (let ((li elmo-maildir-list))
- (while li
- (if (string-match (car li) folder)
- (throw 'found t))
- (setq li (cdr li))))))
-
-(defun elmo-localnews-get-spec (folder)
- (let (fld-name)
- (when (string-match
- "^\\(=\\)\\(.*\\)$"
- folder)
- (if (eq (length (setq fld-name
- (elmo-match-string 2 folder))) 0)
- (setq fld-name "")
- )
- (list 'localnews
- (elmo-replace-in-string fld-name "\\." "/")))))
-
-(defun elmo-cache-get-spec (folder)
- (let (fld-name)
- (when (string-match
- "^\\(!\\)\\(.*\\)$"
- folder)
- (if (eq (length (setq fld-name
- (elmo-match-string 2 folder))) 0)
- (setq fld-name "")
- )
- (list 'cache
- (elmo-replace-in-string fld-name "\\." "/")))))
-
-;; Archive interface by OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
-(defun elmo-archive-get-spec (folder)
- (require 'elmo-archive)
- (let (fld-name type prefix)
- (when (string-match
- "^\\(\\$\\)\\([^;]*\\);?\\([^;]*\\);?\\([^;]*\\)$"
- folder)
- ;; Drive letter is OK!
- (if (eq (length (setq fld-name
- (elmo-match-string 2 folder))) 0)
- (setq fld-name "")
- )
- (if (eq (length (setq type
- (elmo-match-string 3 folder))) 0)
- (setq type (symbol-name elmo-archive-default-type)))
- (if (eq (length (setq prefix
- (elmo-match-string 4 folder))) 0)
- (setq prefix ""))
- (list 'archive fld-name (intern-soft type) prefix))))
-
-(defun elmo-pop3-get-spec (folder)
- (let ((stream-type-alist elmo-network-stream-type-alist)
- spec user auth)
- (if elmo-pop3-stream-type-alist
- (setq stream-type-alist
- (append elmo-pop3-stream-type-alist stream-type-alist)))
- (setq spec (elmo-network-get-spec folder
- elmo-default-pop3-server
- elmo-default-pop3-port
- elmo-default-pop3-stream-type
- stream-type-alist))
- (setq folder (car spec))
- (when (string-match
- "^\\(&\\)\\([^:/!]*\\)\\(/[^/:@!]+\\)?"
- folder)
- (setq user (if (match-beginning 2)
- (elmo-match-string 2 folder)))
- (if (eq (length user) 0)
- (setq user elmo-default-pop3-user))
- (setq auth (if (match-beginning 3)
- (intern (elmo-match-substring 3 folder 1))
- elmo-default-pop3-authenticate-type))
- (setq auth (or auth 'user))
- (append (list 'pop3 user auth)
- (cdr spec)))))
-
-(defsubst elmo-pop3-spec-username (spec)
- (nth 1 spec))
-
-(defsubst elmo-pop3-spec-auth (spec)
- (nth 2 spec))
-
-(defsubst elmo-pop3-spec-hostname (spec)
- (nth 3 spec))
-
-(defsubst elmo-pop3-spec-port (spec)
- (nth 4 spec))
-
-(defsubst elmo-pop3-spec-stream-type (spec)
- (nth 5 spec))
-
-(defun elmo-internal-get-spec (folder)
- (if (string-match "\\('\\)\\([^/]*\\)/?\\(.*\\)$" folder)
- (let* ((item (downcase (elmo-match-string 2 folder)))
- (sym (and (> (length item) 0) (intern item))))
- (cond ((or (null sym)
- (eq sym 'mark))
- (list 'internal sym (elmo-match-string 3 folder)))
- ((eq sym 'cache)
- (list 'cache (elmo-match-string 3 folder)))
- (t (error "Invalid internal folder spec"))))))
-
-(defun elmo-multi-get-spec (folder)
- (save-match-data
- (when (string-match
- "^\\(\\*\\)\\(.*\\)$"
- folder)
- (append (list 'multi)
- (split-string
- (elmo-match-string 2 folder)
- ",")))))
-
-(defun elmo-filter-get-spec (folder)
- (when (string-match "^\\(/\\)\\(.*\\)$" folder)
- (let ((folder (elmo-match-string 2 folder))
- pair)
- (setq pair (elmo-parse-search-condition folder))
- (if (string-match "^ */\\(.*\\)$" (cdr pair))
- (list 'filter (car pair) (elmo-match-string 1 (cdr pair)))
- (error "Folder syntax error `%s'" folder)))))
-
-(defun elmo-pipe-get-spec (folder)
- (when (string-match "^\\(|\\)\\([^|]*\\)|\\(.*\\)$" folder)
- (list 'pipe
- (elmo-match-string 2 folder)
- (elmo-match-string 3 folder))))
-
-(defsubst elmo-pipe-spec-src (spec)
- (nth 1 spec))
-
-(defsubst elmo-pipe-spec-dst (spec)
- (nth 2 spec))
-
-(defun elmo-folder-get-spec (folder)
- "Return spec of FOLDER."
- (let ((type (elmo-folder-get-type folder)))
- (if type
- (save-match-data
- (funcall (intern (concat "elmo-" (symbol-name type) "-get-spec"))
- folder))
- (error "%s is not supported folder type" folder))))
-
;;; Search Condition
(defconst elmo-condition-atom-regexp "[^/ \")|&]*")
(t (error "Syntax error '%s'" (buffer-string)))))
;;;
-(defun elmo-multi-get-real-folder-number (folder number)
- (let* ((spec (elmo-folder-get-spec folder))
- (flds (cdr spec))
- (num number)
- (fld (nth (- (/ num elmo-multi-divide-number) 1) flds)))
- (cons fld (% num elmo-multi-divide-number))))
-
(defsubst elmo-buffer-replace (regexp &optional newtext)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(replace-match ""))
(buffer-string)))))
+(defsubst elmo-delete-cr-buffer ()
+ "Delete CR from buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n")) ))
+
(defsubst elmo-delete-cr-get-content-type ()
(save-excursion
(goto-char (point-min))
(message "")
ans)))
-;; from subr.el
-(defun elmo-replace-in-string (str regexp newtext &optional literal)
- "Replace all matches in STR for REGEXP with NEWTEXT string.
-And returns the new string.
-Optional LITERAL non-nil means do a literal replacement.
-Otherwise treat \\ in NEWTEXT string as special:
- \\& means substitute original matched text,
- \\N means substitute match for \(...\) number N,
- \\\\ means insert one \\."
- (let ((rtn-str "")
- (start 0)
- (special)
- match prev-start)
- (while (setq match (string-match regexp str start))
- (setq prev-start start
- start (match-end 0)
- rtn-str
- (concat
- rtn-str
- (substring str prev-start match)
- (cond (literal newtext)
- (t (mapconcat
- (function
- (lambda (c)
- (if special
- (progn
- (setq special nil)
- (cond ((eq c ?\\) "\\")
- ((eq c ?&)
- (elmo-match-string 0 str))
- ((and (>= c ?0) (<= c ?9))
- (if (> c (+ ?0 (length
- (match-data))))
- ;; Invalid match num
- (error "Invalid match num: %c" c)
- (setq c (- c ?0))
- (elmo-match-string c str)))
- (t (char-to-string c))))
- (if (eq c ?\\) (progn (setq special t) nil)
- (char-to-string c)))))
- newtext ""))))))
- (concat rtn-str (substring str start))))
-
(defun elmo-string-to-list (string)
(elmo-set-work-buf
(insert string)
(setq alist (cdr alist)))
(elmo-plug-on-by-servers alist other-servers)))
-(defun elmo-plugged-p (&optional server port alist label-exp)
+(defun elmo-plugged-p (&optional server port stream-type alist label-exp)
(let ((alist (or alist elmo-plugged-alist))
plugged-info)
(cond ((and (not port) (not server))
(cond ((eq elmo-plugged-condition 'one)
- (catch 'plugged
- (while alist
- (if (nth 2 (car alist))
- (throw 'plugged t))
- (setq alist (cdr alist)))))
+ (if alist
+ (catch 'plugged
+ (while alist
+ (if (nth 2 (car alist))
+ (throw 'plugged t))
+ (setq alist (cdr alist))))
+ elmo-plugged))
((eq elmo-plugged-condition 'all)
- (catch 'plugged
- (while alist
- (if (not (nth 2 (car alist)))
- (throw 'plugged nil))
- (setq alist (cdr alist)))
- t))
+ (if alist
+ (catch 'plugged
+ (while alist
+ (if (not (nth 2 (car alist)))
+ (throw 'plugged nil))
+ (setq alist (cdr alist)))
+ t)
+ elmo-plugged))
((functionp elmo-plugged-condition)
(funcall elmo-plugged-condition alist))
(t ;; independent
(throw 'plugged t)))
(setq alist (cdr alist)))))
(t
- (setq plugged-info (assoc (cons server port) alist))
+ (setq plugged-info (assoc (list server port stream-type) alist))
(if (not plugged-info)
;; add elmo-plugged-alist automatically
(progn
- (elmo-set-plugged elmo-plugged server port nil nil label-exp)
+ (elmo-set-plugged elmo-plugged server port stream-type
+ nil nil nil label-exp)
elmo-plugged)
(if (and elmo-auto-change-plugged
(> elmo-auto-change-plugged 0)
t
(nth 2 plugged-info)))))))
-(defun elmo-set-plugged (plugged &optional server port time
+(defun elmo-set-plugged (plugged &optional server port stream-type time
alist label-exp add)
(let ((alist (or alist elmo-plugged-alist))
label plugged-info)
(setq alist (cdr alist))))
(t
;; set plugged one port of server
- (setq plugged-info (assoc (cons server port) alist))
+ (setq plugged-info (assoc (list server port stream-type) alist))
(setq label (if label-exp
(eval label-exp)
(nth 1 plugged-info)))
(setcdr plugged-info (list label plugged time)))
(setq alist
(setq elmo-plugged-alist
- (nconc elmo-plugged-alist
- (list
- (list (cons server port) label plugged time))))))))
+ (nconc
+ elmo-plugged-alist
+ (list
+ (list (list server port stream-type)
+ label plugged time))))))))
alist))
(defun elmo-delete-plugged (&optional server port alist)
(defun elmo-delete-directory (path &optional no-hierarchy)
"Delete directory recursively."
+ (if (stringp path) ; nil is not permitted.
(let ((dirent (directory-files path))
relpath abspath hierarchy)
(while dirent
(elmo-delete-directory abspath no-hierarchy))
(delete-file abspath))))
(unless hierarchy
- (delete-directory path))))
+ (delete-directory path)))))
(defun elmo-list-filter (l1 l2)
"L1 is filter."
;; filter is nil
l2)))
-(defun elmo-folder-local-p (folder)
- "Return whether FOLDER is a local folder or not."
- (let ((spec (elmo-folder-get-spec folder)))
- (case (car spec)
- (filter (elmo-folder-local-p (nth 2 spec)))
- (pipe (elmo-folder-local-p (elmo-pipe-spec-dst spec)))
- (t (memq (car spec)
- '(localdir localnews archive maildir internal cache))))))
-
-(defun elmo-folder-writable-p (folder)
- (let ((type (elmo-folder-get-type folder)))
- (memq type '(imap4 localdir archive))))
-
-(defun elmo-multi-get-intlist-list (numlist &optional as-is)
- (let ((numbers (sort numlist '<))
- (cur-number 0)
- one-list int-list-list)
- (while numbers
- (setq cur-number (+ cur-number 1))
- (setq one-list nil)
- (while (and numbers
- (eq 0
- (/ (- (car numbers)
- (* elmo-multi-divide-number cur-number))
- elmo-multi-divide-number)))
- (setq one-list (nconc
- one-list
- (list
- (if as-is
- (car numbers)
- (% (car numbers)
- (* elmo-multi-divide-number cur-number))))))
- (setq numbers (cdr numbers)))
- (setq int-list-list (nconc int-list-list (list one-list))))
- int-list-list))
-
(defsubst elmo-list-delete-if-smaller (list number)
(let ((ret-val (copy-sequence list)))
(while list
(setq l1 (cdr l1)))
(cons diff1 (list l2)))))
-(defun elmo-multi-list-bigger-diff (list1 list2 &optional mes)
- (let ((list1-list (elmo-multi-get-intlist-list list1 t))
- (list2-list (elmo-multi-get-intlist-list list2 t))
- result
- dels news)
- (while (or list1-list list2-list)
- (setq result (elmo-list-bigger-diff (car list1-list) (car list2-list)
- mes))
- (setq dels (append dels (car result)))
- (setq news (append news (cadr result)))
- (setq list1-list (cdr list1-list))
- (setq list2-list (cdr list2-list)))
- (cons dels (list news))))
-
-(defvar elmo-imap4-name-space-regexp-list nil)
-(defun elmo-imap4-identical-name-space-p (fld1 fld2)
- ;; only on UW?
- (if (or (eq (string-to-char fld1) ?#)
- (eq (string-to-char fld2) ?#))
- (string= (car (split-string fld1 "/"))
- (car (split-string fld2 "/")))
- t))
-
-(defun elmo-folder-identical-system-p (folder1 folder2)
- "FOLDER1 and FOLDER2 should be real folder (not virtual)."
- (cond ((eq (elmo-folder-get-type folder1) 'imap4)
- (let ((spec1 (elmo-folder-get-spec folder1))
- (spec2 (elmo-folder-get-spec folder2)))
- (and
-;;; No use.
-;;; (elmo-imap4-identical-name-space-p
-;;; (nth 1 spec1) (nth 1 spec2))
- (string= (elmo-imap4-spec-hostname spec1)
- (elmo-imap4-spec-hostname spec2)) ; hostname
- (string= (elmo-imap4-spec-username spec1)
- (elmo-imap4-spec-username spec2))))) ; username
- (t
- (elmo-folder-direct-copy-p folder1 folder2))))
-
-(defun elmo-folder-get-store-type (folder)
- (let ((spec (elmo-folder-get-spec folder)))
- (case (car spec)
- (filter (elmo-folder-get-store-type (nth 2 spec)))
- (pipe (elmo-folder-get-store-type (elmo-pipe-spec-dst spec)))
- (multi (elmo-folder-get-store-type (nth 1 spec)))
- (t (car spec)))))
-
-(defconst elmo-folder-direct-copy-alist
- '((localdir . (localdir localnews archive))
- (maildir . (maildir localdir localnews archive))
- (localnews . (localdir localnews archive))
- (archive . (localdir localnews archive))
- (cache . (localdir localnews archive))))
-
-(defun elmo-folder-direct-copy-p (src-folder dst-folder)
- (let ((src-type (elmo-folder-get-store-type src-folder))
- (dst-type (elmo-folder-get-store-type dst-folder))
- dst-copy-type)
- (and (setq dst-copy-type
- (cdr (assq src-type elmo-folder-direct-copy-alist)))
- (memq dst-type dst-copy-type))))
-
(defmacro elmo-filter-type (filter)
(` (aref (, filter) 0)))
":" "__")
"|" "_or_"))
-(defvar elmo-msgid-replace-chars nil)
+(defvar elmo-filename-replace-chars nil)
-(defsubst elmo-replace-msgid-as-filename (msgid)
- "Replace Message-ID string (MSGID) as filename."
+(defsubst elmo-replace-string-as-filename (msgid)
+ "Replace string as filename."
(setq msgid (elmo-replace-in-string msgid " " " "))
- (if (null elmo-msgid-replace-chars)
- (setq elmo-msgid-replace-chars
+ (if (null elmo-filename-replace-chars)
+ (setq elmo-filename-replace-chars
(regexp-quote (mapconcat
- 'car elmo-msgid-replace-string-alist ""))))
- (while (string-match (concat "[" elmo-msgid-replace-chars "]")
+ 'car elmo-filename-replace-string-alist ""))))
+ (while (string-match (concat "[" elmo-filename-replace-chars "]")
msgid)
(setq msgid (concat
(substring msgid 0 (match-beginning 0))
(cdr (assoc
(substring msgid
(match-beginning 0) (match-end 0))
- elmo-msgid-replace-string-alist))
+ elmo-filename-replace-string-alist))
(substring msgid (match-end 0)))))
msgid)
-(defsubst elmo-recover-msgid-from-filename (filename)
- "Recover Message-ID from FILENAME."
+(defsubst elmo-recover-string-from-filename (filename)
+ "Recover string from FILENAME."
(let (tmp result)
(while (string-match " " filename)
(setq tmp (substring filename
(if (string= tmp " ")
(setq tmp " ")
(setq tmp (car (rassoc tmp
- elmo-msgid-replace-string-alist))))
+ elmo-filename-replace-string-alist))))
(setq result
(concat result
(substring filename 0 (match-beginning 0))
(setq number-set-1 (nconc number-set-1 (list number))))
number-set-1))
+(defun elmo-number-set-to-number-list (number-set)
+ "Return a number list which corresponds to NUMBER-SET."
+ (let (number-list elem i)
+ (while number-set
+ (setq elem (car number-set))
+ (cond
+ ((consp elem)
+ (setq i (car elem))
+ (while (<= i (cdr elem))
+ (setq number-list (cons i number-list))
+ (incf i)))
+ ((integerp elem)
+ (setq number-list (cons elem number-list))))
+ (setq number-set (cdr number-set)))
+ (nreverse number-list)))
+
+(defcustom elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|[0-9]+\\)$"
+ "*Regexp to filter subfolders."
+ :type 'regexp
+ :group 'elmo)
+
+(defun elmo-list-subdirectories (directory file one-level)
+ (let ((root (zerop (length file)))
+ (w32-get-true-file-link-count t) ; for Meadow
+ files attr dirs dir)
+ (setq files (directory-files (setq dir (expand-file-name file directory))))
+ (while files
+ (if (and (not (string-match elmo-list-subdirectories-ignore-regexp
+ (car files)))
+ (car (setq attr (file-attributes (expand-file-name
+ (car files) dir)))))
+ (if (and (not one-level)
+ (and elmo-have-link-count (< 2 (nth 1 attr))))
+ (setq dirs
+ (nconc dirs
+ (elmo-list-subdirectories
+ directory
+ (concat file
+ (and (not root) elmo-path-sep)
+ (car files))
+ one-level)))
+ (setq dirs (nconc dirs
+ (list
+ (concat file
+ (and (not root) elmo-path-sep)
+ (car files)))))))
+ (setq files (cdr files)))
+ (nconc (and (not root) (list file)) dirs)))
+
(require 'product)
(product-provide (provide 'elmo-util) (require 'elmo-version))
;;
(require 'poe)
+;; silence byte compiler
(eval-when-compile
(defun-maybe dynamic-link (a))
(defun-maybe dynamic-call (a b)))
-;; IMAP4
-(defvar elmo-default-imap4-mailbox "inbox"
- "*Default IMAP4 mailbox.")
-(defvar elmo-default-imap4-server "localhost"
- "*Default IMAP4 server.")
-(defvar elmo-default-imap4-authenticate-type 'login
- "*Default Authentication type for IMAP4.")
-(defvar elmo-default-imap4-user (or (getenv "USER")
- (getenv "LOGNAME")
- (user-login-name))
- "*Default username for IMAP4.")
-(defvar elmo-default-imap4-port 143
- "*Default Port number of IMAP.")
-(defvar elmo-default-imap4-stream-type nil
- "*Default stream type for IMAP4.
-Any symbol value of `elmo-network-stream-type-alist'.")
-(defvar elmo-imap4-stream-type-alist nil
- "*Stream bindings for IMAP4.
-This is taken precedence over `elmo-network-stream-type-alist'.")
-
-;; POP3
-(defvar elmo-default-pop3-user (or (getenv "USER")
- (getenv "LOGNAME")
- (user-login-name))
- "*Default username for POP3.")
-(defvar elmo-default-pop3-server "localhost"
- "*Default POP3 server.")
-(defvar elmo-default-pop3-authenticate-type 'user
- "*Default Authentication type for POP3.")
-(defvar elmo-default-pop3-port 110
- "*Default POP3 port.")
-(defvar elmo-default-pop3-stream-type nil
- "*Default stream type for POP3.
-Any symbol value of `elmo-network-stream-type-alist'.")
-(defvar elmo-pop3-stream-type-alist nil
- "*Stream bindings for POP3.
-This is taken precedence over `elmo-network-stream-type-alist'.")
+(defgroup elmo nil
+ "ELMO, Elisp Library for Message Orchestration."
+ :tag "ELMO"
+ :group 'news
+ :group 'mail)
;; NNTP
(defvar elmo-default-nntp-server "localhost"
"*ELMO Password filename.")
(defvar elmo-passwd-life-time nil
"*Duration of ELMO Password in seconds. nil means infinity.")
+
(defvar elmo-warning-threshold 30000
"*Display warning when the bytes of message exceeds this value.")
+
(defvar elmo-msg-appended-hook nil
"A hook called when message is appended to database.")
(defvar elmo-msg-deleted-hook nil
(defvar elmo-use-server-diff t
"Non-nil forces to get unread message information on server.")
-(defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
- "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored.
-(Except `\\Deleted' flag).")
+(defvar elmo-strict-diff-folder-list nil
+ "List of regexps of folder name which should be checked its diff strictly.")
(defvar elmo-msgdb-extra-fields nil
"Extra fields for msgdb.")
(defvar elmo-enable-disconnected-operation nil
"*Enable disconnected operations.")
-(defvar elmo-imap4-overview-fetch-chop-length 200
- "*Number of overviews to fetch in one request in imap4.")
(defvar elmo-nntp-overview-fetch-chop-length 200
"*Number of overviews to fetch in one request in nntp.")
(defvar elmo-localdir-header-chop-length 2048
"*Number of bytes to get header in one reading from file.")
-(defvar elmo-imap4-force-login nil
- "*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.")
-(defvar elmo-imap4-use-select-to-update-status nil
- "*Some imapd have to send select command to update status.
-(ex. UW imapd 4.5-BETA?). For these imapd, you must set this variable t.")
-(defvar elmo-imap4-use-modified-utf7 nil
- "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.")
(defvar elmo-auto-change-plugged 600
"*Time to expire change plugged state automatically, as the number of seconds.
(defvar elmo-multi-divide-number 100000
"*Multi divider number.")
-;;; User variables for elmo-archive.
-(defvar elmo-archive-default-type 'zip
- "*Default archiver type. The value must be a symbol.")
-
;; database dynamic linking
(defvar elmo-database-dl-module
(expand-file-name "database.so" exec-directory))
(defvar elmo-date-match (not (boundp 'nemacs-version))
"Date match is available or not.")
-(defconst elmo-spec-alist
- '((?% . imap4)
- (?- . nntp)
- (?\+ . localdir)
- (?\* . multi)
- (?\/ . filter)
- (?\$ . archive)
- (?& . pop3)
- (?= . localnews)
- (?' . internal)
- (?| . pipe)
- (?. . maildir)))
-
(defvar elmo-network-stream-type-alist
'(("!" ssl ssl open-ssl-stream)
("!!" starttls starttls starttls-open-stream)
OPEN-STREAM-FUNCTION is a function to open network stream.
Arguments for this function are NAME, BUFFER, HOST and SERVICE.")
-(defvar elmo-debug nil)
-(defconst mmelmo-entity-buffer-name "*MMELMO-BUFFER*")
-
(defvar elmo-folder-info-hashtb nil
"Array of folder database information '(max length new unread).")
(defvar elmo-weekday-name-fr '["Dim" "Lun" "Mar" "Mer" "Jeu" "Ven" "Sam"])
(defvar elmo-weekday-name-de '["Son" "Mon" "Die" "Mit" "Don" "Fre" "Sam"])
-(defvar elmo-msgid-replace-string-alist
+(defvar elmo-filename-replace-string-alist
'((":" . " c")
("*" . " a")
("?" . " q")
("/" . " s")
("\\" . " b")))
-(defvar elmo-archive-use-cache nil
- "Use cache in archive folder.")
-
(defvar elmo-nntp-use-cache t
"Use cache in nntp folder.")
-(defvar elmo-imap4-use-cache t
- "Use cache in imap4 folder.")
-
(defvar elmo-pop3-use-cache t
"Use cache in pop3 folder.")
"Non-nil means max number of msgdb is set as the max number of `list active'.
(Needed for inn 2.3 or later?).")
-(defvar elmo-use-killed-list t
- "If non-nil, deleted messages are saved as `killed'
-and do not appear again.")
-
(defvar elmo-pop3-send-command-synchronously nil
"If non-nil, commands are send synchronously.
If server doesn't accept asynchronous commands, this variable should be
--- /dev/null
+;;; elmo.el -- Elisp Library for Message Orchestration
+
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+;; APIs which can be used before opened:
+
+;; elmo-make-folder
+;; elmo-folder-diff
+;; elmo-folder-open
+
+;;; Code:
+;;
+
+(require 'product)
+(require 'luna)
+
+(require 'elmo-vars)
+(require 'elmo-util)
+(require 'elmo-msgdb)
+(require 'elmo-cache)
+
+(eval-when-compile (require 'cl))
+
+(if (or (featurep 'dbm)
+ (featurep 'gnudbm)
+ (featurep 'berkdb)
+ (featurep 'berkeley-db))
+ (require 'elmo-database))
+
+(defcustom elmo-message-fetch-threshold 30000
+ "Fetch threshold."
+ :type 'integer
+ :group 'elmo)
+
+(defcustom elmo-message-fetch-confirm t
+ "Confirm fetching if message size is larger than `elmo-fetch-threshold'.
+Otherwise, entire fetching of the message is aborted without confirmation."
+ :type 'boolean
+ :group 'elmo)
+
+(defcustom elmo-folder-update-threshold 500
+ "Update threshold."
+ :type 'integer
+ :group 'elmo)
+
+(defcustom elmo-folder-update-confirm t
+ "Confirm if update number exceeds `elmo-folder-update-threshold'."
+ :type 'boolean
+ :group 'elmo)
+
+;;; internal
+(defvar elmo-folder-type-alist nil)
+(elmo-define-error 'elmo-error "Error" 'error)
+(elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error)
+(elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error)
+(elmo-define-error 'elmo-imap4-bye-error "IMAP4 BYE response" 'elmo-open-error)
+
+(defun elmo-define-folder (prefix backend)
+ "Define a folder.
+If a folder name begins with PREFIX, use BACKEND."
+ (let ((pair (assq prefix elmo-folder-type-alist)))
+ (if pair
+ (progn
+ (setcar pair prefix)
+ (setcdr pair backend))
+ (setq elmo-folder-type-alist (cons (cons prefix backend)
+ elmo-folder-type-alist)))))
+
+(defmacro elmo-folder-type (name)
+ "Get folder type from NAME string."
+ (` (and (stringp (, name))
+ (cdr (assoc (string-to-char (, name)) elmo-folder-type-alist)))))
+
+;;; ELMO folder
+;; A elmo folder provides uniformed (orchestrated) access
+;; to the internet messages.
+(eval-and-compile
+ (luna-define-class elmo-folder () (type ; folder type symbol.
+ name ; orignal folder name string.
+ prefix ; prefix for folder name
+ path ; directory path for msgdb.
+ msgdb ; msgdb (may be nil).
+ killed-list ; killed list.
+ persistent ; non-nil if persistent.
+ message-modified ; message is modified.
+ mark-modified ; mark is modified.
+ ))
+ (luna-define-internal-accessors 'elmo-folder))
+
+(luna-define-generic elmo-folder-initialize (folder name)
+ ;; Initialize a FOLDER structure with NAME."
+ )
+
+(defmacro elmo-folder-send (folder message &rest args)
+ "Let FOLDER receive the MESSAGE with ARGS."
+ (` (luna-send (, folder) (, message) (, folder) (,@ args))))
+
+;;;###autoload
+(defun elmo-make-folder (name &optional non-persistent)
+ "Make an ELMO folder structure specified by NAME.
+If optional argument NON-PERSISTENT is non-nil, folder is treated as
+ non-persistent."
+ (let ((type (elmo-folder-type name))
+ prefix split class folder original)
+ (setq original (elmo-string name))
+ (if type
+ (progn
+ (setq prefix (substring name 0 1))
+ (setq name (substring name 1)))
+ (setq type (intern (car (setq split (split-string name ":")))))
+ (setq name (substring name (+ 1 (length (car split)))))
+ (setq prefix (concat (car split) ":")))
+ (setq class (format "elmo-%s" (symbol-name type)))
+ (require (intern class))
+ (setq folder (luna-make-entity (intern (concat class "-folder"))
+ :type type
+ :prefix prefix
+ :name original
+ :persistent (not non-persistent)))
+ (save-match-data
+ (elmo-folder-send folder 'elmo-folder-initialize name))))
+
+(luna-define-generic elmo-folder-open (folder)
+ "Open and setup (load saved status) FOLDER.")
+
+(luna-define-generic elmo-folder-open-internal (folder)
+ "Open FOLDER (without loading saved folder status).")
+
+(luna-define-generic elmo-folder-check (folder)
+ "Check the FOLDER to obtain newest information at the next list operation.")
+
+(luna-define-generic elmo-folder-commit (folder)
+ "Save current status of FOLDER.")
+
+(luna-define-generic elmo-folder-close (folder)
+ "Close, save and clearnup FOLDER.")
+
+(luna-define-generic elmo-folder-close-internal (folder)
+ "Close FOLDER (without saving folder status).")
+
+(luna-define-generic elmo-folder-plugged-p (folder)
+ "Returns t if FOLDER is plugged.")
+
+(luna-define-generic elmo-folder-set-plugged (folder plugged &optional add)
+ "Set FOLDER as plugged.")
+
+(luna-define-generic elmo-folder-use-flag-p (folder)
+ "Returns t if FOLDER treats unread/important flag itself.")
+
+(luna-define-generic elmo-folder-diff (folder &optional numbers)
+ "Get diff of FOLDER.
+If optional NUMBERS is set, it is used as current NUMBERS.
+Otherwise, saved status for folder is used for comparison.
+Return value is a cons cell of NEWS and MESSAGES.")
+
+(luna-define-generic elmo-folder-status (folder)
+ "Returns a cons cell of (MAX-NUMBER . MESSAGES) in the FOLDER.")
+
+(defun elmo-folder-list-messages (folder)
+ "Return a list of message numbers contained in FOLDER."
+ (let ((list (elmo-folder-list-messages-internal folder))
+ (killed (elmo-folder-killed-list-internal folder))
+ numbers)
+ (setq numbers
+ (if (listp list)
+ list
+ ;; Not available, use current list.
+ (mapcar
+ 'car
+ (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))))
+ (elmo-living-messages numbers killed)))
+
+(defun elmo-folder-list-unreads (folder unread-marks)
+ "Return a list of unread message numbers contained in FOLDER.
+UNREAD-MARKS is the unread marks."
+ (let ((list (elmo-folder-list-unreads-internal folder unread-marks)))
+ (if (listp list)
+ list
+ ;; Not available, use current mark.
+ (delq nil
+ (mapcar
+ (function
+ (lambda (x)
+ (if (member (cadr x) unread-marks)
+ (car x))))
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))))
+
+(defun elmo-folder-list-importants (folder important-mark)
+ "Returns a list of important message numbers contained in FOLDER.
+IMPORTANT-MARK is the important mark."
+ (let ((list (elmo-folder-list-importants-internal folder important-mark)))
+ (if (listp list)
+ list
+ ;; Not available, use current mark.
+ (delq nil
+ (mapcar
+ (function
+ (lambda (x)
+ (if (string= (cadr x) important-mark)
+ (car x))))
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))))
+
+(luna-define-generic elmo-folder-list-messages-internal (folder)
+ ;; Return a list of message numbers contained in FOLDER.
+ ;; Return t if the message list is not available.
+ )
+
+(luna-define-generic elmo-folder-list-unreads-internal (folder unread-marks)
+ ;; Return a list of unread message numbers contained in FOLDER.
+ ;; Return t if this feature is not available.
+ )
+
+(luna-define-generic elmo-folder-list-importants-internal (folder
+ important-mark)
+ ;; Return a list of important message numbers contained in FOLDER.
+ ;; Return t if this feature is not available.
+ )
+
+(luna-define-generic elmo-folder-list-subfolders (folder &optional one-level)
+ "Returns a list of subfolders contained in FOLDER.
+If optional argument ONE-LEVEL is non-nil, only children of FOLDER is returned.
+(a folder which have children is returned as a list)
+Otherwise, all descendent folders are returned.")
+
+(luna-define-generic elmo-folder-exists-p (folder)
+ "Returns non-nil when FOLDER exists.")
+
+(luna-define-generic elmo-folder-creatable-p (folder)
+ "Returns non-nil when FOLDER is creatable.")
+
+(luna-define-generic elmo-folder-persistent-p (folder)
+ "Return non-nil when FOLDER is persistent.")
+
+(luna-define-generic elmo-folder-create (folder)
+ "Create a FOLDER.")
+
+(luna-define-generic elmo-folder-message-appendable-p (folder)
+ "Returns non-nil when FOLDER is appendable.")
+
+(luna-define-generic elmo-message-deletable-p (folder number)
+ "Returns non-nil when the message in the FOLDER with NUMBER is deletable.")
+
+(luna-define-generic elmo-folder-delete (folder)
+ "Delete FOLDER completely.")
+
+(luna-define-generic elmo-folder-rename (folder new-name)
+ "Rename FOLDER to NEW-NAME (string).")
+
+(luna-define-generic elmo-folder-delete-messages (folder numbers)
+ "Delete messages.
+FOLDER is the ELMO folder structure.
+NUMBERS is a list of message numbers to be deleted.")
+
+(luna-define-generic elmo-folder-search (folder condition &optional numbers)
+ "Search and return list of message numbers.
+FOLDER is the ELMO folder structure.
+CONDITION is a condition string for searching.
+If optional argument NUMBERS is specified and is a list of message numbers,
+messages are searched from the list.")
+
+(luna-define-generic elmo-folder-msgdb-create
+ (folder numbers new-mark already-mark seen-mark important-mark seen-list)
+ "Create a message database (implemented in each backends).
+FOLDER is the ELMO folder structure.
+NUMBERS is a list of message numbers to create msgdb.
+NEW-MARK, ALREADY-MARK, SEEN-MARK, and IMPORTANT-MARK are mark string for
+new message, unread but cached message, read message and important message.
+SEEN-LIST is a list of message-id string which should be treated as read.")
+
+(luna-define-generic elmo-folder-unmark-important (folder numbers)
+ "Un-mark messages as important.
+FOLDER is the ELMO folder structure.
+NUMBERS is a list of message numbers to be processed.")
+
+(luna-define-generic elmo-folder-mark-as-important (folder numbers)
+ "Mark messages as important.
+FOLDER is the ELMO folder structure.
+NUMBERS is a list of message numbers to be processed.")
+
+(luna-define-generic elmo-folder-unmark-read (folder numbers)
+ "Un-mark messages as read.
+FOLDER is the ELMO folder structure.
+NUMBERS is a list of message numbers to be processed.")
+
+(luna-define-generic elmo-folder-mark-as-read (folder numbers)
+ "Mark messages as read.
+FOLDER is the ELMO folder structure.
+NUMBERS is a list of message numbers to be processed.")
+
+(luna-define-generic elmo-folder-append-buffer (folder unread &optional number)
+ "Append current buffer as a new message.
+FOLDER is the destination folder(ELMO folder structure).
+If UNREAD is non-nil, message is appended as unread.
+If optional argument NUMBER is specified, the new message number is set
+(if possible).")
+
+(luna-define-generic elmo-folder-append-messages (folder
+ src-folder
+ numbers
+ unread-marks
+ &optional
+ same-number)
+ "Append messages from folder.
+FOLDER is the ELMO folder structure.
+Make sure FOLDER is `message-appendable'.
+(Can be checked with `elmo-folder-message-appendable-p').
+SRC-FOLDER is the source ELMO folder structure.
+NUMBERS is the message numbers to be appended in the SRC-FOLDER.
+UNREAD-MARKS is a list of unread mark string.
+If second optional argument SAME-NUMBER is specified,
+message number is preserved (if possible).")
+
+(luna-define-generic elmo-folder-pack-numbers (folder)
+ "Pack message numbers of FOLDER.")
+
+(luna-define-generic elmo-folder-update-number (folder)
+ "Update number of FOLDER.")
+
+(luna-define-generic elmo-folder-diff-async (folder)
+ "Get diff of FOLDER asynchronously.")
+
+(luna-define-generic elmo-folder-expand-msgdb-path (folder)
+ "Expand path for FOLDER.")
+
+(luna-define-generic elmo-folder-get-primitive-list (folder)
+ "Get primitive folder structure list contained in FOLDER.")
+
+(luna-define-generic elmo-folder-contains-type (folder type)
+ "Returns t if FOLDER contains TYPE.")
+
+(luna-define-generic elmo-folder-local-p (folder)
+ "Returns t if FOLDER is local.")
+
+(luna-define-generic elmo-folder-message-file-p (folder)
+ "Returns t if all messages in the FOLDER are files.")
+
+;;; Message methods.
+(luna-define-generic elmo-message-use-cache-p (folder number)
+ "Returns t if the message in the FOLDER with NUMBER uses cache.")
+
+(luna-define-generic elmo-message-file-name (folder number)
+ "Return the file name of a message specified by FOLDER and NUMBER.")
+
+;;; For archive
+
+;;; Use original file
+(luna-define-generic elmo-folder-message-file-number-p (folder)
+ "Return t if the file name in the FOLDER is the message number.")
+
+(luna-define-generic elmo-folder-message-file-directory (folder)
+ "Return the directory of the message files of FOLDER.")
+
+;;; Use temporary file
+(luna-define-generic elmo-folder-message-make-temp-file-p (folder)
+ "Return t if the messages in the FOLDER makes local temporary file.")
+
+(luna-define-generic elmo-folder-message-make-temp-files (folder
+ numbers
+ &optional
+ start-number)
+ "Make a new temporary files from the messages in the FOLDER with NUMBERS.
+If START-NUMBER is specified, temporary files begin from the number.
+Otherwise, same number is used for temporary files.
+Return newly created temporary directory name which contains temporary files.")
+
+(luna-define-generic elmo-message-file-p (folder number)
+ "Return t if message in the FOLDER with NUMBER is a file.")
+
+(luna-define-generic elmo-find-fetch-strategy
+ (folder entity &optional ignore-cache)
+;; Returns the message fetching strategy suitable for the message.
+;; FOLDER is the ELMO folder structure.
+;; ENTITY is the overview entity of the message in the folder.
+;; If optional argument IGNORE-CACHE is non-nil, cache is ignored.
+;; Returned value is a elmo-fetch-strategy object.
+;; If return value is nil, message should not be nil.
+ )
+
+(defmacro elmo-make-fetch-strategy (entireness
+ &optional
+ use-cache
+ save-cache
+ cache-path)
+;; Make elmo-message-fetching strategy.
+;; ENTIRENESS is 'entire or 'section.
+;; 'entire means fetch message entirely at once.
+;; 'section means fetch message section by section.
+;; If optional USE-CACHE is non-nil, existing cache is used and otherwise,
+;; existing cache is thrown away.
+;; If SAVE-CACHE is non-nil, fetched message is saved.
+;; CACHE-PATH is the cache path to be used as a message cache file.
+ (` (vector (, entireness)
+ (, use-cache) (, save-cache) (, cache-path))))
+
+(defmacro elmo-fetch-strategy-entireness (strategy)
+ ;; Return entireness of STRATEGY.
+ (` (aref (, strategy) 0)))
+
+(defmacro elmo-fetch-strategy-use-cache (strategy)
+ ;; Return use-cache of STRATEGY.
+ (` (aref (, strategy) 1)))
+
+(defmacro elmo-fetch-strategy-save-cache (strategy)
+ ;; Return save-cache of STRATEGY.
+ (` (aref (, strategy) 2)))
+
+(defmacro elmo-fetch-strategy-cache-path (strategy)
+ ;; Return cache-path of STRATEGY.
+ (` (aref (, strategy) 3)))
+
+(luna-define-method elmo-find-fetch-strategy
+ ((folder elmo-folder) entity &optional ignore-cache)
+ (let (cache-file size message-id number)
+ (setq size (elmo-msgdb-overview-entity-get-size entity))
+ (setq message-id (elmo-msgdb-overview-entity-get-id entity))
+ (setq number (elmo-msgdb-overview-entity-get-number entity))
+ (setq cache-file (elmo-file-cache-get message-id))
+ (if (or ignore-cache
+ (null (elmo-file-cache-status cache-file)))
+ ;; No cache or ignore-cache.
+ (if (and (not (elmo-folder-local-p folder))
+ elmo-message-fetch-threshold
+ (integerp size)
+ (>= size elmo-message-fetch-threshold)
+ (or (not elmo-message-fetch-confirm)
+ (not (prog1 (y-or-n-p
+ (format "Fetch entire message(%dbytes)? "
+ size))
+ (message "")))))
+ ;; Don't fetch message at all.
+ nil
+ ;; Don't use existing cache and fetch entire message at once.
+ (elmo-make-fetch-strategy
+ 'entire nil
+ (elmo-message-use-cache-p folder number)
+ (elmo-file-cache-path cache-file)))
+ ;; Cache exists.
+ (if (not ignore-cache)
+ (elmo-make-fetch-strategy
+ 'entire
+ ;; ...But ignore current section cache and re-fetch
+ ;; if section cache.
+ (not (eq (elmo-file-cache-status cache-file) 'section))
+ ;; Save cache.
+ (elmo-message-use-cache-p folder number)
+ (elmo-file-cache-path cache-file))))))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-folder))
+ t)
+
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-folder) unread-marks)
+ t)
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-folder) important-mark)
+ t)
+
+(defun elmo-message-encache (folder number)
+ (elmo-message-fetch
+ folder number
+ (elmo-make-fetch-strategy 'entire
+ nil ;use-cache
+ t ;save-cache
+ (elmo-file-cache-get-path
+ (elmo-message-field
+ folder number 'message-id)))))
+
+(luna-define-generic elmo-message-fetch (folder number strategy
+ &optional
+ section
+ outbuf
+ unread)
+ "Fetch a message and return as a string.
+FOLDER is the ELMO folder structure.
+NUMBER is the number of the message in the FOLDER.
+STRATEGY is the message fetching strategy.
+If optional argument SECTION is specified, only the SECTION of the message
+is fetched (if possible).
+If second optional argument OUTBUF is specified, fetched message is
+inserted to the buffer and returns t if fetch was ended successfully.
+If third optional argument UNREAD is non-nil, message is not marked as read.
+Returns non-nil if fetching was succeed.")
+
+(luna-define-generic elmo-message-folder (folder number)
+ "Get primitive folder of the message.")
+
+(luna-define-generic elmo-folder-append-msgdb (folder append-msgdb)
+ "Append APPEND-MSGDB to the current msgdb of the folder.")
+
+(luna-define-method elmo-folder-open ((folder elmo-folder))
+ (elmo-generic-folder-open folder))
+
+(defun elmo-generic-folder-open (folder)
+ (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
+ (elmo-folder-open-internal folder))
+
+(luna-define-method elmo-folder-open-internal ((folder elmo-folder))
+ nil ; default is do nothing.
+ )
+
+(luna-define-method elmo-folder-check ((folder elmo-folder))
+ nil) ; default is noop.
+
+(luna-define-method elmo-folder-commit ((folder elmo-folder))
+ (elmo-generic-folder-commit folder))
+
+(defun elmo-generic-folder-commit (folder)
+ (when (elmo-folder-persistent-p folder)
+ (when (elmo-folder-message-modified-internal folder)
+ (elmo-msgdb-overview-save
+ (elmo-folder-msgdb-path folder)
+ (elmo-msgdb-get-overview (elmo-folder-msgdb-internal folder)))
+ (elmo-msgdb-number-save
+ (elmo-folder-msgdb-path folder)
+ (elmo-msgdb-get-number-alist (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-set-info-max-by-numdb
+ folder
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-set-message-modified-internal folder nil)
+ (elmo-msgdb-killed-list-save
+ (elmo-folder-msgdb-path folder)
+ (elmo-folder-killed-list-internal folder)))
+ (when (elmo-folder-mark-modified-internal folder)
+ (elmo-msgdb-mark-save
+ (elmo-folder-msgdb-path folder)
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-set-mark-modified-internal folder nil))))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-folder))
+ ;; do nothing.
+ )
+
+(luna-define-method elmo-folder-close ((folder elmo-folder))
+ (elmo-generic-folder-close folder)
+ (elmo-folder-close-internal folder))
+
+(defun elmo-generic-folder-close (folder)
+ (elmo-folder-commit folder)
+ (elmo-folder-set-msgdb-internal folder nil)
+ (elmo-folder-set-killed-list-internal folder nil))
+
+(luna-define-method elmo-folder-plugged-p ((folder elmo-folder))
+ t) ; default is plugged.
+
+(luna-define-method elmo-folder-set-plugged ((folder elmo-folder) plugged
+ &optional add)
+ nil) ; default is do nothing.
+
+(luna-define-method elmo-folder-use-flag-p ((folder elmo-folder))
+ nil) ; default is no flag.
+
+(luna-define-method elmo-folder-persistent-p ((folder elmo-folder))
+ (elmo-folder-persistent-internal folder))
+
+(luna-define-method elmo-folder-creatable-p ((folder elmo-folder))
+ t) ; default is creatable.
+
+(luna-define-method elmo-folder-writable-p ((folder elmo-folder))
+ t) ; default is writable.
+
+(luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
+ (let* ((new-folder (elmo-make-folder new-name)))
+ (unless (eq (elmo-folder-type-internal folder)
+ (elmo-folder-type-internal new-folder))
+ (error "Not same folder type"))
+ (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
+ (elmo-folder-exists-p new-folder))
+ (error "Already exists folder: %s" new-name))
+ (elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
+ (elmo-msgdb-rename-path folder new-folder)))
+
+(luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
+ nil) ; default is noop.
+
+(luna-define-method elmo-folder-update-number ((folder elmo-folder))
+ nil) ; default is noop.
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-folder))
+ nil) ; default is not file.
+
+(luna-define-method elmo-folder-message-file-number-p ((folder elmo-folder))
+ nil) ; default is not number.
+
+(luna-define-method elmo-folder-message-make-temp-file-p ((folder elmo-folder))
+ nil) ; default is not make temp file.
+
+(luna-define-method elmo-message-file-name ((folder elmo-folder)
+ number)
+ nil) ; default is no name.
+
+(luna-define-method elmo-folder-local-p ((folder elmo-folder))
+ t) ; default is local.
+
+;;; Folder info
+;; Folder info is a message number information cache (hashtable)
+(defsubst elmo-folder-get-info (folder &optional hashtb)
+ "Return FOLDER info from HASHTB (default is `elmo-folder-info-hashtb')."
+ (elmo-get-hash-val (elmo-folder-name-internal folder)
+ (or hashtb elmo-folder-info-hashtb)))
+
+(defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
+ "Set FOLDER info (means MAX, NUMBERS, NEW and UNREAD)."
+ (let ((info (elmo-folder-get-info folder)))
+ (when info
+ (or new (setq new (nth 0 info)))
+ (or unread (setq unread (nth 1 info)))
+ (or numbers (setq numbers (nth 2 info)))
+ (or max (setq max (nth 3 info))))
+ (elmo-set-hash-val (elmo-folder-name-internal folder)
+ (list new unread numbers max)
+ elmo-folder-info-hashtb)))
+
+(defun elmo-folder-set-info-max-by-numdb (folder msgdb-number)
+ "Set FOLDER info by MSGDB-NUMBER in msgdb."
+ (let ((num-db (sort (mapcar 'car msgdb-number) '<)))
+ (elmo-folder-set-info-hashtb
+ folder
+ (or (nth (max 0 (1- (length num-db))) num-db) 0)
+ nil ;;(length num-db)
+ )))
+
+(defun elmo-folder-get-info-max (folder)
+ "Return max number of FODLER from folder info."
+ (nth 3 (elmo-folder-get-info folder)))
+
+(defun elmo-folder-get-info-length (folder)
+ "Return length of FODLER from folder info."
+ (nth 2 (elmo-folder-get-info folder)))
+
+(defun elmo-folder-get-info-unread (folder)
+ "Return unread of FODLER from folder info."
+ (nth 1 (elmo-folder-get-info folder)))
+
+(defun elmo-folder-info-make-hashtb (info-alist hashtb)
+ "Setup folder info hashtable by INFO-ALIST on HASHTB."
+ (let* ((hashtb (or hashtb
+ (elmo-make-hash (length info-alist)))))
+ (mapcar
+ (lambda (x)
+ (let ((info (cadr x)))
+ (and (intern-soft (car x) hashtb)
+ (elmo-set-hash-val (car x)
+ (list (nth 2 info) ;; new
+ (nth 3 info) ;; unread
+ (nth 1 info) ;; length
+ (nth 0 info)) ;; max
+ hashtb))))
+ info-alist)
+ (setq elmo-folder-info-hashtb hashtb)))
+
+(defsubst elmo-strict-folder-diff (folder)
+ "Return folder diff information strictly from FOLDER."
+ (let* ((dir (elmo-folder-msgdb-path folder))
+ (nalist (or (elmo-folder-msgdb-internal folder)
+ (elmo-msgdb-number-load dir)))
+ (in-db (sort (mapcar 'car nalist) '<))
+ (in-folder (elmo-folder-list-messages folder))
+ append-list delete-list diff)
+ (cons (if (equal in-folder in-db)
+ 0
+ (setq diff (elmo-list-diff
+ in-folder in-db
+ nil
+ ))
+ (setq append-list (car diff))
+ (setq delete-list (cadr diff))
+ (if append-list
+ (length append-list)
+ (if delete-list
+ (- 0 (length delete-list))
+ 0)))
+ (length in-folder))))
+
+(luna-define-method elmo-folder-diff ((folder elmo-folder)
+ &optional numbers)
+ (elmo-generic-folder-diff folder numbers))
+
+(defun elmo-generic-folder-diff (folder numbers)
+ (if (elmo-string-match-member (elmo-folder-name-internal folder)
+ elmo-strict-diff-folder-list)
+ (elmo-strict-folder-diff folder)
+ (let ((cached-in-db-max (elmo-folder-get-info-max folder))
+ (in-folder (elmo-folder-status folder))
+ (in-db t)
+ unsync messages
+ in-db-max)
+ (if numbers
+ (setq in-db-max (or (nth (max 0 (1- (length numbers))) numbers)
+ 0))
+ (if (not cached-in-db-max)
+ (let ((number-list (mapcar 'car
+ (elmo-msgdb-number-load
+ (elmo-folder-msgdb-path folder)))))
+ ;; No info-cache.
+ (setq in-db (sort number-list '<))
+ (setq in-db-max (or (nth (max 0 (1- (length in-db))) in-db)
+ 0))
+ (elmo-folder-set-info-hashtb folder in-db-max nil))
+ (setq in-db-max cached-in-db-max)))
+ (setq unsync (if (and in-db
+ (car in-folder))
+ (- (car in-folder) in-db-max)
+ (if (and in-folder
+ (null in-db))
+ (cdr in-folder)
+ (if (null (car in-folder))
+ nil))))
+ (setq messages (cdr in-folder))
+ (if (and unsync messages (> unsync messages))
+ (setq unsync messages))
+ (cons (or unsync 0) (or messages 0)))))
+
+(defvar elmo-folder-diff-async-callback nil)
+(defvar elmo-folder-diff-async-callback-data nil)
+
+(luna-define-method elmo-folder-diff-async ((folder elmo-folder))
+ (and elmo-folder-diff-async-callback
+ (funcall elmo-folder-diff-async-callback
+ folder
+ (elmo-folder-diff folder))))
+
+(luna-define-method elmo-folder-get-primitive-list ((folder elmo-folder))
+ (list folder))
+
+(luna-define-method elmo-folder-contains-type ((folder elmo-folder) type)
+ (eq (elmo-folder-type-internal folder) type))
+
+(luna-define-method elmo-folder-append-messages ((folder elmo-folder)
+ src-folder
+ numbers
+ unread-marks
+ &optional
+ same-number)
+ (elmo-generic-folder-append-messages folder src-folder numbers
+ unread-marks same-number))
+
+(defun elmo-generic-folder-append-messages (folder src-folder numbers
+ unread-marks same-number)
+ (let (unseen seen-list succeed-numbers failure)
+ (with-temp-buffer
+ (while numbers
+ (setq failure nil)
+ (condition-case nil
+ (progn
+ (elmo-message-fetch src-folder (car numbers)
+ (elmo-make-fetch-strategy
+ 'entire)
+ nil (current-buffer)
+ 'unread)
+ (unless (eq (buffer-size) 0)
+ (elmo-folder-append-buffer
+ folder
+ (setq unseen (member (elmo-message-mark
+ src-folder (car numbers))
+ unread-marks))
+ (if same-number (car numbers)))))
+ (error (setq failure t)))
+ ;; FETCH & APPEND finished
+ (unless failure
+ (if unseen (setq seen-list (cons
+ (elmo-message-field
+ src-folder (car numbers)
+ 'message-id)
+ seen-list)))
+ (setq succeed-numbers (cons (car numbers) succeed-numbers)))
+ (setq numbers (cdr numbers)))
+ (if (and seen-list (elmo-folder-persistent-p folder))
+ (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder)
+ (nconc (elmo-msgdb-seen-load
+ (elmo-folder-msgdb-path folder))
+ seen-list)))
+ succeed-numbers)))
+
+;; Arguments should be reduced.
+(defun elmo-folder-move-messages (src-folder msgs dst-folder
+ &optional msgdb all done
+ no-delete-info
+ no-delete
+ same-number
+ unread-marks
+ save-unread)
+ (save-excursion
+ (let* ((messages msgs)
+ (len (length msgs))
+ (all-msg-num (or all len))
+ (done-msg-num (or done 0))
+ (progress-message (if no-delete
+ "Copying messages..."
+ "Moving messages..."))
+ succeeds i result)
+ (unless (eq dst-folder 'null)
+ ;; src is already opened.
+ (when messages
+ (elmo-folder-open-internal dst-folder)
+ (unless (setq succeeds (elmo-folder-append-messages dst-folder
+ src-folder
+ messages
+ unread-marks
+ same-number))
+ (error "move: append message to %s failed"
+ (elmo-folder-name-internal dst-folder)))
+ (elmo-folder-close dst-folder))
+ (when (and (elmo-folder-persistent-p dst-folder)
+ save-unread)
+ ;; Save to seen list.
+ (let* ((dir (elmo-folder-msgdb-path dst-folder))
+ (seen-list (elmo-msgdb-seen-load dir)))
+ (setq seen-list
+ (elmo-msgdb-add-msgs-to-seen-list
+ msgs (elmo-folder-msgdb-internal src-folder)
+ unread-marks seen-list))
+ (elmo-msgdb-seen-save dir seen-list))))
+ (when (and done
+ (> all-msg-num elmo-display-progress-threshold))
+ (elmo-display-progress
+ 'elmo-folder-move-messages progress-message
+ (/ (* done-msg-num 100) all-msg-num)))
+ (if (and (not no-delete) succeeds)
+ (progn
+ (if (not no-delete-info)
+ (message "Cleaning up src folder..."))
+ (if (and (elmo-folder-delete-messages src-folder succeeds)
+ (elmo-msgdb-delete-msgs src-folder succeeds))
+ (setq result t)
+ (message "move: delete messages from %s failed."
+ (elmo-folder-name-internal src-folder))
+ (setq result nil))
+ (if (and result
+ (not no-delete-info))
+ (message "Cleaning up src folder...done"))
+ result)
+ (if no-delete
+ (progn
+ (message "Copying messages...done")
+ t)
+ (if (eq len 0)
+ (message "No message was moved.")
+ (message "Moving messages failed.")
+ nil ; failure
+ ))))))
+
+(defun elmo-folder-msgdb-path (folder)
+ "Return the msgdb path for FOLDER."
+ (or (elmo-folder-path-internal folder)
+ (elmo-folder-set-path-internal
+ folder
+ (elmo-folder-expand-msgdb-path folder))))
+
+(defun elmo-folder-msgdb (folder)
+ "Return the msgdb of FOLDER (on-demand loading)."
+ (or (elmo-folder-msgdb-internal folder)
+ (elmo-msgdb-load folder)))
+
+(defun elmo-message-mark (folder number)
+ "Get mark of the message.
+FOLDER is the ELMO folder structure.
+NUMBER is a number of the message."
+ (cdr (assq number (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))))
+
+(defun elmo-message-field (folder number field)
+ "Get message field value in the msgdb.
+FOLDER is the ELMO folder structure.
+NUMBER is a number of the message.
+FIELD is a symbol of the field."
+ (case field
+ (message-id (elmo-msgdb-overview-entity-get-id
+ (elmo-msgdb-overview-get-entity
+ number (elmo-folder-msgdb folder))))
+ (subject (elmo-msgdb-overview-entity-get-subject
+ (elmo-msgdb-overview-get-entity
+ number (elmo-folder-msgdb folder))))
+ (size (elmo-msgdb-overview-entity-get-size
+ (elmo-msgdb-overview-get-entity
+ number (elmo-folder-msgdb folder))))
+ (date (elmo-msgdb-overview-entity-get-date
+ (elmo-msgdb-overview-get-entity
+ number (elmo-folder-msgdb folder))))
+ (to (elmo-msgdb-overview-entity-get-to
+ (elmo-msgdb-overview-get-entity
+ number (elmo-folder-msgdb folder))))
+ (cc (elmo-msgdb-overview-entity-get-cc
+ (elmo-msgdb-overview-get-entity
+ number (elmo-folder-msgdb folder))))))
+
+(defun elmo-message-set-mark (folder number mark)
+ "Set mark for the message in the FOLDER with NUMBER as MARK."
+ (elmo-msgdb-set-mark-alist
+ (elmo-folder-msgdb-internal folder)
+ (elmo-msgdb-mark-set
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder))
+ number mark)))
+
+(luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number)
+ nil) ; default is not use cache.
+
+(luna-define-method elmo-message-folder ((folder elmo-folder) number)
+ folder) ; default is folder
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-folder) numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-folder) numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) numbers)
+ t)
+
+(defun elmo-generic-folder-append-msgdb (folder append-msgdb)
+ (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
+ (all-alist (copy-sequence (append
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder))
+ number-alist)))
+ (cur number-alist)
+ pair
+ to-be-deleted
+ mark-alist)
+ (while cur
+ (setq all-alist (delq (car cur) all-alist))
+ ;; same message id exists.
+ (if (setq pair (rassoc (cdr (car cur)) all-alist))
+ (setq to-be-deleted (nconc to-be-deleted (list (car pair)))))
+ (setq cur (cdr cur)))
+ (setq mark-alist (elmo-delete-if
+ (function
+ (lambda (x)
+ (memq (car x) to-be-deleted)))
+ (elmo-msgdb-get-mark-alist append-msgdb)))
+ (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
+ (elmo-folder-set-msgdb-internal folder
+ (elmo-msgdb-append
+ (elmo-folder-msgdb-internal folder)
+ append-msgdb t))
+ (length to-be-deleted)))
+
+(luna-define-method elmo-folder-append-msgdb ((folder elmo-folder)
+ append-msgdb)
+ (elmo-generic-folder-append-msgdb folder append-msgdb))
+
+(defun elmo-folder-confirm-appends (appends)
+ (let ((len (length appends))
+ in)
+ (if (and (> len elmo-folder-update-threshold)
+ elmo-folder-update-confirm)
+ (if (y-or-n-p (format "Too many messages(%d). Continue? " len))
+ appends
+ (setq in elmo-folder-update-threshold)
+ (catch 'end
+ (while t
+ (setq in (read-from-minibuffer "Update number: "
+ (int-to-string in))
+ in (string-to-int in))
+ (if (< len in)
+ (throw 'end len))
+ (if (y-or-n-p (format "%d messages are disappeared. OK? "
+ (max (- len in) 0)))
+ (throw 'end in))))
+ (nthcdr (max (- len in) 0) appends))
+ (if (and (> len elmo-folder-update-threshold)
+ (not elmo-folder-update-confirm))
+ (nthcdr (max (- len elmo-folder-update-threshold) 0) appends)
+ appends))))
+
+(defun elmo-folder-synchronize (folder
+ new-mark ;"N"
+ unread-uncached-mark ;"U"
+ unread-cached-mark ;"!"
+ read-uncached-mark ;"u"
+ important-mark ;"$"
+ &optional ignore-msgdb)
+ "Synchronize the folder data to the newest status.
+FOLDER is the ELMO folder structure.
+NEW-MARK, UNREAD-CACHED-MARK, READ-UNCACHED-MARK, and IMPORTANT-MARK
+are mark strings for new messages, unread but cached messages,
+read but not cached messages, and important messages.
+If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except
+read mark status.
+
+Return a list of
+\(NEW-MSGDB DELETE-LIST CROSSED\)
+NEW-MSGDB is the newly appended msgdb.
+DELETE-LIST is a list of deleted message number.
+CROSSED is cross-posted message number."
+ (let ((killed-list (elmo-folder-killed-list-internal folder))
+ (before-append t)
+ number-alist mark-alist
+ old-msgdb diff diff-2 delete-list new-list new-msgdb mark
+ seen-list crossed after-append)
+ (setq old-msgdb (elmo-folder-msgdb-internal folder))
+ ;; Load seen-list.
+ (setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder)))
+ (setq number-alist (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder)))
+ (setq mark-alist (elmo-msgdb-get-mark-alist
+ (elmo-folder-msgdb-internal folder)))
+ (if ignore-msgdb
+ (progn
+ (setq seen-list (nconc
+ (elmo-msgdb-mark-alist-to-seen-list
+ number-alist mark-alist
+ (concat important-mark read-uncached-mark))
+ seen-list))
+ ;; Make killed list as nil.
+ (elmo-folder-set-killed-list-internal folder nil)
+ (elmo-folder-set-msgdb-internal folder
+ (elmo-msgdb-clear))))
+ (elmo-folder-check folder)
+ (condition-case nil
+ (progn
+ (message "Checking folder diff...")
+ ;; TODO: killed list is loaded in elmo-folder-open and
+ ;; list-messages use internal killed-list-folder.
+ (setq diff (elmo-list-diff (elmo-folder-list-messages folder)
+ (unless ignore-msgdb
+ (sort (mapcar
+ 'car
+ number-alist)
+ '<))))
+ (message "Checking folder diff...done")
+ (setq new-list (elmo-folder-confirm-appends (car diff)))
+ ;; Set killed list.
+ (when (and (not (eq (length (car diff))
+ (length new-list)))
+ (setq diff-2 (elmo-list-diff (car diff) new-list)))
+ (elmo-msgdb-append-to-killed-list folder (car diff-2)))
+ ;; Don't delete important marked messages.
+ (setq delete-list
+ (elmo-delete-if
+ (lambda (x)
+ (and (setq mark (cadr (assq x mark-alist)))
+ (string= mark important-mark)))
+ ;; delete message list
+ (cadr diff)))
+ (if (or (equal diff '(nil nil))
+ (equal diff '(nil))
+ (and (eq (length (car diff)) 0)
+ (eq (length (cadr diff)) 0)))
+ (progn
+ ;; NNTP:
+ (elmo-folder-update-number folder)
+ nil ; no update
+ )
+ (if delete-list (elmo-msgdb-delete-msgs folder delete-list))
+ (when new-list
+ (setq new-msgdb (elmo-folder-msgdb-create
+ folder
+ new-list
+ new-mark unread-cached-mark
+ read-uncached-mark important-mark
+ seen-list))
+ (elmo-msgdb-change-mark (elmo-folder-msgdb-internal folder)
+ new-mark unread-uncached-mark)
+ ;; Clear seen-list.
+ (if (elmo-folder-persistent-p folder)
+ (setq seen-list (elmo-msgdb-seen-save
+ (elmo-folder-msgdb-path folder) nil)))
+ (setq before-append nil)
+ (setq crossed (elmo-folder-append-msgdb folder new-msgdb))
+ (elmo-folder-set-message-modified-internal folder t)
+ (elmo-folder-set-mark-modified-internal folder t))
+ ;; return value.
+ (list new-msgdb delete-list crossed)))
+ (quit
+ ;; Resume to the original status.
+ (if before-append
+ (elmo-folder-set-msgdb-internal folder old-msgdb))
+ (elmo-folder-set-killed-list-internal folder killed-list)
+ nil))))
+
+(defun elmo-folder-messages (folder)
+ "Return number of messages in the FOLDER."
+ (length
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder))))
+
+;;;
+(defun elmo-msgdb-search (folder condition msgdb)
+ "Search messages which satisfy CONDITION from FOLDER with MSGDB."
+ (let* ((condition (car (elmo-parse-search-condition condition)))
+ (overview (elmo-msgdb-get-overview msgdb))
+ (number-alist (elmo-msgdb-get-number-alist msgdb))
+ (number-list (mapcar 'car number-alist))
+ (length (length overview))
+ (i 0)
+ result)
+ (if (elmo-condition-find-key condition "body")
+ (elmo-folder-search folder condition number-list)
+ (while overview
+ (if (elmo-msgdb-search-internal condition (car overview)
+ number-list)
+ (setq result
+ (cons
+ (elmo-msgdb-overview-entity-get-number (car overview))
+ result)))
+ (setq i (1+ i))
+ (elmo-display-progress
+ 'elmo-msgdb-search "Searching..." (/ (* i 100) length))
+ (setq overview (cdr overview)))
+ (nreverse result))))
+
+(defun elmo-msgdb-load (folder)
+ (message "Loading msgdb for %s..." (elmo-folder-name-internal folder))
+ (let* ((path (elmo-folder-msgdb-path folder))
+ (overview (elmo-msgdb-overview-load path))
+ (msgdb (list overview
+ (elmo-msgdb-number-load path)
+ (elmo-msgdb-mark-load path)
+ (elmo-msgdb-make-overview-hashtb overview))))
+ (message "Loading msgdb for %s...done" (elmo-folder-name-internal folder))
+ (elmo-folder-set-info-max-by-numdb folder
+ (elmo-msgdb-get-number-alist msgdb))
+ msgdb))
+
+(defun elmo-msgdb-delete-path (folder)
+ (let ((path (elmo-folder-msgdb-path folder)))
+ (if (file-directory-p path)
+ (elmo-delete-directory path t))))
+
+(defun elmo-msgdb-rename-path (old-folder new-folder)
+ (let* ((old (directory-file-name (elmo-folder-msgdb-path old-folder)))
+ (new (directory-file-name (elmo-folder-msgdb-path new-folder)))
+ (new-dir (directory-file-name (file-name-directory new))))
+ (if (not (file-directory-p old))
+ ()
+ (if (file-exists-p new)
+ (error "Already exists directory: %s" new)
+ (if (not (file-exists-p new-dir))
+ (elmo-make-directory new-dir))
+ (rename-file old new)))))
+
+(defun elmo-crosspost-message-set (message-id folders &optional type)
+ (if (assoc message-id elmo-crosspost-message-alist)
+ (setcdr (assoc message-id elmo-crosspost-message-alist)
+ (list folders type))
+ (setq elmo-crosspost-message-alist
+ (nconc elmo-crosspost-message-alist
+ (list (list message-id folders type))))))
+
+(defun elmo-crosspost-message-delete (message-id folders)
+ (let* ((id-fld (assoc message-id elmo-crosspost-message-alist))
+ (folder-list (nth 1 id-fld)))
+ (when id-fld
+ (if (setq folder-list (elmo-list-delete folders folder-list))
+ (setcar (cdr id-fld) folder-list)
+ (setq elmo-crosspost-message-alist
+ (delete id-fld elmo-crosspost-message-alist))))))
+
+(defun elmo-folder-make-temp-dir (folder)
+ ;; Make a temporary directory for FOLDER.
+ (let ((temp-dir (make-temp-name
+ (concat
+ (file-name-as-directory (elmo-folder-msgdb-path folder))
+ "elmo"))))
+ (elmo-make-directory temp-dir)
+ temp-dir))
+
+(defun elmo-quit ()
+ "Quit and cleanup ELMO."
+ ;; Not implemented yet.
+ (let ((types elmo-folder-type-alist)
+ class)
+ (while types
+ (setq class
+ (luna-find-class
+ (intern (format "elmo-%s-folder" (symbol-name (cdr (car types)))))))
+ ;; Call all folder's `elmo-quit' method.
+ (if class
+ (dolist (func (luna-class-find-functions class 'elmo-quit))
+ (funcall func nil)))
+ (setq types (cdr types)))))
+
+
+;;; Define folders.
+(elmo-define-folder ?% 'imap4)
+(elmo-define-folder ?- 'nntp)
+(elmo-define-folder ?\+ 'localdir)
+(elmo-define-folder ?\* 'multi)
+(elmo-define-folder ?\/ 'filter)
+(elmo-define-folder ?\$ 'archive)
+(elmo-define-folder ?& 'pop3)
+(elmo-define-folder ?= 'localnews)
+(elmo-define-folder ?| 'pipe)
+(elmo-define-folder ?. 'maildir)
+(elmo-define-folder ?' 'internal)
+(elmo-define-folder ?[ 'nmz)
+
+(product-provide (provide 'elmo) (require 'elmo-version))
+
+;; elmo.el ends here.
+(provide 'elmo)
+
+;;; elmo.el ends here
+++ /dev/null
-;;; elmo2.el -- ELMO main file (I don't remember why this is 2).
-
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; Keywords: mail, net news
-
-;; This file is part of ELMO (Elisp Library for Message Orchestration).
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-;;
-
-;;; Commentary:
-;;
-
-;;; Code:
-;;
-
-(require 'elmo-version) ; reduce recursive-load-depth
-(require 'elmo-vars)
-(require 'elmo-msgdb)
-(require 'elmo-cache)
-(require 'elmo-util)
-(require 'elmo-dop)
-;;;(provide 'elmo2) ; circular dependency
-
-(eval-when-compile
- (require 'elmo-localdir)
- (require 'elmo-imap4)
- (require 'elmo-nntp)
- (require 'elmo-pop3)
- (require 'elmo-pipe)
-; (require 'elmo-multi)
- (require 'elmo-filter)
- (require 'elmo-archive)
- ;(require 'elmo-cache2)
- )
-
-(if (or (featurep 'dbm)
- (featurep 'gnudbm)
- (featurep 'berkdb)
- (featurep 'berkeley-db))
- (require 'elmo-database))
-
-(elmo-define-error 'elmo-error "Error" 'error)
-(elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error)
-(elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error)
-(elmo-define-error 'elmo-imap4-bye-error "IMAP4 BYE response" 'elmo-open-error)
-
-(defun elmo-quit ()
- (interactive)
- (if (featurep 'elmo-net)
- (elmo-network-clear-session-cache))
- (if (get-buffer elmo-work-buf-name)
- (kill-buffer elmo-work-buf-name)))
-
-(defun elmo-cleanup-variables ()
- (setq elmo-folder-info-hashtb nil
- elmo-nntp-groups-hashtb nil
- elmo-nntp-list-folders-cache nil
- ))
-
-;; (cons of max . estimated message number) elmo-max-of-folder (folder)
-(defun elmo-max-of-folder (folder)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "max-of-folder")
- (elmo-dop-max-of-folder folder)))
-
-;; list elmo-list-folder (folder)
-(defun elmo-list-folder (folder)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "list-folder")
- (elmo-dop-list-folder folder)))
-
-;; list elmo-list-folders (folder)
-(defun elmo-list-folders (folder &optional hierarchy)
- (elmo-call-func folder "list-folders" hierarchy))
-
-;; bool elmo-folder-exists-p (folder)
-(defun elmo-folder-exists-p (folder)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "folder-exists-p")
- (elmo-dop-folder-exists-p folder)))
-
-;; bool elmo-folder-creatable-p (folder)
-(defun elmo-folder-creatable-p (folder)
- (elmo-call-func folder "folder-creatable-p"))
-
-;; bool elmo-create-folder (folder)
-;; create folder
-(defun elmo-create-folder (folder)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "create-folder")
- (elmo-dop-create-folder folder)))
-
-(defun elmo-delete-folder (folder)
- (let ((type (elmo-folder-get-type folder)))
- (if (or (not (memq type '(localdir localnews archive imap4 maildir)))
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "delete-folder")
- (elmo-dop-delete-folder folder)))
- ;; If folder doesn't support delete folder, delete msgdb path only.
- (elmo-msgdb-delete-path folder))))
-
-(defun elmo-rename-folder (old-folder new-folder)
- (let ((old-type (elmo-folder-get-type old-folder))
- (new-type (elmo-folder-get-type new-folder)))
- (if (not (eq old-type new-type))
- (error "not same folder type")
- (unless (and (memq old-type '(localdir localnews archive imap4))
- (elmo-folder-identical-system-p old-folder new-folder))
- (error "rename folder not supported"))
- (if (elmo-folder-plugged-p old-folder)
- (and
- (if (or (file-exists-p (elmo-msgdb-expand-path new-folder))
- (elmo-folder-exists-p new-folder))
- (error "already exists folder: %s" new-folder)
- t)
- (elmo-call-func old-folder "rename-folder"
- (elmo-folder-get-spec new-folder))
- (elmo-msgdb-rename-path old-folder new-folder))
- (elmo-dop-rename-folder old-folder new-folder)))))
-
-(defun elmo-read-msg-no-cache (folder msg outbuf)
- "Read messsage specified by FOLDER and MSG(number) into OUTBUF
-without cacheing."
- (elmo-call-func folder "read-msg" msg outbuf))
-
-(defun elmo-force-cache-msg (folder number msgid &optional loc-alist)
- "Force cache message."
- (let* ((cache-file (elmo-cache-get-path msgid))
- dir)
- (when cache-file
- (setq dir (directory-file-name (file-name-directory cache-file)))
- (if (not (file-exists-p dir))
- (elmo-make-directory dir))
- (if (elmo-local-file-p folder number)
- (elmo-copy-file (elmo-get-msg-filename folder number loc-alist)
- cache-file)
- (with-temp-buffer
- (elmo-call-func folder "read-msg" number (current-buffer))
- (as-binary-output-file
- (write-region (point-min) (point-max) cache-file nil 'no-msg)))))))
-
-(defun elmo-prefetch-msg (folder msg outbuf msgdb)
- "Read message into outbuf with cacheing."
- (save-excursion
- (let* ((number-alist (elmo-msgdb-get-number-alist
- (or msgdb (elmo-msgdb-load folder))))
- (dir (elmo-msgdb-expand-path folder))
- (message-id (cdr (assq msg number-alist)))
- type
- cache-status
- ret-val part-num real-fld-num)
- (set-buffer outbuf)
- (if (elmo-cache-exists-p message-id)
- t
- ;; cache doesn't exist.
- (setq real-fld-num (elmo-get-real-folder-number
- folder msg))
- (setq type (elmo-folder-get-type (car real-fld-num)))
- (cond ((eq type 'imap4)
- (setq ret-val (elmo-imap4-prefetch-msg
- (elmo-folder-get-spec (car real-fld-num))
- (cdr real-fld-num)
- outbuf)))
- ((elmo-folder-local-p (car real-fld-num)))
- (t (setq ret-val (elmo-call-func (car real-fld-num)
- "read-msg"
- (cdr real-fld-num) outbuf))))
- (if ret-val
- (elmo-cache-save message-id
- (elmo-string-partial-p ret-val)
- folder msg))
- (and ret-val t)))))
-
-(defun elmo-prefetch-msgs (folder msgs)
- "prefetch messages for queueing."
- (let* ((msgdb (elmo-msgdb-load folder))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (len (length msgs))
- (count 0)
- msgid msg)
- (while msgs
- (setq msg (car msgs))
- (setq msgid (cdr (assq msg number-alist)))
- (message "%s:Prefetching... %d/%d message(s)"
- folder
- (setq count (+ 1 count)) len)
- (elmo-force-cache-msg folder msg msgid)
- (setq msgs (cdr msgs)))))
-
-;; elmo-read-msg (folder msg outbuf msgdb)
-;;; read message
-(defun elmo-read-msg (folder msg outbuf msgdb &optional force-reload)
- "Read message into outbuf."
- (let ((inhibit-read-only t))
- ;;Only use elmo-read-msg-with-cache, because if folder is network and
- ;;elmo-use-cache-p is nil, cannot read important msg. (by muse)
- ;;(if (not (elmo-use-cache-p folder msg))
- ;; (elmo-read-msg-no-cache folder msg outbuf)
- (elmo-read-msg-with-cache folder msg outbuf msgdb force-reload)))
-
-(defun elmo-read-msg-with-cache (folder msg outbuf msgdb
- &optional force-reload)
- "Read message into outbuf with cacheing."
- (let* ((number-alist (elmo-msgdb-get-number-alist
- (or msgdb (elmo-msgdb-load folder))))
- (dir (elmo-msgdb-expand-path folder))
- (message-id (cdr (assq msg number-alist)))
- (type (elmo-folder-number-get-type folder msg))
- cache-status
- ret-val part-num real-fld-num)
- (set-buffer outbuf)
- (if (and (not force-reload)
- (not (elmo-local-file-p folder msg)))
- (setq ret-val (elmo-cache-read message-id folder msg)))
- (if ret-val
- t
- ;; cache doesn't exist.
- (setq real-fld-num (elmo-get-real-folder-number
- folder msg))
- (if (setq ret-val (elmo-call-func (car real-fld-num)
- "read-msg"
- (cdr real-fld-num) outbuf))
- (if (and message-id
- (not (elmo-local-file-p folder msg))
- (elmo-use-cache-p folder msg))
- (elmo-cache-save message-id
- (elmo-string-partial-p ret-val)
- folder msg)))
- (and ret-val t))))
-
-(defun elmo-copy-msgs (src-folder msgs dst-folder &optional msgdb same-number)
- (let* ((src-spec (elmo-folder-get-spec src-folder))
- (loc-alist (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load
- (elmo-msgdb-expand-path src-spec)))))
- (if (eq (car src-spec) 'archive)
- (elmo-archive-copy-msgs-froms
- (elmo-folder-get-spec dst-folder)
- msgs src-spec loc-alist same-number)
- (elmo-call-func dst-folder "copy-msgs"
- msgs src-spec loc-alist same-number))))
-
-(defun elmo-move-msgs (src-folder msgs dst-folder
- &optional msgdb all done
- no-delete-info
- no-delete
- same-number
- unread-marks)
- (save-excursion
- (let* ((db (or msgdb (elmo-msgdb-load src-folder)))
- (number-alist (elmo-msgdb-get-number-alist db))
- (mark-alist (elmo-msgdb-get-mark-alist db))
- (messages msgs)
- (len (length msgs))
- (all-msg-num (or all len))
- (done-msg-num (or done 0))
- (progress-message (if no-delete
- "Copying messages..."
- "Moving messages..."))
- (tmp-buf (get-buffer-create " *elmo-move-msg*"))
- ;elmo-no-cache-flag
- ret-val real-fld-num done-copy dir pair
- mes-string message-id src-cache i unseen seen-list)
- (setq i done-msg-num)
- (set-buffer tmp-buf)
- (when (and (not (eq dst-folder 'null))
- (elmo-folder-direct-copy-p src-folder dst-folder))
- (message (concat (if no-delete "Copying" "Moving")
- " %d message(s)...") (length messages))
- (unless (elmo-copy-msgs src-folder
- messages
- dst-folder
- db
- same-number)
- (error "Copy message to %s failed" dst-folder))
- (setq done-copy t))
- (while messages
- (setq real-fld-num (elmo-get-real-folder-number src-folder
- (car messages)))
- (setq message-id (cdr (setq pair (assq (car messages) number-alist))))
- ;; seen-list.
- (if (and (not (eq dst-folder 'null))
- (not (and unread-marks
- (setq unseen
- (member
- (cadr (assq (car messages) mark-alist))
- unread-marks)))))
- (setq seen-list (cons message-id seen-list)))
- (unless (or (eq dst-folder 'null) done-copy)
- (if (and (elmo-folder-plugged-p src-folder)
- (elmo-folder-plugged-p dst-folder)
- (elmo-folder-identical-system-p (car real-fld-num)
- dst-folder))
- ;; online and identical system...so copy 'em!
- (unless
- (elmo-copy-msgs (car real-fld-num)
- (list (cdr real-fld-num))
- dst-folder
- db
- same-number)
- (error "Copy message to %s failed" dst-folder))
- ;; use cache if exists.
- ;; if there's other message with same message-id,
- ;; don't use cache.
- (elmo-read-msg src-folder (car messages)
- tmp-buf msgdb
- (and (elmo-folder-plugged-p src-folder)
- (and pair
- (or
- (rassoc
- message-id
- (cdr (memq pair number-alist)))
- (not (eq pair
- (rassoc message-id
- number-alist)))))))
- (unless (eq (buffer-size) 0)
- (unless (elmo-append-msg dst-folder (buffer-string) message-id
- (if same-number (car messages))
- ;; null means all unread.
- (or (null unread-marks)
- unseen))
- (error "move: append message to %s failed" dst-folder)))))
- ;; delete src cache if it is partial.
- (elmo-cache-delete-partial message-id src-folder (car messages))
- (setq ret-val (nconc ret-val (list (car messages))))
- (when (> all-msg-num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (elmo-display-progress
- 'elmo-move-msgs progress-message
- (/ (* i 100) all-msg-num)))
- (setq messages (cdr messages)))
- ;; Save seen-list.
- (unless (eq dst-folder 'null)
- (setq dir (elmo-msgdb-expand-path dst-folder))
- (elmo-msgdb-seen-save dir
- (append (elmo-msgdb-seen-load dir) seen-list)))
- (kill-buffer tmp-buf)
- (if (and (not no-delete) ret-val)
- (progn
- (if (not no-delete-info)
- (message "Cleaning up src folder..."))
- (if (and (elmo-delete-msgs src-folder ret-val db)
- (elmo-msgdb-delete-msgs src-folder ret-val db t))
- (setq ret-val t)
- (message "move: delete messages from %s failed." src-folder)
- (setq ret-val nil)
- )
- (if (and ret-val
- (not no-delete-info))
- (message "Cleaning up src folder...done")
- )
- ret-val)
- (if no-delete
- (progn
- (message "Copying messages...done")
- t)
- (if (eq len 0)
- (message "No message was moved.")
- (message "Moving messages failed.")
- nil ; failure
- ))))))
-
-;; boolean elmo-delete-msgs (folder msgs)
-(defun elmo-delete-msgs (folder msgs &optional msgdb)
- ;; remove from real folder.
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "delete-msgs" msgs)
- (elmo-dop-delete-msgs folder msgs msgdb)))
-
-(defun elmo-search (folder condition &optional from-msgs)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "search" condition from-msgs)
- (elmo-cache-search-all folder condition from-msgs)))
-
-(defun elmo-msgdb-search (folder condition msgdb)
- "Search messages which satisfy CONDITION from FOLDER with MSGDB."
- (let* ((condition (car (elmo-parse-search-condition condition)))
- (overview (elmo-msgdb-get-overview msgdb))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (number-list (mapcar 'car number-alist))
- (length (length overview))
- (i 0)
- result)
- (if (elmo-condition-find-key condition "body")
- (elmo-search folder condition number-list)
- (while overview
- (if (elmo-msgdb-search-internal condition (car overview)
- number-list)
- (setq result
- (cons
- (elmo-msgdb-overview-entity-get-number (car overview))
- result)))
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-msgdb-search "Searching..." (/ (* i 100) length))
- (setq overview (cdr overview)))
- (nreverse result))))
-
-(defun elmo-msgdb-create (folder numlist new-mark already-mark
- seen-mark important-mark seen-list)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
- seen-mark important-mark seen-list)
- (elmo-dop-msgdb-create folder numlist new-mark already-mark
- seen-mark important-mark seen-list)))
-
-(defun elmo-make-folder-numbers-list (folder msgs)
- (let ((msg-list msgs)
- pair fld-list
- ret-val)
- (while msg-list
- (when (and (numberp (car msg-list))
- (> (car msg-list) 0))
- (setq pair (elmo-get-real-folder-number folder (car msg-list)))
- (if (setq fld-list (assoc (car pair) ret-val))
- (setcdr fld-list (cons (cdr pair) (cdr fld-list)))
- (setq ret-val (cons (cons (car pair) (list (cdr pair))) ret-val))))
- (setq msg-list (cdr msg-list)))
- ret-val))
-
-(defun elmo-call-func-on-markable-msgs (folder func-name msgs msgdb)
- "Returns t if marked."
- (save-match-data
- (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
- type error)
- (while folder-numbers
- (if (or (eq
- (setq type (car
- (elmo-folder-get-spec
- (car (car folder-numbers)))))
- 'imap4)
- (memq type '(maildir internal)))
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func (car (car folder-numbers)) func-name
- (cdr (car folder-numbers)))
- (if elmo-enable-disconnected-operation
- (elmo-dop-call-func-on-msgs
- (car (car folder-numbers)) ; real folder
- func-name
- (cdr (car folder-numbers)) ; real number
- msgdb)
- (setq error t))))
- (setq folder-numbers (cdr folder-numbers)))
- (not error))))
-
-(defun elmo-unmark-important (folder msgs msgdb)
- (elmo-call-func-on-markable-msgs folder "unmark-important" msgs msgdb))
-
-(defun elmo-mark-as-important (folder msgs msgdb)
- (elmo-call-func-on-markable-msgs folder "mark-as-important" msgs msgdb))
-
-(defun elmo-mark-as-read (folder msgs msgdb)
- (elmo-call-func-on-markable-msgs folder "mark-as-read" msgs msgdb))
-
-(defun elmo-mark-as-unread (folder msgs msgdb)
- (elmo-call-func-on-markable-msgs folder "mark-as-unread" msgs msgdb))
-
-(defun elmo-msgdb-create-as-numlist (folder numlist new-mark already-mark
- seen-mark important-mark seen-list)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "msgdb-create-as-numlist" numlist
- new-mark already-mark seen-mark important-mark seen-list)
- (elmo-dop-msgdb-create-as-numlist
- folder numlist new-mark already-mark
- seen-mark important-mark seen-list)))
-
-;; msgdb elmo-msgdb-load (folder)
-(defun elmo-msgdb-load (folder)
- (message "Loading msgdb for %s..." folder)
- (let* ((path (elmo-msgdb-expand-path folder))
- (overview (elmo-msgdb-overview-load path))
- (ret-val
- (list overview
- (elmo-msgdb-number-load path)
- (elmo-msgdb-mark-load path)
- (elmo-msgdb-location-load path)
- (elmo-msgdb-make-overview-hashtb overview)
- )))
- (message "Loading msgdb for %s...done" folder)
- (elmo-folder-set-info-max-by-numdb folder (nth 1 ret-val))
- ret-val))
-
-;; boolean elmo-msgdb-save (folder msgdb)
-(defun elmo-msgdb-save (folder msgdb)
- (message "Saving msgdb for %s..." folder)
- (save-excursion
- (let ((path (elmo-msgdb-expand-path folder)))
- (elmo-msgdb-overview-save path (car msgdb))
- (elmo-msgdb-number-save path (cadr msgdb))
- (elmo-msgdb-mark-save path (caddr msgdb))
- (elmo-msgdb-location-save path (cadddr msgdb))
- ;(elmo-sync-validity folder);; for validity check!!
- ))
- (message "Saving msgdb for %s...done" folder)
- (elmo-folder-set-info-max-by-numdb folder (cadr msgdb)))
-
-(defun elmo-msgdb-add-msgs-to-seen-list-subr (msgs msgdb seen-marks seen-list)
- "Add to seen list."
- (let* ((seen-mark-list (string-to-char-list seen-marks))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- ent)
- (while msgs
- (if (setq ent (assq (car msgs) mark-alist))
- (if (memq (string-to-char (cadr ent)) seen-mark-list)
- (setq seen-list
- (cons (cdr (assq (car msgs) number-alist)) seen-list)))
- ;; no mark ... seen...
- (setq seen-list
- (cons (cdr (assq (car msgs) number-alist)) seen-list)))
- (setq msgs (cdr msgs)))
- seen-list))
-
-(defun elmo-msgdb-add-msgs-to-seen-list (folder msgs msgdb seen-marks)
- "Add to seen list."
- (unless (eq folder 'null) ;; black hole
- (let* ((dir (elmo-msgdb-expand-path folder))
- (seen-list (elmo-msgdb-seen-load dir)))
- (setq seen-list
- (elmo-msgdb-add-msgs-to-seen-list-subr
- msgs msgdb seen-marks seen-list))
- (elmo-msgdb-seen-save dir seen-list))))
-
-;; msgdb elmo-append-msg (folder string)
-(defun elmo-append-msg (folder string &optional message-id msg no-see)
- (let ((type (elmo-folder-get-type folder))
- filename)
- (cond ((eq type 'imap4)
- (if (elmo-folder-plugged-p folder)
- (elmo-call-func folder "append-msg" string msg no-see)
- (elmo-dop-append-msg folder string message-id)))
- ((eq type 'cache)
- (if message-id
- (elmo-cache-append-msg
- (elmo-folder-get-spec folder)
- string message-id msg no-see)
- (error "elmo-cache-append-msg require message-id")))
- (t
- (elmo-call-func folder "append-msg" string msg no-see)))))
-
-(defun elmo-check-validity (folder)
- (elmo-call-func folder "check-validity"
- (expand-file-name
- elmo-msgdb-validity-filename
- (elmo-msgdb-expand-path folder))))
-
-(defun elmo-pack-number (folder msgdb arg)
- (let ((type (elmo-folder-get-type folder)))
- (if (memq type '(localdir localnews maildir))
- (elmo-call-func folder "pack-number" msgdb arg)
- (error "pack-number not supported"))))
-
-(defun elmo-sync-validity (folder)
- (elmo-call-func folder "sync-validity"
- (expand-file-name
- elmo-msgdb-validity-filename
- (elmo-msgdb-expand-path folder))))
-
-(defun elmo-use-cache-p (folder number)
- (elmo-call-func folder "use-cache-p" number)
- )
-
-(defun elmo-local-file-p (folder number)
- (elmo-call-func folder "local-file-p" number))
-
-(defun elmo-folder-portinfo (folder)
- (condition-case nil
- (elmo-call-func folder "portinfo")
- (error)))
-
-(defun elmo-folder-plugged-p (folder)
- (and folder
- (or (elmo-folder-local-p folder)
- (elmo-call-func folder "plugged-p"))))
-
-(defun elmo-folder-set-plugged (folder plugged &optional add)
- (if (elmo-folder-local-p folder)
- nil ;; nop
- (elmo-call-func folder "set-plugged" plugged add)))
-
-(defun elmo-generic-sync-number-alist (spec number-alist)
- "Just return number-alist."
- number-alist)
-
-(defun elmo-generic-list-folder-important (spec number-alist)
- nil)
-
-(defun elmo-update-number (folder msgdb)
- (when (elmo-folder-plugged-p folder)
- (message "Synchronize number...")
- (let* ((numlist (elmo-msgdb-get-number-alist msgdb))
- (len (length numlist))
- new-numlist)
- (if (eq (length (setq
- new-numlist
- (elmo-call-func folder "sync-number-alist" numlist)))
- len)
- nil
- (elmo-msgdb-set-number-alist msgdb new-numlist)
- (message "Synchronize number...done")
- new-numlist))))
-
-(defun elmo-get-msg-filename (folder number &optional loc-alist)
- "Available if elmo-local-file-p is t."
- (elmo-call-func folder "get-msg-filename" number loc-alist))
-
-(defun elmo-strict-folder-diff (fld &optional number-alist)
- (interactive)
- (let* ((dir (elmo-msgdb-expand-path fld))
- (nalist (or number-alist
- (elmo-msgdb-number-load dir)))
- (in-db (sort (mapcar 'car nalist) '<))
- (in-folder (elmo-list-folder fld))
- append-list delete-list diff)
- (cons (if (equal in-folder in-db)
- 0
- (setq diff (elmo-list-diff
- in-folder in-db
- nil
- ))
- (setq append-list (car diff))
- (setq delete-list (cadr diff))
- (if append-list
- (length append-list)
- (if delete-list
- (- 0 (length delete-list))
- 0)))
- (length in-folder))))
-
-(defun elmo-list-folder-unread (folder number-alist mark-alist unread-marks)
- (elmo-call-func folder "list-folder-unread"
- number-alist mark-alist unread-marks))
-
-(defun elmo-list-folder-important (folder number-alist)
- (let (importants)
- ;; Server side importants...(append only.)
- (if (elmo-folder-plugged-p folder)
- (setq importants (elmo-call-func folder "list-folder-important"
- number-alist)))
- (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir))))
- (while number-alist
- (if (assoc (cdr (car number-alist))
- elmo-msgdb-global-mark-alist)
- (setq importants (cons (car (car number-alist)) importants)))
- (setq number-alist (cdr number-alist)))
- importants))
-
-(defun elmo-generic-commit (folder)
- nil)
-
-(defun elmo-commit (folder)
- (elmo-call-func folder "commit"))
-
-(defun elmo-clear-killed (folder)
- (elmo-msgdb-killed-list-save (elmo-msgdb-expand-path folder) nil))
-
-(defvar elmo-folder-diff-async-callback nil)
-(defvar elmo-folder-diff-async-callback-data nil)
-
-(defun elmo-folder-diff-async (folder)
- "Get diff of FOLDER asynchronously.
-`elmo-folder-diff-async-callback' is called with arguments of
-FOLDER and DIFF (cons cell of UNSEEN and MESSAGES).
-Currently works on IMAP4 folder only."
- (if (eq (elmo-folder-get-type folder) 'imap4)
- ;; Only works on imap4 with server diff.
- (progn
- (setq elmo-imap4-server-diff-async-callback
- elmo-folder-diff-async-callback)
- (setq elmo-imap4-server-diff-async-callback-data
- elmo-folder-diff-async-callback-data)
- (elmo-imap4-server-diff-async (elmo-folder-get-spec folder)))
- (and elmo-folder-diff-async-callback
- (funcall elmo-folder-diff-async-callback
- folder
- (elmo-folder-diff folder)))))
-
-(defun elmo-folder-diff (folder &optional number-list)
- "Get diff of FOLDER.
-Return value is a cons cell of NEW and MESSAGES.
-If optional argumnet NUMBER-LIST is set, it is used as a
-message list in msgdb. Otherwise, number-list is load from msgdb."
- (elmo-call-func folder "folder-diff" folder number-list))
-
-(defun elmo-crosspost-message-set (message-id folders &optional type)
- (if (assoc message-id elmo-crosspost-message-alist)
- (setcdr (assoc message-id elmo-crosspost-message-alist)
- (list folders type))
- (setq elmo-crosspost-message-alist
- (nconc elmo-crosspost-message-alist
- (list (list message-id folders type))))))
-
-(defun elmo-crosspost-message-delete (message-id folders)
- (let* ((id-fld (assoc message-id elmo-crosspost-message-alist))
- (folder-list (nth 1 id-fld)))
- (when id-fld
- (if (setq folder-list (elmo-list-delete folders folder-list))
- (setcar (cdr id-fld) folder-list)
- (setq elmo-crosspost-message-alist
- (delete id-fld elmo-crosspost-message-alist))))))
-
-
-(defun elmo-get-msgs-with-mark (mark-alist mark)
- (let (ret-val)
- (while mark-alist
- (if (string= (cadr (car mark-alist)) mark)
- (cons (car (car mark-alist)) ret-val))
- (setq mark-alist (cdr mark-alist)))
- (nreverse ret-val)))
-
-(defun elmo-buffer-cache-message (fld msg &optional msgdb force-reload)
- (let* ((msg-id (cdr (assq msg (elmo-msgdb-get-number-alist msgdb))))
- (hit (elmo-buffer-cache-hit (list fld msg msg-id)))
- (read nil))
- (if hit
- (elmo-buffer-cache-sort
- (elmo-buffer-cache-entry-make (list fld msg msg-id) hit))
- (setq hit (elmo-buffer-cache-add (list fld msg msg-id)))
- (setq read t))
- (if (or force-reload read)
- (condition-case err
- (save-excursion
- (set-buffer hit)
- (elmo-read-msg fld msg
- (current-buffer)
- msgdb force-reload))
- (quit
- (elmo-buffer-cache-delete)
- (error "read message %s/%s is quitted" fld msg))
- (error
- (elmo-buffer-cache-delete)
- (signal (car err) (cdr err))
- nil))) ;; will not be used
- hit)) ;; retrun value
-
-(defun elmo-read-msg-with-buffer-cache (fld msg outbuf msgdb &optional force-reload)
- (if elmo-use-buffer-cache
- (let (hit start end)
- (when (setq hit (elmo-buffer-cache-message
- (elmo-string fld) msg
- msgdb force-reload))
- (erase-buffer)
- (save-excursion
- (set-buffer hit)
- (setq start (point-min) end (point-max)))
- (insert-buffer-substring hit start end)))
- (elmo-read-msg fld msg outbuf msgdb force-reload)))
-
-(defun elmo-folder-pipe-p (folder)
- (let ((type (elmo-folder-get-type folder)))
- (cond
- ((eq type 'multi)
- (let ((flds (cdr (elmo-folder-get-spec folder))))
- (catch 'done
- (while flds
- (if (elmo-folder-pipe-p (car flds))
- (throw 'done t)))
- nil)))
- ((eq type 'pipe)
- t)
- ((eq type 'filter)
- (elmo-folder-pipe-p
- (nth 2 (elmo-folder-get-spec folder))))
- (t
- nil
- ))))
-
-(defun elmo-multi-p (folder)
- (let ((type (elmo-folder-get-type folder)))
- (cond
- ((eq type 'multi)
- t)
- ((eq type 'pipe)
- (elmo-multi-p
- (elmo-pipe-spec-dst (elmo-folder-get-spec folder))))
- ((eq type 'filter)
- (elmo-multi-p
- (nth 2 (elmo-folder-get-spec folder))))
- (t
- nil
- ))))
-
-(defun elmo-get-real-folder-number (folder number)
- (let ((type (elmo-folder-get-type folder)))
- (cond
- ((eq type 'multi)
- (elmo-multi-get-real-folder-number folder number))
- ((eq type 'pipe)
- (elmo-get-real-folder-number
- (elmo-pipe-spec-dst (elmo-folder-get-spec folder) )
- number))
- ((eq type 'filter)
- (elmo-get-real-folder-number
- (nth 2 (elmo-folder-get-spec folder)) number))
- (t
- (cons folder number)
- ))))
-
-(defun elmo-folder-get-primitive-spec-list (folder &optional spec-list)
- (let ((type (elmo-folder-get-type folder))
- specs)
- (cond
- ((or (eq type 'multi)
- (eq type 'pipe))
- (let ((flds (cdr (elmo-folder-get-spec folder)))
- spec)
- (while flds
- (setq spec (elmo-folder-get-primitive-spec-list (car flds)))
- (if (not (memq (car spec) specs))
- (setq specs (append specs spec)))
- (setq flds (cdr flds)))))
- ((eq type 'filter)
- (setq specs
- (elmo-folder-get-primitive-spec-list
- (nth 2 (elmo-folder-get-spec folder)))))
- (t
- (setq specs (list (elmo-folder-get-spec folder)))
- ))
- specs))
-
-(defun elmo-folder-get-primitive-folder-list (folder)
- (let* ((type (elmo-folder-get-type folder)))
- (cond
- ((or (eq type 'multi)
- (eq type 'pipe))
- (let ((flds (cdr (elmo-folder-get-spec folder)))
- ret-val)
- (while flds
- (setq ret-val (append ret-val
- (elmo-folder-get-primitive-folder-list
- (car flds))))
- (setq flds (cdr flds)))
- ret-val))
- ((eq type 'filter)
- (elmo-folder-get-primitive-folder-list
- (nth 2 (elmo-folder-get-spec folder))))
- (t
- (list folder)
- ))))
-
-(defun elmo-folder-contains-multi (folder)
- (let ((cur-spec (elmo-folder-get-spec folder)))
- (catch 'done
- (while cur-spec
- (cond
- ((eq (car cur-spec) 'filter)
- (setq cur-spec (elmo-folder-get-spec (nth 2 cur-spec))))
- ((eq (car cur-spec) 'pipe)
- (setq cur-spec (elmo-folder-get-spec (elmo-pipe-spec-src cur-spec))))
- ((eq (car cur-spec) 'multi)
- (throw 'done nil))
- (t (setq cur-spec nil)))))
- cur-spec))
-
-(defun elmo-folder-contains-type (folder type)
- (let ((spec (elmo-folder-get-spec folder)))
- (cond
- ((eq (car spec) 'filter)
- (elmo-folder-contains-type (nth 2 spec) type))
- ((eq (car spec) 'pipe)
- (elmo-folder-contains-type (elmo-pipe-spec-dst spec) type))
- ((eq (car spec) 'multi)
- (let ((folders (cdr spec)))
- (catch 'done
- (while folders
- (if (elmo-folder-contains-type (car folders) type)
- (throw 'done t))
- (setq folders (cdr folders))))))
- ((eq (car spec) type)
- t)
- (t nil))))
-
-(defun elmo-folder-number-get-spec (folder number)
- (let ((type (elmo-folder-get-type folder)))
- (cond
- ((eq type 'multi)
- (elmo-multi-folder-number-get-spec folder number))
- ((eq type 'pipe)
- (elmo-folder-number-get-spec
- (elmo-pipe-spec-dst (elmo-folder-get-spec folder)) number))
- ((eq type 'filter)
- (elmo-folder-number-get-spec
- (nth 2 (elmo-folder-get-spec folder)) number))
- (t
- (elmo-folder-get-spec folder)
- ))))
-
-(defun elmo-folder-number-get-type (folder number)
- (car (elmo-folder-number-get-spec folder number)))
-
-(defun elmo-multi-folder-number-get-spec (folder number)
- (let* ((spec (elmo-folder-get-spec folder))
- (flds (cdr spec))
- (fld (nth (- (/ number elmo-multi-divide-number) 1) flds)))
- (elmo-folder-number-get-spec fld number)))
-
-;; autoloads
-(autoload 'elmo-nntp-make-groups-hashtb "elmo-nntp")
-(autoload 'elmo-nntp-post "elmo-nntp")
-(autoload 'elmo-localdir-max-of-folder "elmo-localdir")
-(autoload 'elmo-localdir-msgdb-create-overview-entity-from-file "elmo-localdir")
-(autoload 'elmo-archive-copy-msgs-froms "elmo-archive")
-
-(require 'product)
-(product-provide (provide 'elmo2) (require 'elmo-version))
-
-;;; elmo2.el ends here
--- /dev/null
+;;; mmimap.el --- MIME entity module for IMAP4rev1 (RFC2060).
+;; **** This is EXPERIMENTAL *****
+
+;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: IMAP, MIME, multimedia, mail, news
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'mmgeneric)
+(require 'mime)
+(require 'pces)
+
+(eval-and-compile
+ (luna-define-class mime-imap-entity (mime-entity)
+ (size header-string body-string new))
+ (luna-define-internal-accessors 'mime-imap-entity))
+
+;;; @ MIME IMAP location
+;; It should contain server, mailbox and uid (sequence number).
+(eval-and-compile
+ (luna-define-class mime-imap-location () ()))
+
+(luna-define-generic mime-imap-location-section-body (location section)
+ "Return a body string from LOCATION which corresponds to SECTION.
+SECTION is a section string which is defined in RFC2060.")
+
+(luna-define-generic mime-imap-location-bodystructure (location)
+ "Return a parsed bodystructure of LOCATION.
+`NIL' should be converted to nil, `astring' should be converted to a string.")
+
+;;; @ Subroutines
+;;
+
+(defun mmimap-entity-section (node-id)
+ "Return a section string from NODE-ID"
+ (cond
+ ((numberp node-id)
+ (number-to-string (1+ node-id)))
+ ((listp node-id)
+ (mapconcat
+ 'mmimap-entity-section
+ (reverse node-id)
+ "."))))
+
+(defun mmimap-parse-parameters-from-list (attrlist)
+ "Parse parameters from ATTRLIST."
+ (let (ret-val)
+ (while attrlist
+ (setq ret-val (append ret-val
+ (list (cons (downcase (car attrlist))
+ (car (cdr attrlist))))))
+ (setq attrlist (cdr (cdr attrlist))))
+ ret-val))
+
+(defun mmimap-make-mime-entity (bodystructure class location node-id parent)
+ "Analyze parsed IMAP4 BODYSTRUCTURE response and make MIME entity.
+CLASS, LOCATION, NODE-ID, PARENT are set to the returned entity."
+ (cond
+ ((listp (car bodystructure)) ; multipart
+ (let ((num 0)
+ curp children content-type entity)
+ (setq entity
+ (luna-make-entity
+ class
+ :new t
+ :parent parent
+ :location location
+ :node-id node-id))
+ (while (and (setq curp (car bodystructure))
+ (listp curp))
+ (setq children
+ (nconc children
+ (list
+ (mmimap-make-mime-entity curp class
+ location
+ (nconc (list num) node-id)
+ entity))))
+ (setq num (+ num 1))
+ (setq bodystructure (cdr bodystructure)))
+ (mime-entity-set-children-internal entity children)
+ (setq content-type (list (cons 'type 'multipart)))
+ (if (car bodystructure)
+ (setq content-type (nconc content-type
+ (list (cons 'subtype
+ (intern
+ (downcase
+ (car
+ bodystructure))))))))
+ (setq content-type (append content-type
+ (mmimap-parse-parameters-from-list
+ (nth 1 bodystructure))))
+ (mime-entity-set-content-type-internal entity content-type)
+ entity))
+ (t ; singlepart
+ (let (content-type entity)
+ (setq content-type
+ (list (cons 'type (intern (downcase (car bodystructure))))))
+ (if (nth 1 bodystructure)
+ (setq content-type (append content-type
+ (list
+ (cons 'subtype
+ (intern
+ (downcase
+ (nth 1 bodystructure))))))))
+ (if (nth 2 bodystructure)
+ (setq content-type (append content-type
+ (mmimap-parse-parameters-from-list
+ (nth 2 bodystructure)))))
+ (setq entity
+ (luna-make-entity
+ class
+ :new t
+ :size (nth 6 bodystructure)
+ :content-type content-type
+ :location location
+ :parent parent
+ :node-id node-id))
+ (mime-entity-set-content-type-internal entity content-type)
+ (mime-entity-set-encoding-internal entity
+ (and (nth 5 bodystructure)
+ (downcase
+ (nth 5 bodystructure))))
+ (if (and (nth 7 bodystructure)
+ (nth 8 bodystructure)) ; children.
+ (mime-entity-set-children-internal
+ entity
+ (list (mmimap-make-mime-entity
+ (nth 8 bodystructure) class
+ location node-id
+ entity))))
+ entity))))
+
+(luna-define-method initialize-instance :after ((entity mime-imap-entity)
+ &rest init-args)
+ ;; To prevent infinite loop...
+ (if (mime-imap-entity-new-internal entity)
+ entity
+ (mmimap-make-mime-entity
+ (mime-imap-location-bodystructure
+ (mime-entity-location-internal entity))
+ (luna-class-name entity)
+ (mime-entity-location-internal entity)
+ nil nil)))
+
+;;; @ entity
+;;
+
+(luna-define-method mime-insert-entity ((entity mime-imap-entity))
+ ;; Root entity.
+ (if (mime-root-entity-p entity)
+ (progn
+ (insert (mime-imap-entity-header-string entity))
+ (mime-insert-entity-body entity))
+ ;; Insert body if it is not a multipart.
+ (unless (eq (mime-content-type-primary-type
+ (mime-entity-content-type entity))
+ 'multipart)
+ (mime-insert-entity-body entity))))
+
+(luna-define-method mime-write-entity ((entity mime-imap-entity) filename)
+ (with-temp-buffer
+ (mime-insert-entity entity)
+ (write-region-as-raw-text-CRLF (point-min) (point-max) filename)))
+
+;;; @ entity body
+;;
+
+(luna-define-method mime-entity-body ((entity mime-imap-entity))
+ (or (mime-imap-entity-body-string-internal entity)
+ (mime-imap-entity-set-body-string-internal
+ entity
+ (mime-imap-location-section-body
+ (mime-entity-location-internal entity)
+ (mmimap-entity-section
+ (mime-entity-node-id-internal entity))))))
+
+(luna-define-method mime-insert-entity-body ((entity mime-imap-entity))
+ (insert (mime-entity-body entity)))
+
+(luna-define-method mime-write-entity-body ((entity mime-imap-entity)
+ filename)
+ (with-temp-buffer
+ (mime-insert-entity-body entity)
+ (write-region-as-binary (point-min) (point-max) filename)))
+
+;;; @ entity content
+;;
+
+(luna-define-method mime-entity-content ((entity mime-imap-entity))
+ (let ((ret (mime-entity-body entity)))
+ (if ret
+ (mime-decode-string ret (mime-entity-encoding entity))
+ (message "Cannot decode content.")
+ nil)))
+
+(luna-define-method mime-insert-entity-content ((entity mime-imap-entity))
+ (insert (mime-entity-content entity)))
+
+(luna-define-method mime-write-entity-content ((entity mime-imap-entity)
+ filename)
+ (with-temp-buffer
+ (mime-insert-entity-body entity)
+ (mime-write-decoded-region (point-min) (point-max)
+ filename
+ (or (mime-entity-encoding entity) "7bit"))))
+
+;;; @ header field
+;;
+
+(defun mime-imap-entity-header-string (entity)
+ (or (mime-imap-entity-header-string-internal entity)
+ (mime-imap-entity-set-header-string-internal
+ entity
+ (mime-imap-location-section-body
+ (mime-entity-location-internal entity)
+ (if (mime-entity-node-id-internal entity)
+ (concat (mmimap-entity-section
+ (mime-entity-node-id-internal entity))
+ ".HEADER")
+ "HEADER")))))
+
+(luna-define-method mime-entity-fetch-field :around
+ ((entity mime-imap-entity) field-name)
+ (if (mime-root-entity-p entity)
+ (or (luna-call-next-method)
+ (with-temp-buffer
+ (insert (mime-imap-entity-header-string entity))
+ (let ((ret (std11-fetch-field field-name)))
+ (when ret
+ (or (symbolp field-name)
+ (setq field-name
+ (intern (capitalize (capitalize field-name)))))
+ (mime-entity-set-original-header-internal
+ entity
+ (put-alist field-name ret
+ (mime-entity-original-header-internal entity)))
+ ret))))))
+
+(luna-define-method mime-insert-header ((entity mime-imap-entity)
+ &optional invisible-fields
+ visible-fields)
+ (let ((the-buf (current-buffer))
+ buf p-min p-max)
+ (with-temp-buffer
+ (insert (mime-imap-entity-header-string entity))
+ (setq buf (current-buffer)
+ p-min (point-min)
+ p-max (point-max))
+ (set-buffer the-buf)
+ (mime-insert-header-from-buffer buf p-min p-max
+ invisible-fields visible-fields))))
+
+;;; @ end
+;;
+
+(provide 'mmimap)
+
+;;; mmimap.el ends here
--- /dev/null
+/* XPM */
+static char * namazu_xpm[] = {
+"16 16 16 1",
+" c None",
+". c #104008200000",
+"X c #000000000000",
+"o c #BEFB71C638E3",
+"O c #30C224924103",
+"+ c #28A220812081",
+"@ c #1040104028A2",
+"# c #104010401040",
+"$ c #186110400820",
+"% c #9E79596528A2",
+"& c #AEBA69A630C2",
+"* c #CF3CAAAAAEBA",
+"= c #082008200820",
+"- c #38E324921040",
+"; c #49242CB21861",
+": c #410338E330C2",
+" ",
+" ...X ",
+" XooooX ",
+" XoooooX ",
+" XoooooooX ",
+" XoooooooX ",
+" XXoXoooooO ",
+" XXoXooooo+ X",
+" XoooooXXooX XX",
+" @##$%.o&ooXXoX",
+" X****#ooooooooX",
+" X*****XXoooooX ",
+" XXXX+***=oooX ",
+" X******=-;ooX ",
+" ::::::X -o# ",
+" $# "};
/* XPM */
-static char *wl-beta-logo26[] = {
-/* width height ncolors chars_per_pixel */
-"491 176 26 1",
-/* colors */
-". c None",
-"a c #7B5F86",
-"b c #586CC0",
-"c c #D09BD6",
-"d c #907AC2",
-"e c #080B07",
-"f c #E1AAD2",
-"g c #C898D0",
-"h c #E02828",
-"i c #8278C6",
-"j c #6870C0",
-"k c #3964B6",
-"l c #305FB7",
-"m c #285BAF",
-"n c #873943",
-"o c #506CBF",
-"p c #B08BCE",
-"q c #205199",
-"r c #B47FB0",
-"s c #1B2423",
-"t c #7073BF",
-"u c #C08FCE",
-"v c #425EA4",
-"w c #9D82CC",
-"x c #F0C8D8",
-"y c #000400",
-/* pixels */
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...............................................................................................................................................................................................................................hhh.........................................................................................................................................................................................................................................................................",
-"..............................................................................................................................................................................................................................hhhh.........................................................................................................................................................................................................................................................................",
-"............................................................................................................................................................................................................................hhhhhhh........................................................................................................................................................................................................................................................................",
-".............................................................................................................................................................................................................................hhhhhh........................................................................................................................................................................................................................................................................",
-"...............................................................................................................................................................................................................................hhhh........................................................................................................................................................................................................................................................................",
-"....................................................................................................................................................................................................................hhhh.........hh........................................................................................................................................................................................................................................................................",
-"..................................................................................................................................................................................................................hhhhhhhh.......hhrpppppppp...............................................................................................................................................................................................................................................................",
-".......................................................................kkk........................................................................................................................................hhhhhhhhwwwwppprhhppppppppppppppp........................................................................................................................................................................................................................................................",
-"......................................................................kkkky........................................................................................................................................hhhhhhhhrwppwprhhruppppuppupuuuuuppp....................................................................................................................................................................................................................................................",
-".....................................................................kkkkkee.............................................................................................................................hhh......wwhhhhhhhhrppwprhhrpppppppuuuppppuuuuuupu................................................................................................................................................................................................................................................",
-"....................................................................kkkkkksy..........................................................................................................................hhhhhhhhrwwwwwrrhhhhhhhrppwrhhhwpuppuppppuuupuupuuuuuur..............................................................................................................................................................................................................................................",
-"...................................................................kkkkkkksy.........................................................................................................................hhhhhhhhhhrwwwwwwhhhhhhhhwpppahhrppppppppupppuupuupuupuuuur...........................................................................................................................................................................................................................................",
-".................................................................kkkkkkkkoqy........................................................................................................................hhhh.drrhhhhrwwwwwrhhhhhhhrrpprhhrpppuppuppuupppupuuuuuuuuguud.........................................................................................................................................................................................................................................",
-"................................................................kklkkkkkkkqy........................................................................................................................hhhdwwwwwrhhhhwwpwwhhrprhhhhrprhhhruppppupuppuuuuuuupuuuuuugugur.......................................................................................................................................................................................................................................",
-"...............................................................kkkkklkkkkkqy.......................................................................................................................hhhrwwwwwwwrhhhrwwpwahrrwprhhhrrhhhrpppuppppuppupupupuuupuuuugugura.....................................................................................................................................................................................................................................",
-"..............................................................kklkkkkkkkloqy......................................................................................................................dhhhrwwwwwwwwwhhrwrwprhhwwpwhhhhhhhhhpppppupupuuppuupuupuuuguguugggga....................................................................................................................................................................................................................................",
-"............................................................kkvkkkkkkkkkkksy...........................................................................................................hhhh.....wwdhhnwwwwwwwwwwrhhwwwwwhhrrrwrrhhhhhhhrupppppuppuupuupuuuupuuupuuguugura..................................................................................................................................................................................................................................",
-"...........................................................lklkklkkkkkkkkosy........................................................................................................hhhhhhh....wdwdhhrwwwwwwwwwwwhhrwwwprhhpwpwphhhhhhhhppupuppuuppuupuuuuuguuugggugugcuga.................................................................................................................................................................................................................................",
-"..........................................................kklkkkkklkkkkkkksy......................................................................................................hhhhhhhhh..wddwwdhhawwwwwwwwwwwahhpwrwwhhrwpwprhhhhhhhrppppuppuuupuupupuuuuuuugpgggucugga................................................................................................................................................................................................................................",
-"........................................................lklkklklklkkkkkkkvsy....................................................................................................hhhhhhhhh..dddwwddrhhwwwwwwwwrwwwrhhwwwpwahawppprrhhhhhhrpupuppupppupuuuuuupuuuugugugugugggrs..............................................................................................................................................................................................................................",
-".......................................................kllklklkkkkklkkkkkkyy...............................................jjj..................................................hhhhhhhh.ddddidwdwdahrdwwwwwwwwwwwhhrrwwwrhhpwppwphhhhhhhpppuupuuuuupupupuuuuuuuuugugggguucurs.............................................................................................................................................................................................................................",
-".....................................................lkklklvklklklkkkkkkkoyy.............................................jjjjbtjv...............................................hhhh..hhhdiwwwwdwwwwrhwwwwwwwwwwwwrhhwwpwphhrpwppwprhhhhrpppppppppppupuuuuuuuuugguuugugucggggps............................................................................................................................................................................................................................",
-"...................................................kklllklklkklkkkklkkkkkqyy...........................................bjbjjjjbjjq....................................................hhrdddddwwdwwwahrwwwwwwwwrwwhhhrrwwwrhharpppwprhhhrpuppupuuuuuuupupuuuuuuuuuggugguggggcgre...........................................................................................................................................................................................................................",
-"..................................................llllllklklkvkllkkkkkkkksy...........................................jjbjbjjjjjjjs....................................hhhh..........dnhaididwddwdddnhawwwwwwwrwwwhhhrwpwrhhhhharwppprrhrppppuupppppuupuuupuugpuuguguggguggguggae..........................................................................................................................................................................................................................",
-"................................................lllllllklklkklkkklkklkkkksy..........................................jjbjbjbjjjjjtqy...............................hhhhhhhh........dddrhhrddwwwwwwdwrhhwwwwwwwwwwrhhhwwpwrhhhhhhhpppppppppuppppuuupupupuuuupuuguupguuguggucgggcgq..........................................................................................................................................................................................................................",
-"..............................................lllkllkllklklklkkllkkkkkkkkyy.........................................bbbjbjjjjjjjjjvy.............................hhhhhhhhhh.......dididhhhawiddiwwwwwhhrwwwwwwwwwwhhhrpdanhhhhhharppppppupppupupppupuuuuupuguuupgggugugggcuggggggs.........................................................................................................................................................................................................................",
-"............................................lllllllllkllllklklkkklkklkkkqyy........................................jbbjojbjbjjjjjjjye...........................hhhh...hhhhh.....ddiiddahhhwwwwwwwdwwrhhwwwwwwwaashhhsyyyehhhhhh...eessaapppuppuupuupupuuuuuuguuguguguggucgcgcgcgpe........................................................................................................................................................................................................................",
-"..........................................mlllllllklllllklklklklkklkkkkksy........................................bbjjjjjjbjjjjjjtjyy...........................hhh......hhh...iiiidddidhhhrddwddwwwwdhhhrassyyyy.hhh.....................qqapuppupupuuuuuupuuuguuuggugugugugugcggae.......................................................................................................................................................................................................................",
-"........................................lllmllllllllklkllklklklkkkkklkkmyy.......................................bjbbjbjbjjjbjjjjjjyy...........................hh.......hhh..iidiididddnhhnwdwwdwdwwwnhhney.....hhh..........................aapupuppupupuuuuuuuguuggugggggcucggcgs.......................................................................................................................................................................................................................",
-".....................................mllmllllmlllllllllkklklkkkkkkkkkkksye.......................................jbjbbbbjjbjbjjjtjqyy...........................hh........hh.iidiididdidrhhhdwddwwdvsyyehhhhhh...hhh.............................aduuuuuuuuuuupguuucpgcgggucgcugcgcry......................................................................................................................................................................................................................",
-"..................................mmmmmlmmlmllmlmllklllklklklklkkkkkkkmyy.......................................bjobjbbbjjjjjjjbjjqy...........................hhh.........ridiididddidddhhhawwwasyye....hhhhhhhhhh.................................duupuupuguguggugggpggggggcgcgcggqe.....................................................................................................................................................................................................................",
-"...................mmm........mmmmmmmmlmlmlmlllllllllkklllklkklkklkkkksye......................................obbjbbjbjjbbjjjjjjjsy.............hhhhhh.........hh........iiiiididiiididdahhhasyyy........hhhhhhhh....................................duuuuuuuugpuuguugguggcgggggggcpy.....................................................................................................................................................................................................................",
-"...................mmmmmmmmmmmmmmmmlmmlmlllllllllllllkllkklklklkkklkkqyy......................................jjbbbjbbjbjbjbjbjjjbyy...........hhhhhhhhh........hh.......iiiiiidiiddddidddhhheye............hhhhh.......................................upuuuuuggucugguggugucgccgcgggse....................................................................................................................................................................................................................",
-"....................mmmmmmmmmmmmmmmmlmlmlmllllllllkllllklklkkklklkkkkeye.....................................bbbbbbbbjbjbjjjjjjjjqye.........hhhhhhhhhhhh........hhh....ahanariiidididdiisnhhh................h..........................................ppuuugpuuuuggcucggcugggggcccry....................................................................................................................................................................................................................",
-"....................mmmmmmmmmmmmmmmlmllmlmmlmllllllllklkllklklkkkklksyy......................................bbbbbjbbbbjjbjbjjjjjey........hhhhhh.....hhh........hhhhhhhhhhhhhnidddidwtsyyshhhh..h.........................................................uuuuguguugggpgugcggucgcggggee...................................................................................................................................................................................................................",
-"....................mmmmmmmmmmmlmlmllmmlmllmllllllllllllklklkkklklkqyy......................................obbojbbbjjjbjjjjjjjjqyy........hhhhh.......hhh.......hhhhhhhhhhhhhhriiidtqyye..hhhhhhhhh........................................................uugpguucpgucpcgugcgcggcgccay...................................................................................................................................................................................................................",
-"....................mmmmmmmmlmmmlmmmmmmllllmlllmllllllkkllklklkkkkqyy......................................bbbbbbjbbbjbbjbbjjjjjey....h....hhhh.........hh.........hhhhhhanhhhhhidisyye....hhhhhhhhh.........................................................uuguuuucuucgucuggggcgcgggry...................................................................................................................................................................................................................",
-".....................lmmmmmmmmmmmmmmmmllmlllllllllllllmklklvklkklqyy......................................obbbbbbbbjbbjbjjjjjbjsyyhhhhh......hhh.......hhh..........diraiiidahhhdqeyy.....hhhhhhhhh...........................................................gpgugguucugggggcgcgggccccee..................................................................................................................................................................................................................",
-".....................mmmmmmmmmmmmlmllmllmlllllllllllkllkkllkklkksyy.......................................obbbbjbbbbbjbbjbjbjbvyhhhhhhhh.....hhh.......hhh.........iiiiiiiiiihhhnyy......hhhhhhhhh.............................................................ggpcuggucucugggggcgcgggcsy..................................................................................................................................................................................................................",
-".....................mmmmmmlmlmlmmmlmmmmlllmlllkllllllkllkkllkmsyy.......................................bbobobbbbjbjjbjjjjjjanhhhhhhhhh......hhh......hhh........iiiiiiiiiiianhye......hhhhhhh.................................................................gguugugugpgcgggcgggcccgay..................................................................................................................................................................................................................",
-"......................mmmlmmlmmmlllmmllmlmlllllllllllllklllkvqeye.......................................ojbbbbbobbbbbbjbbjbahhhhhhhhhhhh.......hh....hhhhh.......iiiiiiiiiiivehh........hhhhh....................................................................uguucggcgggpgggcgcgggcpy..................................................................................................................................................................................................................",
-"......................mmmmlmmmmmlmmlllmlllllllllllkllllklkklsyye........................................obobbbojbbbbjjbjjthhhhhhh.....hhh......hhhhhhhhhhh......iiitriiiiiisynhhh........h.......................................................................guuggugugggccgcgggcccccye.................................................................................................................................................................................................................",
-".......................mmmmmlmlmmmlmmmmllllllllllllklkllklqeyy.........................................bobobojojbbbbbbjbjahhhhh.......hhh.......hhhhhhhhh......iiiiihhaiiaeyehhh..................................................................................ggucpggggggcucgcgcgcggsy.................................................................................................................................................................................................................",
-".......................mmlmmmmmmmmmmlllmlmlmlllllllllllkmsyye.........................................oobbbobobbbjjhnhajbahhhhh.................hhhhhhhhhh....iiiiiiahhaqyye.hhh...................................................................................pguguggggggcggggcggccsy.................................................................................................................................................................................................................",
-"........................mmmlmmlmlmmlmmlllmlllllllllklllsyye...........................................boobbbjbbbbahhhhabjvehhh......hh..........hhhhhhhhhh...tiiiiiidhhhns.hhhhh...................................................................................gggcgggggugggccggcgccsy.................................................................................................................................................................................................................",
-".........................mmmmmmmmmmmmmmmmlllllllkllllqeyy............................................ooobooobobahhhhhhbjqyy.hhh....hhh...........hhhh...hhhhiiiitiiidhhhhhhhhhhh....................................................................................pgguguucgcgcgggcccggay.................................................................................................................................................................................................................",
-"..........................mmmmlmmlmmmllllllmlllllllmeyy.............................................obbobbbobbjbhhhhhajqyy...hh....hhhh..........hhh.....hhhdiiiiiiiahhhhhhhhh......................................................................................gguggcucuuggccgcggcgay.................................................................................................................................................................................................................",
-"...........................lmmmlmmmllmmmmmllllllllqyye..............................................oooboanbbobbbanhhtqyy....hhhhhhhhhh...........hh.....hhhhhadtiiqyhhhhhh..h.......................................................................................ugggugucccgggcggcgpay...............................................................................ww................................................................................................................................",
-".............................mmmmlmmmllllmllllllmsey...............................................boohhhhhabbbbbbthhsyy......hhhhhhhh............hh.....taahhhhadsyy.hhh............................................................................................cugggcggugcgcggcuittse.............................................................................ppwry..............................................................................................................................",
-"...............................qmmmmmlmmmllllllqeye................................................oahhhhhhnbbbojbbnhny.......hhhhhhhhh...........hhh...tiiihhhhhnyy.................................................................................................guggggpgcggggccuitttvy............................................................................wpwpwye.............................................................................................................................",
-"..................................ssssesmmmlllqeye................................................ooanhhhhhabbjbobvshh........hhhhhhhhh............hh..ittitahhhhee...................................................................................................guggcgcucgccgcittttvy...........................................................................pwpwpwyy.............................................................................................................................",
-".......................................mmllllmyy.................................................ooooohhhhhaobbbbqynhh.........hhhh.hhh....hh.....hhhh.tiiiiitahne....................................................................................................gguguggcgggggwtttttty...........................................................................wpwpppyy.............................................................................................................................",
-"......................................mllllmqeye.................................................boobooanhhhobbosyyhhh.........hh..........hh......hhhhhtttiibeee.....................................................................................................gugcugcucggcutttttttyy.........................................................................pwpwwrwyy.............................................................................................................................",
-"......................................lmmmlmyy..................................................oooooooobhhhaoveye.hhh..........hh.........hhh....hhhhhhaiitbeye......................................................................................................cgcpgcgggggctttttittyy........................................................................wwpwpwwpyy.............................................................................................................................",
-".....................................mlllmmeye..................................................oovoobobbnhhnsyye..hhh..........hh..........hh....hhhhhhtitbeye.......................................................................................................uggguggcgcgwtttttttbyy........................................................................pwpwppwpyy.............................................................................................................................",
-"....................................mmmmlmeye..................................................oooooooooobthhse....hhh..........hhh........hhh.....hhhnaiijeye.........................................................................................................gggcgcucguttttttttvye.......................................................................pwpwwpwpwyy.............................................................................................................................",
-"...................................lmlllmeee...................................................oooboobbbovvnhhh.....hh...........hh.......hhhhh....tadtttbeye..........................................................................................................gugpgguggittttttttvy........................................................................wwpwwwprayy.............................................................................................................................",
-"...................................mllmmsye...................................................vooooobooooosenhh.....hh...........hh....hhhhhhhh...ttittiieye...........................................................................................................gggccgcgwtjtttttttqy.......................................................................wwpwwppwway................................................................................................c.............................",
-"..................................mmmmlsyy....................................................ooooooooobojyy.hh....hhhh..........hhhhhhhhhhhhh...ttttittsyy............................................................................................................uguuucgpttttttttttsy......................................................................wrwpwwwwpwsy.............................................................................................fccccg...........................",
-".................................mmmmlqyy....................................................ovooooobobobqyy..hhh..hhh...........hhhhhhhhhhhh....ttttttsyy.............................................................................................................cucgcggwtjttttttttyy......................................................................wwwwrprpppsy...........................................................................................ccccccffye.........................",
-"................................mmmlmqyy.................................h...................ooooooobobobey...hhhhhhhhh.........hhhhhhhhhh......tttttivyy..............................................................................................................ugguugpttjjttttttvyy.....................................................................wpwpwwwwwwdyy..........................................................................................cccfccccayy.........................",
-"................................mmmmqyy................................hhhh.................ookokoooooobqyy....hhhhhhhh..........hhhhhhh.......ttttttvyy...............................................................................................................cgggcgijjtittttttsy......................................................................wwwwwpwrppaye.........................................................................................cccccccccey..........................",
-"...............................mmmmmeye.............................hhhhhhhh................oovoooooooooey......hhhhhh...........hhhh..........tttttbey................................................................................................................uggggwttttttttttvyy.....................................................................wwwwwwwpwwpey..........................................................................................ccccccccayy..........................",
-"..............................mmmmmsye..............................hhhhhhhhhh.............okooooooobobqyy.......hhhhhh.......................tttttteye................................................................................................................cugcpttjijttttttsye.....................................................................wwwrwpwwrpayy.........................................................................................ccccccccuyy...........................",
-"..............................mmmmsyy.................................hhhhhhhh............oooooooooooobsy.........hhhhh......................tjttttsyy.................................................................................................................ugguwjtjtjtttttvyy.....................................................................wwwwwrwpwwdey.........................................................................................cccccccfueye...........................",
-".............................mmmmqyy........................h...........hhhhhhh..........oookovooooobovyy.........hhhh.......................jttttvyy..................................................................................................................cgggjjjijijtttieye....................................................................wwwwwwwwwwwsye.........................................................................................ccccccccsye............................",
-"............................mmmmmyy.......................hhhhh.........hhhhhhh........ookookooooooooosye..........hhhh.....................tttttbey...................................................................................................................gugitjjtttjttttyy.....................................................................wwrwwpwpwpayy.........................................................................................ccccccccnyy.............................",
-"...........................mmmmmeye...................hhhhhhhhh.........hhhhhhhh......vkooooooooooooovyy............hh.....................jjttttsye...................................................................................................................ugpttttjtttttpsye....................................................................wwwwrwwwwwayy.........................................................................................ccccccccayy..............................",
-"...........................mmmmsyy...................hhhhhhhhhhh........hhh...hhh....ookokkoookooooboqye...................................tttttqyy...................................................................................................................gguijtjtjttjtdpyy.....................................................................rwwwwwwwpdey..........................................................................................cccccccayy...............................",
-"..........................mmmmqyy.................hhhhhhhhh...hh.........hh....hhh.ookokookokkoooooooey...................................ijjjtbyy....................................................................................................................ugujjjjttjjtdcaye....................................................................wwwwwwwwpdeye.................................................................ccg.....................cccccccryy................................",
-".........................mmmmqeye...............hhhhhhhhhh....hh........hhh....hhhnvkoqqkooooovooooovyy...................................tttttsye....................................................................................................................guijtijjtttdcgey............................................d........................wwwwrrwrdeye.................................................................cgccee...................ccccccueye................................",
-"........................mmmmmsye................hhhhh.hhh......hh.......hhhh..hhhhhnvqylokoookoooooosye..................................jtjtjqyy.....................................................................................................................uujjtjjtjticgryy...........................................ddda.....................wwdwwwwpdeye.................................................................cgcgayy..................ccccccpeye.................................",
-"........................mmmmqyy..........h.h....hhh.....hh...............hhhhhhhhhhhnysookooookoooooey...................................ttttbey........................lll...........................................................................................gijtjtjttdcggsye...................iiiiii.................dddiey....................dwwwwwwdeye................................................................cggggpyy...................ccccccsye..................................",
-".......................mmmmmeye........hhhhh....hhh.....hh...............hhhhhhhhhhhheokokokooooooovyy..................................tjtjjsye......................lllklq.........................................................................................cpjjjttijigcgryy.................iiiiiiiiiis.............dddwteye...................wwwwwwwieye....................p...........................................gggcgcaye...........cccccccccccccsyy...................................",
-"......................mmmmmqyy......hhhhhhhhh....hh.....hh..............hhhhhhhhhhhhhhaokoookookoooqye.................................jtjttvyy.......................lllllky...........................kk................................................jjjbjjbb...gijtjtjjdggggsye...............iiiiiiiiiiiivy...........ddiddsye...................wwwwwwrdeye...................ppppa........................................cgcgcggge...........cccccccccccccrss........c...........................",
-".....................mmmmmmyy.....hhhhhhhhhhh....hh......hh..............hhhhhnannnhhhhnvokkoooooooqy..................................jjtjjsye......................lklllklyy........................kvkoky...........................................bjjjbqeyyy....utjjtjjicgcgryy..............tiiiiiiiiiiiiivy..........ddddidqy....................wwwwwwdeye..................pppppppy......................................gcgggggcgre.........cccccccccccccccccccfccfccu...........................",
-".....................mmmmmsye....hhhhhhhh.hhh.....hh.....hh..............hhhnkoqyy.hhhhhhaookovoooooy.................................jtjttqyy...............mmmmmlllllllllqyy......................kkkkokqye.......................................bjjbvsyye.......gitjtttdggggcsye.............iitqssbiiiiiiiisy.........diididddv....................wwwwwdeye..................ppppuppdyy...............uuuu.................gggggccgcgcps........ccccccccccccccccccccccuayye..........................",
-"....................mmmmmqyy..hhhhhhhh....hhhh....hh......hh............nhhhamsyy..hhhhhhnoookoooobosy................................tjtjtey............mmllmmqsyyslllllllsye.....................kkolokksy..........ooooo.......................bjjbveyy..........utjjjjdgggcgryy............tii.yye..iiiiiiiiey........iddddddiddda.................wwwwwdeye..................ppppppppaye..............uuuuury...............gcgcggggccggpe........ccccccccccccccccccrasyye............................",
-"...................mmmmmmsye..hhhhhhh.......hh....hh......hh...........kohhvleye....hhhhhnooooookoooqy...............................jtjtjqyy..........mmmmqsyye...lllllllqyy.....................kokkkkoqyy........oooookoqe....................jbbosyy............wbjtjdggucggsye...........iti.ye....iiiiiiisyy.......diidiwiwiwidddi...............dwwwreye..................ppppppppdey..............uuuupuuye...............ggggccgcgccgae.........sssrccccaaaasssyyye...............................",
-"..................mmmmmmqyy....hhhhh...............h......hh.........kkkknhnyye....hhhhhaookoooooooovy...............................jtjjjey.........mmmmqeyy......lllmlllqy.....................kkkkkkkksye.......vkokkooooy..................bjbbveye............uittjigcucugayy...........itiey.......iiiiivyy........iddidididwdddddts............wwwwayye...................ppppppudsye.............uuupuuuayy.............ggguucgggggcgcgs............ccccryy........................................",
-"..................mmmvavsye......hhh.......................hh.......kkkkkahhs......nnnhnvokookooooboose..............................jtjtqyy.......mmmmlqyye.......lllllmllq....................kkkkkkvoqyy.......oooooookoosy................bbbbveye.............pjjjtuugcgcpey...........titsy........iiiivyy..........idwidwididwwdwwse...........wwwayy....................pppppppdeye.............uupuuuurey.............cg..ypgcgcgccgccay..........cccccsye........................................",
-".................mmhhhhhns.......hh.......h................hh......kkkkkmhhhhh.....okooookoooookooooovy.............................jtjjtey.......mmmmmqyy..........lllklkllms.................kkkkkokkkey.......okookkooooosy...............bbbbjqye.............gwjtjpucguggsye..........titsye.......iiiivyy..........ddiidiiddiwiwdidsy..........wwwayy....................pppwpwusyye.............upuupuuweye............g...e..ggggcggcggpy..........ccccryy.........................................",
-"................nahhhhhhhh........hh....hhh................hhh...kkklkkqnhhhhhh....ooookookooooooooboose............................tjtjqyy.....mmmmmmmeye..........llllllllkms................kkkkkkkoqyy......ookkoookokoosy..............bjbjbvyy..............gbjjwgggggcayy...........tibyy.......iiitsyy..........ii.eyatidwidiwiwvyy..........dwdeye...................ppwpppaeyy...............puuuuureye............g..e.....cgggcgcccgye........cccccsye.........................................",
-"..............hhhhhnhhhhhhh.......hhhh.hhhhh................hh..klkkkkqenhhhhh.....olookokokokooooooobvy...........................tjttjey.....mmmmmmmqyy............lllmkkkmlqe..............kkkkkkkvmyy......okkookkooooooqy.............obobbbqye..............wjjtggugucrey...........ittyy......iiiiayye..........i.......iiiwidwwqyy...........wwsye....................wppppqyye...............uuuupuaeye............g..........cgcgcgcgcyy........cccccyy..........................................",
-"............hhhhhhnmvvanhhh.......hhhhhhhhhh................hhavkkkkmsyy.hhhhh.....okkkokookoooookooooose..........................jjtjqyy....mmmmmmmmsy............ll.lllmkklle.............klkkkkolkqye.....o..ysookokooooqy.............bbbjobsy..............wtjjwggcgggsye...........ttvyy...tiiiiayyy...........d.........ddiwiwsyy...........wwwyy....................pppppsyy................puppuuayy..........................cgccccgryy........ccccayy..........................................",
-"............hhhhhhvmmmmshhh........hhhhhhhhhh................hhhnhaqeye...h........oovoookooooooobooooobe.........................jjtjjsy.....mmmmmlmmyy...........ll..qllklllksy............kkkkkokkoey.....v..e..okoooookoqy............bbbbbbbsy.............dtjjtwgugugayy...........ttiittiiiitqeyye........................widisyy............wwwyy....................pwwwayy................pupuuusyy............................cgcggcaye.......cccccay...........................................",
-"............hhhhhnqmmmmsnhhh.......hhhhhhhhhh..............khhhhhhheye.............okkoloookkkvoooobobobqy........................tjjtvyy....mmmmmmmlmyy...........l....llllkllsy...........kkkkkkkkkqyy............okkkkoooqy...........obbbbbjbsy............jiijjjwggugwyy............tttvqssyyyye............................ddwsyy.............wdwsy...................pppuwsye...............uupuuuayy.............................cgccggsy........cccccsy...........................................",
-".............ahhhammmmmsehh.........hhhh..h...............kahhhhhhny...............kkokokokoooooooooooooos........................jjjjsye...mmmmmlmlmmey..........l.....lllllllsy...........kkkkkkkokqye............ooooooooqy...........bobbbbbbvy...........jiutjtjtgucgeye...........tittsye.................................ddisyy.............wwwwws...................wpwwpsy................ppuupuey...............................ggccryy.......ccccccay...........................................",
-"............mmahhhmmmmmqnhh.........hhh..........h......kkknhhhhhsy................oookokoooookoooooooobovy......................jtjtvyy....mmmmmmlmmmsy........lm.....llklkklkyy..........kkkkkkolkosy.............okoookkooy...........bbobbbbbbse.........jjuujjjjjdugsyy............ttitvy..................................ddayy............w.wwwwwws.................wpppppay...............uuuppupey............g..................ccgcsye.......ccccccry...........................................",
-"...........mmqqhhhvmmmmnhhhh........hhh.........hhh....klklhhhhhn...................kkookokkoooookobobbobbqe.....................jjjjqye...mmmmmmmmmmmqe.......ml......klmllllqyy........k.kkkkkkkkkksy.............oookkooooey........obobbbojbjbbs.......jjjwuwjjjtjjdayy............ttititve....................ii..........dddsy............w..wwwwwwwa................ppwpwpwae............pppppuppuqy...........u.....ggg...........ggcayy........cccccccae...............f..........................",
-"...........qmmmnhhnamanhhhhh.........hh..........hhh.kklllkaasee....................ookkooookookooooooooobbs....................jjtjjsy....mmmmlmmmmmmmmq....lll.e....llkklkllqye......kk..kkkkkkkvkkmsk............okooookooqy......bb.bobbjbobbbbjvv..jjjjbaguwjtjjtjjbs............t.ttttitvs..................ii..........ddidyy..........dw..sdwwwwwwwwi.............pwpwpppwpaq..........ppuuuuuupups.........gg..e..ggugrs.........cgpey.........ccccccccas............fc...........................",
-"..........mmmqmvnhhhhhhhhhhhhh.......hh..........hhhallklklqyye......................ovkokooooooboooooobboovy...................jjjjvyy....mmlmmmmmmmmmmmmmmlmm.y.....lllmlllkqy.....kk..eqkklkkkkkkokkq.e..........kookoooooos....obo..bobobojbojbbjjjjjbbbsuugijjjjjtjjjv.........tt..ttiitiitv...............iid.e........ddiddsy........dww.ey.wwwwwwwwwwwwdw.......wpwpppppppppprw......ppp.pppppuuuuua......ugg..e..guggggae.......gccsye........cccccccccccp........ccc..e..........................",
-"..........qmmmmmahhhhhhhhhhhhhh.......hh.......hhhhhnlllkmsyy........................okokvokoooooooooooobbobqe..................tjtjsye...mmmmmmlmlmlmmmmmmmlsyy.....llllklllllss.kkkl.ey..kklkkkkolkkqyy...........oookkokooooooobobsyebobbbjbbbbbbbbjojjvsruuuijjtjjjjttjtjjjtjjttt.estttijtitittt..........iii..y.......dddidwiay......wwwwsyy..wwwwwwwwwwwwwwwwwwpppw.awpwpwpppppppppppppppssuuupuupupuuuuuuguupey....gggugggy.......cgayy.........ccccccccccccccccccccccaey...........................",
-".........qmmqmmmahhhhhhhmas.hhhh.......hh...hhhhhhhnalllqeye..........................okookokoooooooooboobobbs.................jjjjjey....mmmmmmmmmlmmmmlmllsyy.....lllllllkkllklkllmyye..klkkkkkkkkkqyy............okkooooooooobooqeye.obbbbojbbjbjjbjjboeauuuuijjjjjjtjjttjtttttttsye.tittitiiiiiiiiiiiiiiiiiiqyy........idiwdiddtadddwwdwdeye...dwwwwwwwwwwwwrwwwwwwayyapwpwppppppppppppppayyapppupupuuupupuuuusyy....gguggcggny.....gggyy..........ccccccccccccccccccccueyy............................",
-".........mqmmqmmmhhhhhavmmms.hhh.......hhhhhhhhhhhakkkqsyy.............................okooookookoooooboobobbve................jjjjvyy....mmmmlmlmlmlmlmlmmeyy......lllllllllklklkmsyy....kkkklkkkkoqyy..............oookokookooooqyy...bobojobbbbbbbbjbveauuuuudjjtjtjjtjttttjttttsyy..tttitttitiiiiiiiiiiiiitsyy........diidiiwiwidddddwdieye....wwdwwwwwwwwwwwrwwppsyy..ppppppppppppupppusyy..uupupupuuuuuuuursyy.....guguguguwe....cgcey............ccccccccccccccccccayye.............................",
-"........qmmqmmmmqnhhhnmmmmmmqhhh.......hhhhhhhhhhnvllqeye..............................ookookooooooobooobbbbbbve...............jjtjsye....mmmmmlmmmlmlmmmqyye......lllkllllklllklqeye.....klkkkkkkkqyy...............kokooooooooosyy....obobbbbbbbjbjjbqesguuuguwjtjjjtjtjjjjjttjbeyy...tittiiiiititiiiiiiiiiaeye........iiddiddididddddwdayye.....wwwwwwwwwwwwwwwprdsyy...wpwpwpwpppppppppsyy...ppupuuuupupuuuaeye......ugggggcggra.cgc.ey.............cccccccccccccccfpsyy...............................",
-"........mqmmmmmmmvhhhmmmmmmmmahhh.....hhhhhhhhhavlkqsyy.................................okoookooooooobboobbbbbbse.............jtjjjsy......mmmmmlmmmllmmsyy........llllllllllklqsyy.......kklkkkkoqyy................oookookoooveyy......bobbbbjbbbbjbqysupuuuuugjjjjjtjjttjtjttveye.....iittttitiiitiiiiiiiqyye.........diiddwiwiwiwwiwwqyy........wwwwwwwrwwwwwwwaeye....pwpppppwppppppreyy....upuuupupuuuuusyy.........gugugugggggggayy..............cccccccccccccccaeye................................",
-"........mmqmmqmmmmhhhammmlmmmvhhhv....hhhnnhnamlllqeye...................................ookoookoovoooobbooobbjbs.............jjjjvyy......mmmmlmmmlmmqyye.........llmlllllllmsyye........kkkkkkkqyy.................ookooooooqyye.......obbojbojbjbosyeppuuuuguuqjjjtjjtjjjtttqeye.......ttiiiiititiiiiiitsyy...........iddidiiiddiwdwtsyy..........wwwwwwwwwwrwdsyy.......ppwwwpppppppayye......upppupuuupdeyy..........ucgggcgggggreyy................ccccccccccccpsyy..................................",
-".......mqmmmmmmmmmahhnmmmmmmmmnhnmmmmvhnhvlmllklqsyy......................................kooooboooooooobobbbbbbve............jjjtqye.......mmlmmlmmqeyy...........llllllllmsyye...........kllkkqyy...................ookkkomsyy..........obbbbbbbbqeyspuuuuuuudsyqjtbjjtjttjjqyy..........ttttttiiiiiiiiqyye.............dididddwiwiiaeye............wwwrwwwwwisyye.........pupupwuppasyy.........uupuuuprsyye............ugugucgcpqyye..................cccccccccpayye...................................",
-".......mmqmqmqmmmmqhhhvmmmmmanhhvmmmmlmlvmlmlllqeye.......................................koooooooboboboobbbbbbbbqe..........jjjjbsy..........qqqqseyy..............lllllqsyye.............kkkksyy....................kooovsyye............bobbooqeyy.uuuuuuuudeye..jjjtjtjjqeyy............tiiiiiitiitqeyy................iddddiiditsyye..............ddwwwwasyye............rpwppwasyye...........puppaqyye...............gucgursyye.....................gcccccrsyye.....................................",
-".......qmmmmmmmqmmmmnhnmmmnhhhhnmmmlmmmllmlllqeyy..........................................oooooooooboobobojobbjbjs..........jjtjjey..................................qsyyy.................kqsyy.......................qsyye................qseyye..uuuuuuuudeye....vvqvqsyyy................vbiiijvsyyy....................aiwiwiqeye...................syyyy.................assyyy................qeyye...................qsyyye.........................assyyye.......................................",
-".......mmmqmqmmmmmmmahhammhhhhhammmmmllmmllqsyye............................................ooooboooobbobobbbjbbbojs.........jtjjvyy..........................................................e.....................................................upuuuuuudeye.................................eyyye.........................assyye......................................................................................................................................................................",
-".......qmmmmmmmmmmmmhhhhnhhhhhvmmmmmmmlllmqeye...............................................bbbbbobobbbjbbbbbjbjbbve........jjjtqye...............................................................................................................puuguuuuayye............................................................................................................................................................................................................................................",
-".......qmqmmmmmmmmmahhhhhhhhhnmlmmmlmlmmqsyy..................................................jjjjboobbbojbbjbbbbjjbve......tjtjjsy...............................................................................................................uuugugggayy..............................................................................................................................................................................................................................................",
-".......mmmmmqmmmmmmnhhhhhhhammmmmlmlmmqsyye............es....ss..............................ssitjbbbbjbjbbjjjbjjbjttqs.....iiiitsy.....................................ss.....sss...............................................................puuuaeugsee...................................................................................sssss.......................sssssss.........................................................................................................................",
-".......mqmqmmmmmmmmmhhhhnvmmmmmlmmmlmsyye...............sg...sfx..sssssss.ssssssss..........sssriijjbqsjjtjqvjjjjbqsqvs..essqaaqaees.....e....essssss...sssss...........ssa....ssax...sssssss....sss......sss......ss........ss......essssss....puuuursfnses.....e..ssssssss..sssssss...sssss......ssssss....ss.......sss....sssssss..........snxfrns....ss....s...........srrrrrrx...s.....s......ss.......sss.....sss.....sssssss...ss....s..............................................................",
-".......qmmmqmqmmmmmmanammmmmmmmmmmmsyye.................ss..srf...srrrrrrx.rrnnrrrx.........srraxitbjvsadtisrctjasarrnas..rrsrrrrnssx....sx...srrrrrrx..srrrrs..........snng..ssaax...srrrrrrx.ssaras...ssaras.....sna.....esaras....srrrrraf.uuupupgrsfss.ss....sx..arnnrrrx.srrrrraf..srrrrna...saxfxxgf..sssx....ssaras...srrrrraf........saf....sn...ssr...sx..........sx.........eg...ssr....sssx....ssaras...s.rrnn...srrrrraf..ssr...sx.............................................................",
-".......qmmmmmmmmmmmmmmmmmmmmmmmmqsyye....................sasaf....sx.........naf............sxfnf.ijbaasadiqrutbspfcugsrs..csrfcrsssx....sx...sx........sf...sr.........sara..sraax...sf.......sfx..gx..sgx..gf....sfsf...s.fx..rf...sx.....fuuuuppggssx...sas...sx....naf....sx........sx...an...sr........sfnr...ssfx..gf..sx..............sf......sx..srs...sf..........srnns......na...sar....sfnr...ssfx..gf..nx...fx..sx........srs...sf.............................................................",
-"........qmmqmmmmmmmmmmmmmmmmmmqsyye.......................sax.....snsss......sax...........sax.na..tjaapsrwargiaafwdiiaars.wsrcwss.ssssssnx...sasss.....sassssf.........safngsnxnax...sasss.....ssss.....ssss.....safsr...sx.........snsss..guupuuprsssf...sxaa..sx....sax....snsss.....snssssrx..snsss.....sf.s...sx........snsss...........sf......sf..sx.n..sf..........sraanx.....anr.s.ar....sf.s...sx........ssss.....snsss.....sx.n..sf.............................................................",
-".........qmmmmmmmmmmmmmmmmmmqeyye.........................srx.....srrrrx.....sax...........snnanng..jvagdnrarciaafddiiaafavdsrcwss.sxxxxrax...srrrrx....srraaxx...iii...saxnanrxsax...srrrrx.....rrann....rrrnn...sra.sf..sx..sss....sarrrrfgupupuaeessx...sx.aa.nx....sax....sarrrr....srrrsfx...srxxrf...sar.sr..sf........sarrrr..........sf.....ssx..sx.an.sx..........sxxxxx.....a.s.sxsr...sar.sr..sf.........frras...sarrrr....sx.an.sx.............................................................",
-"..........mmqmmmmmmmmmmmmqsyye............................sr......sx.........snx..........safxxxra...vauirsarcdisfdiiisffiadsrcdse.sx....nx...sx........sx..sr..ddiiiiidsax.nrx.sax...sx............rax......rax.snraana..sr...xar...srx.ffcguuudsyy..sf...sx..snsx....snx....srx.......sx..na....sr.......srraan..sa....s...srx.............sn.....srf..sx..aasx..........sx.........a.ss.xsr...srraan..sa....s........sf..srx.......sx..aasx.............................................................",
-"............qmmmmmmmmqssyye...............................sr......sasssss....snx..........sx.....sf...aptiasrgiianaavsafwiidsrcdee.sx....nx...sasssss...sx...sfwddiiiidwaaf.nfx.sax...sasssss..sss.ss.x.sss.ss.x.sx....sf..nss.ssr...ssaaaaqcuuayye...sf...sx...nax....snx....snnssss...sx...sr...sr......s.x...sr..nsssssr..snnssss..........asssssaf...sx...nsx..........sasssss....a..af.sr..s.x...sr..nsssssr..sss.ssx..ssnssss...sx...asx.............................................................",
-"..............ssssseyyy....................................r.......rrrrrrx....rf...........f......r...aptiirruiiigrrrffudtitarciee..f....ag....rrrrrrx...g...ardiiiiiiidarfprf...rf....rrrrrrx..xrraff...frraff...f.....r...rrr.xf...arrrrrrfrsyy.....af....g....rf.....rf.....rrrrraf...r....r....r.......f.....r...frrrff...rrrrraf..........frrrxf.....r....rr..........arrrrrrg.......x..r...f.....r...frrrff...rrrrxx...rrrrraf...r....rr.............................................................",
-"........................................................................................................bjtdugttttiuuuiittjtwupvee...........................wcpdiiiiiidpccwwwd.....................................................ugffffffreee...........................................................................................................................................................................................................................................................",
-".........................................................................................................bjtttjjjttjtttttjjttiiqy............................ddiiiiiiiiidwwdwwwwq.................................................ppuuuuugasee.............................................................................................................................................................................................................................................................",
-"..........................................................................................................bjbjbjjjjjjjjjjtjjtjjvy...........................iiiiiiiiiiiiiddddidddq..............................................pppppppuasey...............................................................................................................................................................................................................................................................",
-"...........................................................................................................jojbbjbjjjjjjbbjtjjtqy...........................iiiiiiiiiiiiiiiiiididie...........................................ppppupppdsyye................................................................................................................................................................................................................................................................",
-".............................................................................................................bbbbbbbjbbjjjjjjjjsy...........................iiiitiiiiiiiiiiiididddvy........................................wpppppppdqyye..................................................................................................................................................................................................................................................................",
-"..............................................................................................................jbbjbjbjjbjbjtjjjsy...........................tiiiiiiiiiiiiiddiiididds......................................ppppppppdqyye....................................................................................................................................................................................................................................................................",
-"...............................................................................................................bbbbbbjbjjjjbjjjvy............................iiiiiiiiiiiiiiiiididdids...................................wppwpwpwasyye......................................................................................................................................................................................................................................................................",
-"................................................................................................................bbjbbjbjjbjjjjjjqe...........................iiiiiitiiiiiiiiiiiiiidids...............................wppwpwpwpasyye........................................................................................................................................................................................................................................................................",
-".................................................................................................................bojbbjbbbjbjjjjjs............................iiitiiiiiiiiiiiiiiididddq...........................wwwpwwwpwdaeyye..........................................................................................................................................................................................................................................................................",
-"..................................................................................................................bjbbjbjjjjbjjjjvy............................iiiiiiiitiiiiiididdiddidta.....................wwwwwwwwppwasyye.............................................................................................................................................................................................................................................................................",
-"....................................................................................................................bjbbjbbjjjjjjjse............................iiiiiiiiiiiiiiiiiidddidddii..............wwdwwwwwwwpwpdseyye...............................................................................................................................................................................................................................................................................",
-".....................................................................................................................jbjjjjjjjjjtjvy..............................jiiiitiiiiiiiddiiididddddddddddddwwwwwdwwwwwwwwwwdasyye..................................................................................................................................................................................................................................................................................",
-"......................................................................................................................jbbbjjjbjjjjjse...............................atiiiiiiiiiiiidddddddiddddwwwwdwwwwwwwwwwwwwaseyye.....................................................................................................................................................................................................................................................................................",
-".......................................................................................................................jjbjbjjjjjtjvy.................................aqbiiiiiiiiiiiidiwiwiddddwwwdwwdwwwwwwaqsyyy.........................................................................................................................................................................................................................................................................................",
-"........................................................................................................................bjjbjjjjjjjjse....................................qqviiidiiddiwidiwwwwwdwwwwwwwaassyyye............................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jbjjjjjjjtbjvy.........................................sssvvaaidwididiwaaaqsseyyye.................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jjbjjbjjtjjjjee.................................................yyyyyyyyye.........................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jjjbjjjbjjtjtqy....................................................................................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jbjjjjjjjtjjjvy....................................................................................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jjbjjjjjjjjtjjse...................................................................................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jjjjbjjjjjjjtjqy...................................................................................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jbbjjjjjjtjtjjvy...................................................................................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jjjjbjjjjjtjjtjse..................................................................................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jbjjjjjjjjjjtjjsy..................................................................................................................................................................................................................................................................................................................................................................",
-"........................................................................................................................jbjbjjjbtjjjjttvy..................................................................................................................................................................................................................................................................................................................................................................",
-".........................................................................................................................jbjjbjjjjtjttjjy..................................................................................................................................................................................................................................................................................................................................................................",
-".........................................................................................................................jjjjjjjjjtjjjtjsy.................................................................................................................................................................................................................................................................................................................................................................",
-".........................................................................................................................jbjjjjjjjjjtjjtsy.................................................................................................................................................................................................................................................................................................................................................................",
-".........................................................................................................................jjbjjjbtjjjjtjjqy.................................................................................................................................................................................................................................................................................................................................................................",
-".........................................................................................................................jbjjbjjjjtjjttjvy.................................................................................................................................................................................................................................................................................................................................................................",
-"..........................................................................................................................jbjjjjjtjjtjtjjye................................................................................................................................................................................................................................................................................................................................................................",
-"..........................................................................................................................jjjjjjjjjjjjtjtyy................................................................................................................................................................................................................................................................................................................................................................",
-"..........................................................................................................................bjjjjjjjtjtjtjjsy................................................................................................................................................................................................................................................................................................................................................................",
-"..........................................................................................................................jjbjjjjjjjjjttjsy................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................jjbjjjjtjtjtjtsy................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................jjjjjtbjjjtjjjsy................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................jjjjjjjtjtjjtjsy................................................................................................................................................................................................................................................................................................................................................................",
-"............................................................................................................................bjjjtjjjjtjtjsy................................................................................................................................................................................................................................................................................................................................................................",
-"............................................................................................................................jjjjjjjtjttjjsy................................................................................................................................................................................................................................................................................................................................................................",
-".............................................................................................................................jjjjtjjtjjtjsy................................................................................................................................................................................................................................................................................................................................................................",
-".............................................................................................................................jjjjbtjjtjtjey................................................................................................................................................................................................................................................................................................................................................................",
-"..............................................................................................................................jjtjjtjjjtjyy................................................................................................................................................................................................................................................................................................................................................................",
-"..............................................................................................................................bjjjtjjttjqyy................................................................................................................................................................................................................................................................................................................................................................",
-"...............................................................................................................................jjjjjtjjtsy.................................................................................................................................................................................................................................................................................................................................................................",
-"................................................................................................................................jjjtjtjvyy.................................................................................................................................................................................................................................................................................................................................................................",
-".................................................................................................................................jtjjtveye.................................................................................................................................................................................................................................................................................................................................................................",
-"...................................................................................................................................vssyye..................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"...........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................",
-"..........................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................."
-};
+static char * wl_logo_alpha_xpm[] = {
+"491 176 256 2",
+" c None",
+". c #020204",
+"+ c #3874C3",
+"@ c #871113",
+"# c #133C73",
+"$ c #87446C",
+"% c #523C70",
+"& c #C91715",
+"* c #88ABDB",
+"= c #757574",
+"- c #135AB4",
+"; c #565654",
+"> c #C63040",
+", c #6F92BF",
+"' c #B54558",
+") c #8E3151",
+"! c #4F0C0E",
+"~ c #355782",
+"{ c #E81A1C",
+"] c #925D81",
+"^ c #2F3A4C",
+"/ c #5B8CCC",
+"( c #A72D45",
+"_ c #0F2137",
+": c #6B3D67",
+"< c #6E5991",
+"[ c #927598",
+"} c #90908F",
+"| c #5774A0",
+"1 c #3568AD",
+"2 c #76A0D4",
+"3 c #DF303A",
+"4 c #AA3852",
+"5 c #7285AA",
+"6 c #E7282F",
+"7 c #4D698B",
+"8 c #87919E",
+"9 c #354B69",
+"0 c #9E4562",
+"a c #C92533",
+"b c #5681B9",
+"c c #B85C76",
+"d c #2064BC",
+"e c #282828",
+"f c #9D5C7F",
+"g c #6C4C7E",
+"h c #194B8A",
+"i c #4F4F4E",
+"j c #3858A4",
+"k c #270604",
+"l c #AB1314",
+"m c #CD4353",
+"n c #D8242F",
+"o c #C93D4C",
+"p c #FC1E1C",
+"q c #2658A1",
+"r c #883C5C",
+"s c #BBC8D4",
+"t c #442A40",
+"u c #B42C40",
+"v c #6E9AD2",
+"w c #10315D",
+"x c #436897",
+"y c #487FC4",
+"z c #505896",
+"A c #B55166",
+"B c #6B6B6B",
+"C c #405064",
+"D c #7B3E69",
+"E c #828384",
+"F c #6781A6",
+"G c #40569F",
+"H c #865076",
+"I c #847294",
+"J c #B01E24",
+"K c #D22F3B",
+"L c #9183A9",
+"M c #B7374D",
+"N c #9A526C",
+"O c #9D6989",
+"P c #524C8A",
+"Q c #0B141D",
+"R c #AAAAAC",
+"S c #3A3D71",
+"T c #DC3B46",
+"U c #5F696F",
+"V c #264D86",
+"W c #4875B1",
+"X c #E82227",
+"Y c #846B94",
+"Z c #B93247",
+"` c #243D62",
+" . c #637699",
+".. c #F1262B",
+"+. c #8198C0",
+"@. c #344E94",
+"#. c #5C4E86",
+"$. c #623A64",
+"%. c #165EB4",
+"&. c #9C2F4B",
+"*. c #760F0E",
+"=. c #82A5D4",
+"-. c #E72F37",
+";. c #C92A3B",
+">. c #D92A36",
+",. c #94466D",
+"'. c #7A7A7D",
+"). c #1F2021",
+"!. c #A27697",
+"~. c #22162C",
+"{. c #4D619C",
+"]. c #1C58A7",
+"^. c #7890B9",
+"/. c #C3475A",
+"(. c #326EBC",
+"_. c #5386CB",
+":. c #35619F",
+"<. c #BD2C40",
+"[. c #921E28",
+"}. c #97B6DB",
+"|. c #6A97D4",
+"1. c #A8465F",
+"2. c #2C2E2F",
+"3. c #7A4E7B",
+"4. c #B81615",
+"5. c #265EA6",
+"6. c #963C5A",
+"7. c #7898C7",
+"8. c #7D6A9C",
+"9. c #622438",
+"0. c #D7D7D5",
+"a. c #A6BEDC",
+"b. c #A3A3A1",
+"c. c #6D3452",
+"d. c #421A24",
+"e. c #140304",
+"f. c #C8C8C8",
+"g. c #5F6062",
+"h. c #445872",
+"i. c #3F3F3E",
+"j. c #7B5982",
+"k. c #3E1E34",
+"l. c #B26A84",
+"m. c #97B2DA",
+"n. c #991314",
+"o. c #D91A1C",
+"p. c #39080C",
+"q. c #7E7E7C",
+"r. c #24446B",
+"s. c #BEBFBF",
+"t. c #3E4682",
+"u. c #6F6895",
+"v. c #4E5F7A",
+"w. c #122948",
+"x. c #7A2A4C",
+"y. c #7A1A24",
+"z. c #4E457E",
+"A. c #5F4577",
+"B. c #1E2731",
+"C. c #8084B2",
+"D. c #1E314B",
+"E. c #6C4477",
+"F. c #917CA4",
+"G. c #7A3450",
+"H. c #144382",
+"I. c #794471",
+"J. c #41618C",
+"K. c #0C0E0E",
+"L. c #6A6197",
+"M. c #1A0E14",
+"N. c #D0D0D1",
+"O. c #414D90",
+"P. c #5E6BA2",
+"Q. c #BE1E24",
+"R. c #151517",
+"S. c #906887",
+"T. c #B6B6B4",
+"U. c #4B67A9",
+"V. c #1352A4",
+"W. c #959697",
+"X. c #4260A3",
+"Y. c #6391CB",
+"Z. c #AB5B76",
+"`. c #955372",
+" + c #5B0C0E",
+".+ c #AB546E",
+"++ c #33435A",
+"@+ c #7A5F8C",
+"#+ c #7574A4",
+"$+ c #3F6CAE",
+"%+ c #587AAC",
+"&+ c #32120C",
+"*+ c #58609F",
+"=+ c #333435",
+"-+ c #DA4250",
+";+ c #C15267",
+">+ c #AA6A8C",
+",+ c #906288",
+"'+ c #748AB1",
+")+ c #37527A",
+"!+ c #427AC4",
+"~+ c #22529A",
+"{+ c #767BA7",
+"]+ c #847BA3",
+"^+ c #3A5E8C",
+"/+ c #A73E5A",
+"(+ c #546E90",
+"_+ c #BA3E54",
+":+ c #4F5289",
+"<+ c #305288",
+"[+ c #666EA4",
+"}+ c #6886B3",
+"|+ c #637A99",
+"1+ c #3E7AC4",
+"2+ c #86161C",
+"3+ c #8E3656",
+"4+ c #A8324A",
+"5+ c #296ABC",
+"6+ c #6E5284",
+"7+ c #270E0E",
+"8+ c #AA1A24",
+"9+ c #D21E24",
+"0+ c #4C6E9F",
+"a+ c #4F5877",
+"b+ c #8190BB",
+"c+ c #1F467D",
+"d+ c #92B2DC",
+"e+ c #BA627C",
+"f+ c #F62224",
+"g+ c #8A8A8C",
+"h+ c #A2BEDC",
+"i+ c #3A0E14",
+"j+ c #B54A64",
+"k+ c #1E5294",
+"l+ c #AC2634",
+"m+ c #0E1A2C",
+"n+ c #993651",
+"o+ c #2A3644",
+"p+ c #464646",
+"q+ c #828AB7",
+"r+ c #B92637",
+"s+ c #966E9C",
+"t+ c #D53C48",
+"u+ c #884A74",
+"v+ c #C63644",
+"w+ c #7AA6D4",
+"x+ c #DD363F",
+"y+ c #9A4A64",
+"z+ c #A0627C",
+"A+ c #CA4A5C",
+"B+ c #4E86CC",
+"C+ c #B65670",
+"D+ c #D23642",
+"E+ c #8F8AB4",
+"F+ c #9B6E8F",
+"G+ c #626E7C",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" v v v v v v v 2 v 2 ",
+" 5+5+5+ |.Y.|.v v v v v |.2 v 2 v 2 v 2 2 v 2 v 2 v 2 v 2 ",
+" 5+5+5+5.. |.Y.v v v v v |.|.v v v v v v v 2 2 2 |.v 2 2 2 v 2 2 2 2 2 2 2 v 2 ",
+" 5+5+5+5+5+K.K. |.Y.|.Y.2 Y.|.|.2 v v v v |.2 2 |.2 2 |.v 2 2 2 v 2 2 2 2 2 2 2 2 =.2 2 2 2 2 2 2 ",
+" d 5+5+5+5+5+_ . Y.Y.|.Y.v |.7.|.v v |.|.|.v |.v v v |.v v v 2 v 7.v 7.2 2 2 2 2 2 2 2 2 v =.2 2 =.2 =.2 2 2 , ",
+" 5+5+5+5+5+5+5+_ . Y.Y.|.|.|.|.|.|.|.|.|., v , |.v v v v v v 2 |.2 |.2 2 2 2 v 2 v 2 v 2 2 2 2 =.2 w+2 2 2 2 =.2 =.w+2 =.}+ ",
+" 5+5+5+d 5+5+5+5+(.# . Y.|.|.|.|.Y.Y.|.|.|.|.|.|.|.|.v v |.v |.v v v v v v 2 |.2 v v 2 v 2 2 2 2 v 2 2 2 2 v =.2 =.2 L !.b+=.w+w+w+w+=.b ",
+" d d d 5+5+5+5+5+5+5+c+. Y.Y.|.Y.Y.Y.|.|.|.Y.|.Y.|.|.|.|.v |.|.v v v v v v v 2 v |.2 |.2 2 2 2 v 2 2 v =.2 2 2 2 2 b+L l.-+x+v+F++.2 =.w+w+=.=.w+'+ ",
+" 5+5+5+d 5+d 5+5+5+5+5+c+. Y.Y.Y.Y.Y.Y.|.|.Y.Y.|.Y.|.|.Y.|.|.v |.v |.v |.|.v v v v v v v v 2 2 |.2 v 2 2 2 2 2 v 2 2 2 =.^.f f+p p p 6 Z.2 w+2 =.w+* 2 =.w+, (+ ",
+" 5+d d d (.5+5+5+5+5+5+5+# . / Y.Y.Y.Y.|.Y.|.Y.Y.|.|.Y.|.|.v |.|.|.|.|.|.v v v v v v v v v |.2 2 |.v v 2 2 v v v 2 2 2 2 2 2 v C.A f+p p p f+Z.+.=.=.w+w+2 * w+w+=.* |+ ",
+" d d 1 5+(.5+d 5+d 5+5+5+5+5+_ . Y.Y./ Y.Y.Y.Y.Y.Y.Y.|.Y.|.Y.|.|.Y.|.|.|.|.|.|.|.|.|.|.|.7.v v v 2 v v 2 v 2 v 7.7.7.2 ^.5 b+E+b+7.=.w+, ]+A 6 p f+t+F.2 2 =.2 w+=.2 =.w+w+w+w+, C ",
+" d d d 5+5+d d 5+5+5+5+5+5+5+(._ . Y.Y.Y.Y.Y.Y.Y.Y.|.Y.|.Y.Y.Y.|.Y.Y.|.Y.|.|.Y.|.|.v v v v |.|.v v v v v v v v v v 2 2 [ t+x+/.;+m ' Y , v =.2 7.!.T f+/.b+w+=.w+=.=.w+=.=.=.w+=.* =.w+h. ",
+" d 5+5+d 5+5+5+5+d 5+5+5+5+5+5+5+_ . Y./ / Y.Y.Y.Y.Y.Y.Y.Y.Y.Y.Y.|.|.Y.|.Y.|.|.|.v v v Y.|.|.|.v v v v v v v 7.v 2 2 2 2 v 7.1.6 f+f+p p p ' C.7.v 2 2 ^.z+6 t+[ 2 2 =.w+w+=.w+=.=.* =.w+=.w+* 7 ",
+" d d 5+d 5+5+d d d 5+5+5+5+5+5+5+5+5+Q . / Y./ Y.Y./ Y.Y.Y.Y.Y.Y.|.Y.|.|.Y.Y.|.|.|.|.Y.|.v |.|.v v v v v v v v |.|., [ [ C.v |.2 2 7.[ ;+f+p p p p 6 o 5 2 =.w+2 {+x+..C+b+w+w+2 =.w+=.w+w+w+=.* =.* w+* F o+ ",
+" d d d d d d d 5+5+5+5+d d 5+5+5+5+5+5+. . 1+1+!+ / / / / Y./ Y.Y.Y./ Y.Y.Y.Y.Y.Y.Y.|.|.Y.|.|.|.|.Y.|.|.|.v Y.|.|.|.|.|.^.b+[ A+t+x+K ' I C.Y.7.v 2 |.z+6 p p p p ..z+E+v w+2 ^./.p p c +.=.=.2 =.w+=.w+w+w+* w+=.w+* w+^.B. ",
+" d d d d d 5+1 5+5+5+5+d 5+5+5+5+5+5+5+5+(.. . 1+!+!+!++ y !+1 / / / Y.Y.Y.|./ Y.|.Y.|.Y.Y.Y.|.Y.Y.Y.Y.Y.Y.Y.|.|.|.|.Y.|.|.v |.v v v Y.s+m ..f+..X p X X /.I v 2 2 |.]+o p p p p f+3 c 2 2 2 7.S.f+..c =.2 =.* w+=.=.=.=.=.w+=.* * =.* * 7.). ",
+" d d d d d d d d d 5+d d 5+5+5+5+d 5+5+5+5+5+c+. . + !+1+!+!+y + y !+W r. / / Y./ Y./ / / Y.Y./ Y.Y.Y.Y.Y.Y.Y.|.Y.|.|.|.Y.Y.|.|.Y.|.v |.|.v |.|.v ^.,+D+f+p >.Z..+3 f+p ..m F.7.2 v '+A f+p p p f+p T F.+.2 7.[ 3 -.s+2 2 w+w+w+2 =.=.=.=.w+=.w+* 2 * w+* F K. ",
+" d d d d d 5+d d d 5+d 5+5+d d 5+5+5+d 5+5+5+5+w . !+!+1+1+1+y !+y !+y 1+y m+ / / / / / / / / |./ Y.Y.Y.Y.Y.Y.Y.Y.Y.|.|.Y.Y.Y.|.v |.|.|., |.|.|.|.v |.v , T p f+f+Z.^.5 f x+p p f+c q+v 2 , f -.p p t+_+6 f+m L 2 2 C.A+X .+, =.2 2 =.* =.w+w+=.* w+=.=.* w+w+* * 7 R. ",
+" d %.5.d d d d d 5+5+d d 5+d 5+5+5+5+5+5+d 5+5+5+5+Q . 1+1+W 1+1+1+1+1+1+y 1+y 1+<+. / / Y./ / Y./ |./ Y.Y.Y.Y./ Y./ Y.Y.Y.Y.Y.|.Y.|.|.|.Y.Y./ C.]+[ 5 , |.|.v |.^.S.6 p v+#+^.v v |.F..+6 p 3 .+7.2 2 #+-.f+p !.I v+X n j+]+2 , Z.../.C.=.=.w+w+w+=.w+=.w+=.w+=.=.* * w+* * * ++ ",
+" d %.d 5+d d d d d 5+d d d d d d 5+d d 5+5+5+5+5+5+5+5+. . + 1+1+1+1+!+1+1+y 1+1+y 1+y $+. / / / / / / / Y./ Y./ / Y./ Y.Y.|.Y.Y.Y.Y.Y.Y.|.Y./ Y.5 O C+m 6 6 O v |.|.}+X.a+&.X X 6.{.x 7 }+v v 5 ,+o 6 v+]+2 v , A 3 p c '+F+v+f+>.] '+7.s+-.6 [ 7.=.2 w+=.=.w+* w+* * * * =.w+* w+w+* * _ ",
+" d %.d d %.d d d d d d d d 5+5+d 5+d 5+5+d d 5+5+d 5+5+5+c+. . 1++ + 1++ 1+1+!+1+1+1+!+y 1+y 1+. K. / / / / / / / Y.Y.B+|.Y.Y.Y.Y.Y.Y./ Y.|.Y.Y.Y.Y.}+]+F+A+3 -.p p p p [.e.. . . . 7+& p { Q K.=+9.u n f ^.v 2 5 N p x+b+7.`.6 p 6 S.7.F T p z+b+=.=.=.* w+=.w+w+=.w+w+* * * =.* * * * 7.K. ",
+" %.%.d d %.d d d d 5+d d d d d d d 5+5+d 5+d 5+5+d 5+5+5+5+5+Q . + + !+y !+!+!+!+1+1+y y y 1+y y y . . / _./ _./ Y./ / / / Y.Y./ Y./ Y./ Y.Y.Y.Y.Y.Y.|.C.Z.A+3 p p p p p p p p o.p { & f+{ x.p+7 , ,+3 -.F.7.q+O t+..v+O ]+A p 3 ;+2 w+w+w+=.w+=.=.w+=.=.=.w+=.* w+* * w+* v.K. ",
+" d %.d %.d d d %.d %.d d d d d d d d d d 5+d 5+d 5+5+5+5+5+5+5+5.. . + y + 1+1+1+1+1+!+!+!+1+1+y + 1+y + . . / / / Y./ / / / Y./ Y./ Y./ Y./ Y.Y./ |./ Y.Y.Y.^+c.{ p p p p p p p p l o.p 4.{ p 4. A.<.f+e++.2 2 >+....D+/.3 p p T b+2 w+=.w+=.=.=.=.* w+* * w+* =.* * * w+* B. ",
+" - d %.%.d d %.d %.d d d d 5.d d d 5+5+d 5+d d 5+d 5+5+5+5+5+5+5+5+5+w . K. y + !++ + 1+1+!+1+1+1+1+1+1+y y y ~ . . _.B+/ / B+/ / / / Y./ / / Y./ Y.|./ / Y.Y.B+:.D.. k @ p p p p p p p p p l p { p & o.p _+= =.2 8 z+o ..p p p f+;+b+=.=.=.=.w+w+* * =.* w+=.* * * w+w+* * * F . ",
+" %.%.%.%.%.d - 5.d - d %.d d 5.d d d d d %.d d 5+5+d 5+d 5+d 5+5+d 5+d 5+].. . + 1++ !+!++ W + !+!+!+!+y 1+!+!+1+1+r.. / _.Y._./ / / / / / / / / Y./ Y./ / |+8..+r k.. . K. { o.& { p p p & p & p { p p }+w+b+S.x+f+p p p A b+2 =.=.=.w+=.w+w+w+* * w+w+* * * * * * * * ++R. ",
+" - - ]. - - %.%.%.%.%.- d %.d - d d d d d %.d d d d d d d 5+d d d d 5+d d 5+d d 5+5+5+d w . K. + W + y + + y 1+!+1+1+1+y + y y !+y y _ . _._./ _./ / / / / / / / / / F {+x+-.v+4 J { p *. p p { { p { l p p l { p , '+Z.K p p p t+]+w+2 w+* w+* w+* =.w+w+* * =.* * * w+* w+* 7.. ",
+" - - - - - - - - %.%.%.%.- %.%.%.d %.%.d d d d %.d %.d d d d d 5.d d 5+d d d d 5+d 5+d d 5+5+5+d 5+(.k+. . 1+1++ + 1+1+1+1+1+1+!+1+1+1+1+1+1+1+y 1 . . _./ / / / / / / / / / / Y.B+|+0 p p p p o.p p p o. p p p o.p { { { & & p p q+y+p p p ..I =.w+w+=.w+=.w+w+=.=.=.w+=.* w+* * * * * * w+B.K. ",
+" - - - - - %.- - - %.%.%.%.%.%.%.d - - %.%.- d %.d d d %.d d d d d %.d d d 5+d d 5+5+5+5+d 5+5+5+d K.. R. + + + 1++ 1++ + 1+1+!+1+!++ y !+1+y y !+r.. K. _./ B+/ B+/ / B+/ / / / / Y.F N X p p p p p p p p { n. { p & p { o.{ o. { p p ,+K p p f+A , =.w+w+=.w+* * w+* * * * =.w+* * w+* * * * }+. ",
+" - - - - - %.%.- ].%.%.- %.%.%.%.%.d d %.d %.%.d %.d d d d d d d d 5+5+d d d 5+d 5+d 5+5+5+5+5+5+_ . . 1+1+1+1+W 1+!++ + + !+1+y + !+y 1+1+y y K.. / _.B+/ / / / / / / Y./ / / / u.J p { { p { p p p & p { { p & { o. { p p { 4.>.p f+/.^.2 =.=.w+=.w+* 2 w+w+w+* * w+=.* * * * * * =.Q K. ",
+" - - - - - - - %.%.].%.%.%.%.%.5.d %.%.d %.d d - d d d %.d d d d d %.d d d d d d d 5+d 5+d 5+d # . . + + + + 1+1+1++ !+!+y 1+!+!+1+y 1+1+y 1+` . . B+_./ / B+B+/ / B+/ B+/ / / y ^ +& p { & { p o. p p o.p { { p { p p p p & o.o x+c b+=.=.w+=.w+=.=.* w+* * =.* * * * w+* * * * * C . ",
+" - - - - %.- - - %.- %.].%.%.%.%.%.5.%.d %.d d - %.d d 5.d d d d d d 5+d 5+d 5+d d d d 5+5+5+c+. . + + + + + + 1+1++ 1+1++ 1+1+1+1+1+!+!+y y K.. / B+_._.F S.P.|+/ / / / / / ` . . n.p p o.{ o. p p o. p p { p p p { p p p p p { F+L 2 w+=.w+=.w+=.w+* =.w+* =.* * w+* * * * * * * F . ",
+" %.%.- - %.%.%.%.%.%.%.%.%.%.%.%.%.%.%.%.%.d d d d d %.d %.d d d d d d d d d 5+5+5+5+d d H.. . + 1+1+1+1+1++ + W y + 1+!+1++ y !++ y 1+1+w . . _. .Y f m ..6 M o #+/ / / V Q . . { p p o. p p { { p p o.p p { & p p p p p & w+w+=.w+=.=.=.w+* =.w+* 2 * w+* * * w+* w+* * * * K.R. ",
+" - %.%.- - %.- %.- %.%.%.%.%.d d %.d d %.d %.d %.d d d d d d 5+d d d d 1 d d d 5+d 5+5+w . . (.+ + + + y + 1++ 1++ 1+W 1+1+1+y + !+1+:.. . 8.A o 3 p p f+p f+p >.y+a+_ . . p p { { p { o.p { p p p o.{ p p p =.=.w+w+=.=.w+=.* w+* w+=.w+* * * * * * * * * * ^ . ",
+" - - - - %.- %.].%.%.%.%.%.%.- %.%.%.q d - d %.d d %.d d d d %.d d d d d d d d d d 5._ . . + + + + + 1++ + 1+1+1+!+1+1+!+!+!++ y y $+K.. R. 3 f+f+p p p p ..o > X f+9+! e.R. p p p p p { p { & p p { =.=.w+=.=.=.=.w+=.w+* * * * w+* * * w+* * * * (+. ",
+" - %.- %.- %.%.].%.%.%.d %.%.%.d d %.d %.d - d d d d d %.d 5+d 5+d d d 5+5+d 5+h K.. K. + 1+1+1+1++ + 1++ + 1++ + 1+1+1+1+y + 1+1+w.. K. n p p p p 6 o f [+#+@+4+o.o.*. p p p { { p { l { p p { & p p { { =.w+w+=.* =.=.* w+=.* w+w+=.* * * * * * * d+7.. ",
+" - - - - %.- ].d - ].%.%.%.d d %.%.d %.%.%.d d %.d %.d d d d 5.d d 5+d d d d w . . R. + + + + + 1+1+1+W 1++ !+y 1+1+1+!++ y 1+D.. . u.> f+p p p _+F / / _.2.e.@ { { p p p p p { { p p p { { p p { { { p p p p p p p p =.* =.=.w+w+* w+* w+=.* * * w+* w+* * w+d+=.* . K. ",
+" - %.- %.%.%.- %.%.%.%.%.- ].%.%.d d d d %.d d d d d %.d d d d d 5+d d k+K.. . + + + + + + W + 1+1++ + + + + !++ y 1+!+<+. . p p p p p p p B+b `.6 f+p p `._._.U.K.. . { { 4. { p p p p p p p p p p { p p p p p p p p p 4. w+w+=.* w+=.=.* * =.* * * * * * * * * * * w+).. ",
+" %.- - - - - %.%.].%.%.%.%.5.d %.5.%.- d %.%.d %.d d d d d d d d d 5._ . . R. + + + + + 1++ + + + + 1+y 1+y !++ y 1+1+<+. . p p p p p p p p p p ,+_.B+b u.0 >.f+j+_.9 . . R. o.p l & { p p p p p p p p p { p p p { { { p w+=.=.w+w+w+* w+* w+* w+* w+* * * * * d+d+^ . ",
+" - %.%.%.- %.%.- %.%.%.d %.%.d d d - d d d d d %.d %.d d d d d w.. . K. + + 1+1++ 1+1+1+1++ + W + + 1+!+1+1+1+<+. . p p p p p p p p p { p p p .+b / B+/ P.0 X D+t . . { { p p o.p p 4.{ { p 4. p p p p p p p p o. w+=.=.* * w+* =.* w+* * * * w+* w+* w+* * o+. ",
+" %.].- d ].- d %.%.%.%.%.%.- %.%.d d %.d %.d d 5+d d d d H.K.. . (.+ (.+ (.+ + + + 1+1+1++ 1+1++ 1+1+1+<+. . { p p p p p p p { { f+p m [+B+_._.b j.>.o.! Q { p { { { o. o.p p p p p p p p { w+* w+w+=.w+w+w+* * w+* * * * d+* d+* * .. ",
+" %.- %.%.%.].- %.%.%.%.d d %.d %.d - d %.d %.5+%.d q Q . . 1++ 1++ 1+1++ 1++ + 1++ 1+1++ y + + 1+V . . p p & { p p p p { L.X p 6 8._._._._.z.l p 2+ { { p p { { p p p p p p p p p { w+=.=.=.w+* * * w+w+* * w+* w+* w+* * w+(+. ",
+" %.- - %.%.%.%.%.d d %.%.%.%.%.%.d d d d d d d w . . K. (.(.+ + + (.+ + 1++ + 1++ + 1++ !+!+r.. . p p p p p { o.p { l B+(+v+f+p ,+B+/ B+` . *.p { { { p p p { o.{ & { p p p p p p p p p =.=.* * w+* =.* * w+* * * * * * * w+2 %+. Y.|. ",
+" - ].%.%.%.%.- %.5.d d d %.d %.d %.%.%.].m+. . + 1++ + + 1++ + + 1++ + 1++ W 1++ 1+w.. . p p p p p p { { { & %+W W P.u+j+8._._.B.. . p p p { p p p p p o. { o. p p p p * w+=.=.=.* * * * w+* * * * * * w+B+y y m+Q 2 |.|., . ",
+" H.V.%.%.%.- d - %.- d d d d d d h K.. K. + (.+ (.+ + 1++ + + 1+1++ y 1++ $+m+. . p { { { p p p { { o. y [+H @+%+%+%+B+W _ . . o.p p p p p p p p { p p l { p { p p w+=.w+* * w+w+w+* * * w+* * * w+/ y b B+<+. Y.v v v v . K. ",
+" _ _ _ _ K.K.V.- - d %.d H.. . R. + + + 1+(.+ + + 1++ + + 1++ 1+1+5.K.. K. p p p p { { p p { { o.4. _.y j.>.3 8._._.W K.. K. & p p { o.p p p p p { { { p p p =.w+w+* * * * w+* * * * * * / y y y y ~ . 2 Y.v v v |.. . ",
+" %.%.d d q d ].. . (.+ (.+ (.1++ + 1++ 1++ + + + + r.. . R. p p p p p p { & p p { { { j.u./+X p f b W K.. K. { p { p p { p p p { p p p { * =.=.w+w+w+* * * w+* w+* Y.y B+B+B+B+y . Y.2 |.v v v . . ",
+" %.d d d d %.H.K.. K. + 1++ 1+(.(.1++ + (.!++ 1+1+1 w.. . { p p p p { l { { o.p p X 6 _+6 p p v+U.K.. K. { p { p p p p p p p { p p p p p p w+=.=.* =.w+* w+* * * * 2 y y y y y b y . . 2 Y.v |.|.7.|.. . ",
+" d %.- - d ].. . (.(.(.+ (.+ 1+(.+ (.1++ 1++ 5.K.. K. { { p p p { { p o. & p p p p p p p p ..&+. K. o.p p { p p { p p p p p p p { p { * * * w+* * * * * * w+* B+y y B+B+b B+y . . Y.|.v |.v |.|.v . . ",
+" %.d d d d V.K.. K. + + + + + + + 1+1++ + + + D.. . R. { { p p & { p { & { p p f+>.K f+p X *.K. l p p { { p o.{ p p p p p w+=.w+w+w+w+* w+* * * |.y B+y y B+y B++ . . v |.v v v v |.v . . ",
+" %.q %.%.%.V.K.. K. (.+ (.+ + (.+ + (.+ + 1+q K.. . l { { & p { & Z p p n `.@+Z p 4.! p { p o.p p p p p { p =.* * =.* * w+* * 2 y B+y B+y y B+y ~ . K. v |.v Y.|.|.v v v . . ",
+" d %.d %.%.].K.. K. + + (.+ + + + + + + + 1 . . Q { p { p p l | 3.;.p Z L.0+M. + + o.p { p p { { { p p p p w+=.* 2 w+* w+w+* / y b y y B+y y y ~ . v |.v v |.|.v , x . . ",
+" %.d %.%.%._ . K. (.(.(.+ + + (.+ + + + + D.. K. o.{ p l { p & y B+[+Z X 6.%+K.. K. { p p p p p { p p =.w+* * * * * * |.1+y y y b y y B+b ` . Y.|.v |.|.v v |.v x . d+ ",
+" %.%.%.%.d _ . . + (.+ (.+ + + + + + + 1+. . p p p o. { p & y y B+y /+X &.e . . & p p { p p p p p l =.w+w+w+w+* * 2 B+y B+y B+B+B+y y y w.. |., |.v |.|.v |.v |.2.. }.}.d+}.d+* ",
+" %.%.%.%.d w . . *+6+{.(.+ + + + + + + 1+# . . p p { o.{ & B+B+y b j.a Q.p.. & p p p p p p p p * =.* * * * w+Y.y y y B+y y y B+B+B+. . |.|.|.|.v |.v v v v _ . d+}.d+d+}.}.}.}.. K. ",
+" %.%.%.d - H.. . p K >.M 3.+ (.+ (.+ + (.+ K.. p p { { { { y y y y B+u.r+& + { p p { p p p =.w+w+=.w+* v y y y y y y B+y y y ~ . . |.|.|.|.|.|.|.|.|.|.}+. . d+d+d+}.}.d+}.}.v.. . ",
+" %.%.- %.~+. . p p f+f+p p X r v.(.+ + + 1+c+. . p p { { y y B+B+B+y :+@ & o. p p p p p p * =.* * * * _.y y B+y y y y B+B+y m+. |.|.|.|.|.v |.v v v )+. K. d+d+d+d+d+d+d+d+m.Q . ",
+" ].%.%.%.- K.. K. p p p p p p p o.$ X.+ + (.(.K.. o.p { p { { B+y y y B++ M.@ p p o.{ p p p p p p p p w+w+=.w+* |.y y y B+B+b y y y B+x . . |.|.|.Y.|.|.|.|.|.|.v K.. }.d+d+d+d+}.}.d+7 . . ",
+" %.%.%.%.%.Q . K. p { { p p p p p p p a I.X.(.1+k+. . { p p o.4.p p y y %+B+B+y e.p.& p p p p p p p p p p * =.* * 2 1+B+y y y y B+y B+y y m+. R. |.|.|.v |.v |.|.v v ~ . . d+d+d+}.d+}.d+}.=.. . ",
+" %.%.%.%.w.. . p p p p p p P 6.M n p p p f+p > :+(.+ Q . { p p p p p p B+y y y y y D.k { p p p p p p p p w+w+w+=.|.y y 1+y y y B+y b B+x . . |.|.|.|.|.|.v |.v v }+K.. d+d+d+d+d+d+d+d++.R.. K. ",
+" - %.- %.# . . { p p p p o. (.+ $+{.3.p p p p p { I.U.~ . . { p p p p p y y B+y y ~ e.*.p p p p p p * =.* w+1+y y B+y y y y y B+B+K.. R. |.Y.|.Y.|.|.|.|.|.|.|.D.. K. d+d+d+d+}.d+}.d+^ . K. ",
+" %.- %.%.V.. . p p & { p p p { (.(.(.(.+ 1 6+X p p f+6 p > $ w . R. & { p p p p @+B+y B+B+W K.e. p p p * =.* _.y y 1+B+y B+y y y y | . . |.|.|.|.Y.v Y.v |.v 7 . . d+d+d+d+d+}.d+}.C . . ",
+" - ].%.%.- K.. K. { p p p p o. o.p { o. 5+(.(.(.+ + (.$ n X 4 < y+X p ;.k . { p p p >.u.!+y y y m+. . p w+2 2 y y y y y y y y B+y v ^ . R. |.|.Y.|.v v |.v |.|.J.. . d+d+d+d+}.d+d+}.|+. . ",
+" %.%.%.%.w.. . p p p p p { { { & (.+ (.(.5+5++ $+r n ;.g x *+4 6 p & ! o.{ p p M | y y y 9 . . =.* =.B+y y y y y y B+y y / 7.. . , |.|.|.|.|.|.|.v b K.. d+d+d+d+d+d+d+%+. . ",
+" - - - ].V.. . 4.{ p p p p { o.{ r+P 1 5+(.+ + (.(.X.D X n g $+$+*+<.p p o.p p H !+y B++ . . =.w+2 y y y y y y y y y Y.* v.. K. |.|.Y.|.Y.|.Y.|.|./ Q . K. * =.* d+d+* d+d+}.}.'+. . ",
+" %.%.%.%.V.K.. R. p p p { p p p p p r+n : (.h h 5++ 5++ 1 3+p a I.X.(.{.;.p p p `.| y B+y m+. K. =.w+_.y 1+y y y y y B+/ * * K.. / |.|.|.|.v |.|.v b K.. K. * * * * Q K. d+d+d+d+d+d+2 K.. R. ",
+" - %.%.- - _ . K. p p p p p p p { o. { p p p 1 z ( X 3+++. d (.(.+ + X.) p p 6 4 #.y+p p p p o. y !+!+y !+9 . . =.2 1+y B+y y y y y / w+* }+. . / / / 0+ |.Y.Y.|.|.Y.|.|.}+R.. K. * * * * v.. . d+* d+d+d+d+=.R.. K. ",
+" - - - %.H.. . p p p p p p p p p p p { { { (.1 g ;.f+8+p.w + + 5+(.+ 1 D X p p X ;.n p p p p { y b y B+1 K.. d %.d w+/ y 1+y 1+y y B+Y.* * w+_ . R. _.B+/ _._.B+ / Y./ b K.. Y.|.|.|.|.Y.|.b K.. K. * =.* w+* 7.. . d+d+d+d+* d+Q . K. ",
+" - - %.- - K.. R. o.p p p p { p { p p p p o. { { 1 d :.$ { p 4.! 1 (.5+(.+ 5+X.$ X p p p 6 n { p p p { o. y y y y !+D.. K. d %.d d d H. * v 1+y y y B+B+y / w+* * '+. . _.B+_.B+_._._._./ b D. / / / Y.y K.. K. |.|.|.Y.|.|.|.b Q . K. v * w+* * * * (+. K. * * * d+* * * d+d+* d+d+d+^ . . ",
+" - - - %.- w . . { p p p p { { p p o. { p p $ /+M $ 4 >.{ p { 4.:.+ (.(.+ + :./+p p p n 0 c.*.*.& { { { y y y y y 1 . . d 5.d d 5.d . 5+5+ 1+1+1+1+!+y + W =._.y y y y 1+y / w+* w+* B.. R. _.B+_._._._.B+/ B+_._.B+~ . / / / / / ^ . K. Y.|.|.|.|.Y.|./ K.. K. 2 v 2 |.%+ * w+* * * * * * K. * d+d+* d+* }.d+d+d+d+d+d+Y.^ ^ m. ",
+" - %.- %.- V.. . { { p p o. o.p p p p p f+p p X p p p p p ( z (.(.(.5+(.X.4+f+p K $ X.t.. { { & y y y y y m+. R. d d d d d d d . . 5+(.(.(.5+. + 1+1+W + r.R.. . . w+y y 1+y 1+y / * * * * F . . y _.B+_.B+_./ _./ B+/ _./ / ^+. / / / / / / )+. |.Y.Y.Y.Y.|./ K.. K. v |.2 2 v 2 2 . =.* * * w+* w+* * 7.Q * }.d+d+* d+d+* d+* d+d+d+}.d+d+d+d+d+}.d+}.}.d+m.=. ",
+" - %.- %.%.w.. K. o.{ p o. 4.p p { p p p p p p p { p { p a A.5++ (.(.+ $+>.p p #.$++ + . & p p { o. y y y y y r.. . %.%.%.%.%.d %.d d d d d d d h . . 5+5+5+5+(.(.c+. K. + !+!++ 1 o+. . K. w+/ y y 1+y y / w+* w+* * ).. R. _.b B+9 D.` W B+B+_.B+B+_._.B+B.. / / / Y./ / / / ^+ Y.|.|.|.Y.b K.. K. 2 2 |.v 2 2 7.}+. . 2 2 2 2 w+=.* w+* * * * * =.* ^.). * * * d+* d+d+* d+d+* d+d+d+d+d+d+d+d+d+d+d+2 C . . K. ",
+" - - - - - V.. . p p p p l p o. { p j n+p p p p { & @ 4.a 9+D 1 + (.+ + $+4 p 4+X.+ (.+ m+. { p p p p { 1+y y y B+K.. %.%.%.d %.].` B.. . w %.%.d d d d d Q . R. 5+5+(.5+5+5+5+Q . (.(.(.+ (. + 1+1+1+1 K.. . =.y 1+y y y / * w+* * w+F . . y B+_. . . R. b _._./ / _./ / Q . / / / / / / Y.Y./ / / 0+ Y.|.|.|.|.}+Q . K. |.|.v 2 v v v v h.. K. 2 =.2 =.=., . * * * * * * * * * * * * 7.K. d+* d+d+d+* d+}.* d+d+d+d+d+d+d+d+d+'+v.B.. . K. ",
+" - - - - - - w.. K. { p p p p p p & p { { p 5+5.$ X p p Q.! 7+ r a 4+G (.5+5++ U.,.p <.:+$+(.(.` . { p p p p p y y y y y r.. . %.%.%.%.h Q . . K. d d d %.d d d H.. . 5+(.5+(.5+(.5+k+. . + (.+ (.+ 5++ # R. 1++ + + _ . . Y.y 1+y y / w+* w+* * * B.. R. _.y B+ . K. _._._.B+B+_._.` . . / / / / / Y./ / / Y./ / / / b Y.Y.Y.|.b K.. K. v v 2 |.2 2 v 2 / K.. 2 2 w+w+2 =.2 . K. w+* * w+* * w+* * * * * (+K. ^ ` o+'+* d+d+d+| | | 7 ^ ^ B.. . . R. ",
+" - - - - - - V.. . { p p p p p { o. p p & o.p { 5+5+5+5+O.n p { *.7+ g a u #.+ (.+ 5+*+4+f+p ;.$ *++ 5+. o.p p { & y y y 1+y K.. %.%.%.- ].Q . . d d d d %.d d w . 5+5+5+5+5+5+5+5+m+. R. 5+5+(.5+(.(.+ + (.. + 1++ !+$+K.. K. w+B+y y y B+* * w+* =.w+J.. . _.y _.R.. _._._./ / ~ . . _./ / / / / / / Y./ Y./ / / / y 2. |.|.|.Y.x . . K. 2 2 v 2 v 2 2 }+o+. K. 2 =.2 =.2 w+2 h.. . w+=.* 2 w+* w+* * * * * * * * ). d+d+d+d+'+. . ",
+" - - %.- - - w . K. & p p p p p { p { p p p o.q 5+5+5+5+:.8+p p + z u a : X.(.(.(.g n p p f+6 H (.(.o+K. p y 1+y y r.. . %.%.%.%.d H.. . K. %.d %.d d d d d h 5+5+5+5+5+(.(.(.# . . (.+ + + + 5++ 5++ + _ . + + 1++ $+K.. K. 2 y !+1+y 2 w+* * * * 7.Q . y / y _ . _._._.B+^+. . / / / / / Y./ / / Y.Y.Y.Y.Y.Y.D.K. Y.Y.|.J.. . v v 2 |.2 7.v Y.Q . K. =.2 w+2 =.2 =., Q . * * . 7.* * * * w+* * * * * | . d+d+* * * B.. R. ",
+" - - - - O.t.V.Q . o.{ p p p p { & { p p p { E.1 5+5+5+5.Q +{ p p (.1 &.X ( z 1 L.,.;.X p p p p 1.$++ :.. 1+y y y y K.. %.%.%.%.%.H.. . d d d d d d d d ].w. 5+5+5+5+(.5+5+5+5+K.. (.(.(.5+(.5++ + + (.+ w.. + 1++ 1+1+D.. K. w+/ y y y 2 =.* w+w+* * o+. K. y B+y ++. K. _./ B+/ ~ . . / / B+/ / / _.Y./ / / / Y./ / Y.m+. Y.|.|.W . . v v |.|.2 v 2 ++. . K. 2 2 2 2 2 2 =.Y.K.. K. w+ R. w+* w+* * * * d+* * 7.. * d+}.d+'+. . ",
+" ].@.O.D <.>.( c+. . o.p p p & p p p p p p p p { <.:+d 5+5+c+K.. p.o.p p (.U.( p f+a n 6 ..p p p p p p 0 U.(.+ w K. y y 1+y r.. . %.%.- %.%.%.%.K.. R. d d d d d d d d d ].Q 5+5+5+5+5+5+5+(.# . . (.+ (.(.+ + 5+(.(.5+(.(.w . + !+1+W 1+(.. . w+!+1+y |.w+=.* * w+* | . . y _.0+. . _._.B+!+2.. . / / K.. x y / / / / / Y./ / Y.)+. . Y.Y.}+K.. R. v v v 7.v v %+K.. . 2 =.2 w+=.2 }+R.. K. =. K. * * * * w+w+* * * * . K. d+* * d+d+` . R. ",
+" @.D u n p f+p X x.k K. p p { p p p p p p p n E.:.5+5+5+# . . { p 1 #.;.p p p p p p f+n K ,.I.6.z + + + 1 . y y y y y K.. - %.%.%.%.%.%.w . . d %.d d d d d d d # K. 5+5+5+5+5+5+5+(.5.. . (.5+5+(.+ 5+(.+ (.+ + (.+ V . + 1++ 1++ + r.. K. Y.y y y =.* w+w+w+* ^.Q . b B+B+K.. B+B+_._.x . . K. _. B+Y.Y./ / / Y.Y.9 . . Y.|.r.. K. |.2 v v v ++. . R. 2 2 2 w+2 2 (+Q . K. w+ * w+* * * * * * * . . d+d+d+* }.. . ",
+" : a p p p p p p { *. p p p p p p p X Z ,.j d 5+q w.. . { p p :.E.n p p f+p >.4 `.< $++ $+U.(.+ + + + w K. y !+y y c+. . %.- - - - %.%.%._ . d d d d d d d 5+%.d K. 5+d 5+5+5+5+(.5+5+# . K. (. . # (.+ 5+(.(.(.+ (.+ c+. + + + 1++ + w.. |.y 1+!+Y.=.* * * =.* o+. K. y y :.. . y _.B+B+_.x . . . / / / Y./ Y./ D.. . |.Y.|.. . v v 2 2 2 o+. . 2 2 2 2 =.=.h.. . * d+* d+* * * F . . d+* d+* %+. . ",
+" - z.<.n f+p p p p p n. p p p o. p p p p $ {.d 5+5+k+K.. K. p p p { (.:+<.6 K _+6+*+U.(.+ + (.(.+ + + (.+ + + K. y !+1+y y m+. - - %.%.%.%.%.%.. . %.d h d d d d d d d _ . 5+5+5+5+5+(.5+5+5+K.. (. K. + 5++ + + + + 5++ V . + + 1++ + 1++ w.. / y 1+y y v w+w+=.2 * (+. . y B+B+_.y y B+_.B+b %+9 R.. . R. / Y./ / D.. . Y.|.Y.. . v v |.|.| . . 2 2 2 =.2 2 o+. . w+* w+* * * v.. R. d+* d+d+d+C . ",
+" - - ~+A.: &.9+p p p p { o. p p { p p p a G 5+d 5+# . . R. o.p p p p & 5+:.g 6+X.+ (.+ (.(.5+(.+ + + (.+ + + + $+V . y y y y :.. . %.%.%.- %.].%.%.%.. . d d %.d d d d d _ . d 5+5+5+5+5+5+5+5+k+. . (.5+(.5+(.+ (.(.h . + 1++ 1+1++ y + D.. y / / 1+y y |.=.w+* =.|.. . B+y y $+` B.D.. . . . Q / / Y.w . . |.Y.Y.` . v v v 7.|.D.. R. 2 2 2 2 =.2 (+. . * * d+* * * _ . d+* d+* * ^ . ",
+" V.- - - V.h c.X p p p p o. p p { { & I.p X r q d 5._ . . { p p p p o. 5+(.(.(.(.(.+ (.+ + + + + (.(.+ + + + + 1++ w. 1+y !+y w.. R. - - - ].%.%.%.%.%.- K.. %. %.5+d d d d d Q . 5+5+5+5+5+5+5+(.5+# . R. + + + + + (.+ + V . + + + + + 1++ + :.. 1+B+2 y y y y y =.w+* =.Q . K. y b B+B+B.. Q / / / D.. . Y.Y.|.|.|.D. v |.v v 2 o+. 2 2 2 2 2 2 Q . * * w+d+}+. . * * * d+d+d+C . ",
+" - - - - - - - % Q.p p p p p { p p p { o. d d I.n n r 5.c+K.. K. { p p { { + (.+ 5+(.(.5++ (.+ (.(.(.+ (.(.+ (.(.(.+ + 1 . y y y 1+$+. . ].%.%.%.- %.%.%.%.%.w.. d %. d d d d d 5+d d . . 5+d 5+5+5+5+(.5+5+(._ . 5+(.5++ + 5+(.(.+ . + 1++ + + W + + + D.Q 1+y 2 w+!+1+1+y y / w+* =+. . y y _.y 1 . Y./ %+. . Y. Y.Y.Y.Y.|.Y.` v v v v v v | . 2 =.2 2 2 2 =.K.. w+ * * w+* B.. R. d+d+* * * * 5 . ",
+" - - V.- - - - V.z.a p X r+@ o.{ o. p p p o.{ 4. d d :.G.X p <.9.p.p. 5+(.+ (.(.(.(.5++ + (.+ + + + + + 1+1+(.+ + # K. 1+y !+y V . K. - %.- %.- %.%.%.%.- - V.K. - d d 5.d d d d d ].. . 5+ 5+5+d 5+5+5+5+5+5+5+_ . + + + (.5++ + + (.K.. + + 1++ 1+1++ 1+y 1+1+1+D. 1+!+1+v w+|.y !+y y y !+_.v.. . y B+_.y B+b <+R. _./ / / / ).. Y. Y.Y.Y.|.Y.Y.|.0+ v v v v |.v v J.R. 2 v 2 2 2 2 2 2 2 9 . w+ =.w+w+ w+* d+| . . * d+d+d+d+d+d+ .R. }. ",
+" V.- V.- - - - V.$.9+X &.@.~.@ { { o. p { o.p & @.d d d d E.a p p & & p { + 5+(.5++ (.+ 5+5++ + (.+ (.(.+ (.(.+ + + + + Q y 1+y 1+y Q . - %.- %.%.].%.%.%.%.%.%.V.w d d %. R. d d d d d d d d H.. K. 5+d 5+5+5+5+5+5+5+5+5+5+5.w 5+ 5+(.+ + (.+ 5++ (.# . + + + + + + 1++ + + + + 1+1+q 1 1+!+!+!+!+| +.w+Y.!+y !+y y y y (.m+ B+ y B+B+y _.y <+2. / _. Y./ / / . . Y.Y. _ Y.Y.Y.|.v Y.v |./ / v v v v v v 2 v 2 | 9 2 2 2 2 2 w+2 2 2 2 2 o+ w+=. R. w+=.=.* , e * w+7.K.. d+* * d+* d+* * .o+ }.d+ ",
+" - - - V.V.- - - V.S a X D ~+V. +{ p { o. p { & & { a z.5+d d 5+P o.p p p p p p l (.(.(.(.5++ + + (.(.+ + + + + + 1+1++ + + + 1 . 1+!+y y :.. . - - %.- - d ].%.%.%.%.%.%.%.%.%.%.%.5.%. . d d d d d d d 5+h . d d K.H.5+5+d 5+5+5+5+5+5+(.5+5+k+ K. (.+ (.5++ + + (.+ + w + + + + + + + 1++ W 1+1+1+1++ !+1+!+!+1+1++ + ` w+=.w+B+y 1+1+1+y y y !+y x y y B+y b B+y _.B+y x _._./ K. / / / / Y._ . / Y.Y. R.. |.|.Y.Y.Y.|./ |.v Y.|.Y.Y.Y. |.v |.v v v v v v v |.2 |., |. 2 v 2 2 2 2 2 w+2 2 =.2 2 |+ 2 w+=. K. w+=.=.* w+w+v.K. * * * B.. K. * * * d+d+d+* d+}.* d+7. d+d+}. K. ",
+" V.- - - - - V.- - c+&.{ n+@.].t & p p { p p { ( p n $.q d d @.y.{ p p p p p p + (.+ (.5++ (.+ (.+ (.(.+ + + (.(.+ + 1+W 1++ V K. y y !+y ` . R. %.%.- %.%.- %.%.%.%.%.%.%.%.%.%.%.%.d _ . . d d d d d d d d d d w.w d d d d K.. 5+5+d 5+5+5+5+5+5+5+5+c+. . 5++ + 5+(.+ 5++ (.+ (.+ (.+ $++ + B.. K.+ 1+1++ 1+1++ + + + 1++ + 1+1++ !+y 1 )., w+=.w+_.y y y !+1+1+y y y y 1+y + y y !+y y y y R.o+B+y B+B+y B+b y B+y y y / _./ . / / / / / / / 0+. Y.Y.Y.Y.^ . . Y.|.Y.|.Y.|.Y.|.Y.|.|.|.Y.|.Y.|.Y.|.|.v v |. 0+v v v v v 2 v v 2 |.2 v 2 |.v 2 v 2 2 7.K.o+2 2 2 2 =.2 2 2 2 w+2 2 2 2 =.=.w+w+2 K.. * * w+=.* =.w+. * * | . . d+d+* * d+d+d+d+d+* * * d+d+d+d+d+d+}.d+}.d+|+K.. ",
+" V.- - V.- - - - - - ~+( p n l+D a { p p p o. p p { q z.r+f+a #.5+d H.7+n.p p p p (.5+(.+ 5++ 5++ (.+ + + (.+ + 1++ + (.+ + + + w. !+1+1+y + K.. - - - - - - %.- %.%.%.%.%.%.d %.%.d _ . . %.d 5.%.d d d d d d d d 5+d d d 5.. . K. 5+d 5+5+5+5+5+5+5+5+5+V . . + (.5++ + (.+ (.+ (.+ + + (.+ V K.. K. 1++ + + + + 1+1+1+!++ !+y 1+!+!+1+1 K.7 2 w+w+w+/ 1+1+y !+!+y y 1+y y y y y y y y y y B+B.. K. y B+y B+B+B+B+_.B+_._._.B+_.B+_.B+_.B+_.B+_./ _.)+. . _./ Y./ / / Y./ !+0+/ / / Y.Y./ Y.b K.. K. Y.Y.|.Y.|.Y.|.|.|./ |.|.|.|.|.|.|.v |.Y.x . . | v v v v v v v v |.2 |.2 2 2 v 2 2 v 7 . . h.2 2 2 2 v =.2 w+2 =.2 2 =.2 w+2 =.o+. . =.w+w+=.* =.* =.9 . * * * . . * d+}.* d+* d+* d+d+}.d+d+d+d+d+d+d+d+}.+.Q . . ",
+" - V.- - V.- - - - V.@.r+p p p p p p p p p p { p p p j j $ <.X p 9+E.].m+. e. (.(.(.+ + + (.(.+ + + (.+ (.+ + 1++ + + + + 1 K. y y !+y :.. . %.- %.- %.- %.%.%.%.%.%.%.%.%.%.V.K.. . d d d d d d d d d d d d d 5+5._ . . 5+5+5+5+5+5+5+5+5+(.H.. . + (.+ 5++ (.(.+ (.(.+ 1++ # . . + + 1++ W + + 1+W 1++ + + + 1++ $+K.h.=.2 =.2 w+/ y + y y y y y y y y y B+y y y B+B+y B.. . B+B+y _.y B+y b B+_.b _.B+B+_._._._._./ B+_.y m+. . Y./ / / / / / Y./ Y./ / / / / |./ _.K.. K. Y.Y.Y.Y.|.Y.Y.|.|.Y.|.|.|.|., |.|.v v ++. . v v v v v 2 2 v v 2 v 2 v 2 v v 2 o+. . 2 2 2 w+2 2 2 =.2 2 w+2 =.2 =., ).. . =.=.w+=.w+w+* =., Q * w+* K.. * * d+d+d+d+d+d+d+d+d+d+d+d+d+d+d+d+|+. . K. ",
+" V.V.- V.V.- - - - - - @.u p p p p p p p p p p p o. p p p { r+6.4+f+X p p p <.S K.. K. (.+ 5++ (.5++ + (.+ (.+ + + + + (.1++ + + + + q K. 1+1+y y D.. R. - %.%.%.- - d ].%.%.%.%.%.- d # . . K. d d d d %.d d d d d d 5+d d H.K.. Q 5+d 5+5+5+5+5+5+5+c+. . 5++ 5++ + + + (.+ + (.(.w.. . + 1++ 1+1+1+1++ 1++ y 1+!+!+!+~+K.^ w+w+=.w+=.w+|.!+y y 1+y 1+y 1+y y !+y y y b !++ K.. . y B+B+b _._._.B+B+B+B+y _._._._.B+_._.B+/ x K.. K. B+/ / / / Y./ / / / / Y.Y.Y./ Y./ x . . K. Y.Y.|.|.Y.|.|.|.|.|.|.Y.|.|.v |., }+_ . . v v v v v |.|.2 2 v v v 2 v 2 2 D.. . 2 2 2 7.2 2 2 2 =.2 =.w+w+2 7 Q . K. =.=.* w+=.* =.* =.^.v. w+* * K.. d+* d+* * * * d+d+d+d+d+d+d+d+}.+.^ . . ",
+" - V.- - V.- - V.- V.- A.n p p p p p X u u n p p { { p p p p p p p p p X a [.. . (.(.5++ + 5++ (.+ (.+ + + + + (.1+1+1++ + + + D.Q y y !+y y m+. - - %.%.- %.%.- %.%.d %.~+_ . . %.d d d d 5.d d d d d d q Q . . 5+d d 5+5+5+5+(.H.. . (.+ (.(.(.+ + (.+ + 1 K.. . + + + + + + 1+1++ + + !++ r.. _ 2 2 2 =.2 =.=.w+y 1+y + y y y y 1+y y y y y y $+K.. K. B+B+y y B+y _.y _._.b B+B+_./ _._._._.9 . . R. / / / / / / / Y./ Y./ Y.Y./ Y.Y.9 . . Y.Y.|.Y.Y.Y.|.Y.|.|.|.Y.|.|.|.J.Q . K. v v v v v 7.v |.v v 2 7.v 2 }+Q . . 2 2 w+2 =.2 =.2 w+2 =.2 =.9 . . w+=.* 2 * w+w+* w+* w+* =.h.. . * }.* }.d+d+* * d+* d+* d+d+d+|+Q . K. ",
+" - - V.- - V.- - - - - z.n p X X <.I.P @.@.% r+p o.&. O.) X p p p p p f+..> > l+i+. K. + + 5++ + + + + + + + + + + + + + + 1+1+1+1+1+m+ 1+1+1+1+$+. . - %.- - %.%.].%.%.%.%.w . . K. d %.d d d d d d d d q w . . K. 5+5+5+5+5+5+5+c+. . + (.5++ + + (.+ (.# . . K. + + + + 1+1++ 1+1+1+y 1 D.. K.2 =.2 =.w+=.w+w+w+V y y y y y 1+y y y 1+y y B+~ K.. Q y B+B+B+_._._.B+B+B+_._.B+_._._.W _ . . B+/ / / / / / / / / / / / Y.y D.. . Y.Y.Y.|.|.Y.|.Y.|.|.|.|.b D.. . v v v v v v 7.v 2 |.2 2 h.. . K. 2 2 2 2 2 2 2 2 2 2 |+Q . . w+* =.* =.* * =.* w+* F Q . . * d+* d+d+d+d+d+d+d+d+d+2 B.. . ",
+" - V.- - - - V.- - - - - - ;.p l+O.V.q - %.%.~+x.X p a G.@.].].A.a p p p X > 4+u+G @.k.p.e. (.(.+ 5++ (.+ (.+ (.+ + + + + (.+ + + + + + 1 K. y y y y ~+. K. %.%.%.- %.%.- %.w K.. . d d %.d d d d d ].w.. . K. 5+d d 5+5+H.. . + + 5+5+(.+ 5.m+. . 1+1++ 1++ + W + + H.K.. ).v =.2 2 =.2 =.2 , B.. <+1+y 1+y 1+y y y y y y D.. . B+y B+y B+y _._.b B+_._.B+_.9 . . K. / / / / / / / Y./ / Y./ 0+K.. K. Y.Y.Y.Y.Y.Y.|.Y.|._.++. . K. v 2 2 v 2 v 2 2 v | _ . . 2 2 2 2 =.2 2 , o+. . R. w+w+w+w+=.* w+* 7.9 . . R. d+d+* d+d+* d+* d+2 C . . K. ",
+" - - V.- V.- V.- V.- - - t.r+f+c.V.- - %.- - ].% X p p X &.t.q t.u X n 6.g P 5.d w K.. K. 5++ + + + + + + + + + + 1+(.+ 1++ + + !++ + + V K. y 1+1+1+1+B.. H.# # w _ . . . d d d d d c+_ . . K. 5+5+5+5+w . . 5+(.+ + 5+w . . R. + 1++ 1++ 1 r.K.. . =.2 2 w+=.2 w+w+^.Q . K. y 1+y y y y y y c+K.. . B+_.B+_.B+_.B+B+B+B+B+9 K.. . / / Y./ / / Y./ / b r.. . R. }+_.Y.|.|.|.x D.. . Q |.v v v v |.7 ).. . R. 2 2 2 2 %+++. . K. =.=.* * =.F o+. . K. * * * d+d+d+'+^ . . K. ",
+" V.- V.- V.- - - V.- - - @.r+9+$.].%.%.%.%.- q ( p p p p p 3+V.~+A.#.].5.d %.h Q . . + (.+ + (.+ + + + + (.+ 1++ + 1+y + 1+y 1+1+1+D. y y y y y K.. c+Q . . . 5+h Q . . c+m+. . K. c+D.K.. . K. 2 * w+w+2 w+=.2 , R.. K. 1 )+<+~ q w.. . . ^+W B+_.B+W ~ D.. . . %+/ Y./ Y.B+9 K.. K. ).. . . . C ^ ^ . . . 9 R.. . R. 9 B.. . . R. v.` ^ . . . R. ",
+" - V.- V.- V.- - - - - V.% a X ) t.V.- - - ].z.X p p X n <.A.d %.%.5.d %.].w . . R. + + + + + + + + + 1++ + + + + + + 1++ + + + 1+m+ + y 1+y (.. . K. 2 2 2 2 2 w+=.w+F R.. K. K.. . . K. ^+D.D.. . K. ",
+" V.- - - - - V.- - V.- h ) X p 9+a ( z.q %.- ~+D ( 6.I.G %.].%.d d d %.# . . K. + + 1++ + + + + + 1+1+1++ + 1++ !+y 1+1+1+1+$+K. y y y y <+. R. 2 w+=.=.=.2 w+=.0+. . R. ",
+" V.- V.- V.- V.- - - - z.a p p p p X D q - %.%.~+G q %.- d %.%.%.%.h Q . . y y 1+1+1++ + 1++ + 1+1+1++ 1++ + + W 1+1+1+:.R. y y y 1+y D.. 2 2 =.w+=.* * w+v.. . ",
+" - - - - - V.- - - - - c+X p p p f+n z.].- - %.- - %.%.%.%.%.%.h Q . . R. R.R. R.). ).2.B+B+1+1++ + + 1+1+1+1+y 1+y !+1+y 1+1+y !+y 9 m+ B+B+/ B+y B.K. R.). ).).e 2 =.=.2 v.R.+.* ++K.K. ).).e ).e ).2.=+=+=+=+). ",
+" - V.V.V.- - - - - - - ~+r+X ;.Z E.j ].].%.%.%.%.d %.%.- d - w.. . R. e T. e T.N. R.R.).).).R.). R.R.).).).).).). e i.^ W./ B+1+1+1+~ ^ + y y y r.~ y y 1+y (.9 ++9 $+o+ R.m+2.C C C 9 x K.R.R. R. R.R.).).~.).R. R.R.).).). =+=+g. 2.i.= 0. R.R.).).~.).R. R.R.). R.R.). R.R. R.R. R.R.).).~.).R. 2 2 2 2 * F e f.p+R.R.R. R. R.R.).).).).).). R.R.).).~.).R. R.R.).R.). R.R.~.).R.R. R.). R.R.). R.R.).).~.).R. ).; N.N.b.; i. R.R. R. 2.b.R R b.b.b.0. R. R. R.). R.R.). R.R.). R.R.).).~.).R. R.R. R. ",
+" V.- - - V.- V.V.- V.- - z.E.O.- - - %.- - - %.].- %.%.V.w.. . K. p+i. =+E N. 2.} } } } g+g+0. E g+i i } } E N. e E } g.0.B+B+1+1+:.2.g./ y b ++F * y y J.e 7 g+^.p+v.). } 8 =+'.W.8 W.; R.).N. i.N. e } } W.g+} g+N. 2.} } } g+=+ 2.g.p+T. 2.i.'.q.0. 2.} } W.g+} g+N. ).).E g+= i. R.).E g+= i. ).i B R.e q.g+g.2. e E g+} g+} = N. 2 2 2 2 2 2 w+F 2.N.=+e ).=+ i.N. q.g+i i } } E 0. 2.E g+} g+} = N. e E } } g+; U ).q.0.N.0.0.T.N. e i.=+0. R.e '.g+= e e E g+} g+} = N. ).= N. i.; =+e E ).N. i.0. R.T. e ).g+ e i.=+0. R.e '.g+= e ). } g+i p+ e E g+} g+} = N. 2.2.E ).N. ",
+" V.- V.V.- - - - - - - - - - - - - %.- %.%.%.- %.d H.w.. . K. p+= i.= N. e 0. p+B N. =+0.s.; T. y y 1+J.|+i.= Y./ 9 g+=.y W e 7.s d+=.=.i.+.e * ^ R a.* 7.i 2.2.N. i.0. e N. ).N. i.W. 2.B } = i.b.'.= 0. e N. ).T.0. T.N. e T.0. T.N. e s.=+T. ). f.0. W.N. ).0. N.2 w+2 =.2 2 =.=.p+=+N. e '.i. i.0. p+B N. ).0. ).0. g.; ).} ).s.; g+ ).i.N.0. T.N. ).0. e N. i.0. e b.=+ e N. p+E i i p+ p+g. e g.b. ).s.; g+ ).i.N.0. T.N. p+N. s.0. ).0. ).b.2. e N. ",
+" V.- - V.- - - - - - V.- - - - - %.%.%.- %.%.H.m+. . R. p+= N. e g.i.2.2. =+B 0. 2.= 0. g.= y y x |+2 p+8 Y.h.8 w+_.~ h.f.|.Y./ / C '.}+e Y.i.b.}.Y.++R. i.i.p+i.i.i.p+0. e g.i.=+=+ e g.2.=+i.i.N. =+B f.; T.i.i 0.; = 0. 2.g.i.=+=+ ).=+2.=+ e =+2.2. e = N.p+E ).0. ).; =+2.2. =.=.=.2 2 2 2 , B.e =+N. e 0.g.B i.0. =+B 0. e ; =+=+e ).; 2.=+=+=+W.0. e p+p+e e e N. p+ e N. e ; =+=+2. =+f. i.s. 2.0. p+ i.f. p+g+'.= g.N. = i } 2. B } e N. p+ e N. 2.i.e =+ e ; =+=+e ).0. p+ i.f. ",
+" V.V.- V.- - V.- - - - - - - - - - - V.w K.. . R. i.R 0. 2.W.W.W.E N. e g.0. 2.i ; g.; ; T. 1+:.|+=./ i }+v.W.* / h.g.a./ / _./ C = }.J.~ Y.i.R m.Y.++R. i.N.0.0.N.b.= 0. =+W.W.} E N. e W.W.= U 0.N. _.B+_. e B 0.; B ; R 0.p+= 0. =+W.W.} E N. R W.q.p+; R W.E p+; e W.q. i.T. e N. e e 2. e B } W.8 R h+* w+2 2 w+2 h.K.R.2.i.N. e 0. g.g. i 0. e g.0. e B } } } b. ).} } } p+s.N. ).} 0.0.b.N. ).g.W. i.} 2.s. e B } } } b. 2.f. 2.p+N. e 0. '.p+ i.0. i.0.0.0.0.0. B i. =+0.p+W. ).g.W. i.} 2.s. s.W.W.g.=+ e B } } } b. e 0. '.p+ i.0. ",
+" - - V.- - - - - - - - - - - V.# m+. . K. i.R =+N. e g.N. e U N.N.0.0.} '. ^+|+=._.}+i.; W.* / y e m./ _./ b e m.}./ 7 / =+b.d+Y.B.R. i.N. p+0. =+N. e N. p+W. / / _./ _./ _.Y.^ g.0. p+} N. i.B N. =+N. W.g.0. W.g.0. e ; b.= = ; q. e W. 0.B } e } 0. a.h+d+=.w+2 2 , B.. . =+f. ).0. i.; p+0. e g.N. e } 0. ).0. g.B e } ).W.} = B p+ =+B ). e } 0. i.p+ =+} N. e N. g.g.i N. i.0. B i.=+ 0.=+} e W.} = B p+ =+B ). i.N. 2.} 0. ).N. g.B p+N. ",
+" H.- - - - - - - - # w.m+. . K. 2.b. 2.= i.=+2.e ). ).; 0. ).0. i.T. (+2 B+_.|+^ b.* _./ | i v.(+)+++ .f.|._.b / e b.* / R.R. 2.N. i 0. =+= i.=+2.e ). ).0. p+a.|./ / _.B+_./ / Y.C G+s i s.0. =+g.0. =+= i.=+2.e ). ).2.e =+2. 0. ).2.2. =+2. 0. ).0. =+T. i i.e =+=+b. e i g.U g.h.9 * =.2 J.. . K. 2.N. e N. i B 0. ).; 0. ).i i =+2.).e ).0. i.b. R.g+ R. 0. p+g+ ; i.e e ).).} e i i 2.2.).e = =+=+e e 2.= N. R.0. g.p+N. i.= i.i.e e ). U g.f. e } ). 0. p+g+ ; i.e e ).).} ).=+2. =+=+N. e i i =+2.).e ).0. g.p+N. ",
+" w.m+_ m+_ . . . . b. b.} W.} } g+N. } N. N. R U +.B+B+b 5 W.* B+_./ w+8 '+|+h+s.=./ B+B+b 0+R * / K.K. T. B T. b.W.} } } g+N. T. G+b.Y./ / / B+_./ / }+| 8 s 2 , N. } T. b.W.} } } g+N. N.W.} q.T.N. N.W.} q.T.N. N. R b.} g+ 0.N. h.} W.+.W.W.E s }+B.. . = T. T. W.T. } N. } W.} } } = f. b. } b. s. } T.W.} R f.N. } W.} W.} = f. s.b.} g+N.N. b. } R = b.} W.} } g+T. 0. b. s. } T.W.} R f.N. R } E W.N.0. } W.} } } = f. b. W.R ",
+" 1+y y / * w+y y y b _.=.=.2 _._.y y y y Y.* v ~ K.K. |.* 2 / _.B+/ _.B+_./ v * * |.|.|.}+ 2 * h+a.a.a.h+m.} Q K.R. ",
+" 1+y y !+_.y y y 1+y !+b B+y b y y y y y _.B+~ . / / / / _._./ _./ _./ Y.Y.Y.Y.Y./ Y.Y.)+ 2 v 2 2 =.w+=.w+v.).K.K. ",
+" + 1+!+1+1+1+1+y !+y y + y 1+1+1+y y y y y ~ . _.B+B+_.B+_._.B+/ _._._./ / / / / / / / / ++ v v 2 2 2 2 2 =.b 2.Q . ",
+" 1++ 1++ 1+1+1+1+1+y + y y 1+1+1+y y y !+9 . _./ _./ / B+/ B+/ / _./ _._./ / / / _./ / / Q 2 v 2 2 v v 2 v Y.).. . R. ",
+" + 1++ 1+1++ + !+1+1+1+y 1+y 1+1+1+y w.. _._.B+B+B+/ _._./ _./ B+/ / / / _./ Y./ / / ^+. |.|.v v |.v v v }+++. . R. ",
+" 1++ 1+1+y + 1+!+1+1+1+1+y y !+1+!+w.. y _._._._._.B+B+B+_./ _./ B+/ / / _./ Y./ / / D. v v v v v v 2 2 Y.++. . K. ",
+" + + 1+1+1+1+1++ !+1+1+1+1+!+y y $+. _.B+_.B+_._._./ / B+/ / / B+/ / / / _./ / / _._ |.v v v v v v v | 2.. . Q ",
+" + + 1+1+1+y + 1+!+1+!+y 1+1+1+!+r.K. _._._._./ / B+B+B+B+_./ B+/ B+/ B+/ / _./ / / / D. |.|.v v v v v v v %+_ . . R. ",
+" + + 1++ + y 1+1+1+1+1+1+y y !+y m+ _.B+B+B+B+B+/ / / B+B+/ B+/ / / / / Y./ / / / / 9 |.Y.|.v |.Y.|.v v _.C R.. . R. ",
+" + 1+1++ !+1+1+!+1+y + 1+1+1+1+:.. _.B+_./ B+B+B+/ B+/ B+/ B+B+/ / _./ / / / / / / !+x Y.Y.|.Y.v |.Y.|.v v |.| o+. . K. ",
+" 1+!++ W !+1+1++ y 1+y !+y !+Q R. _.B+_.B+/ _.B+/ / / _./ / / _./ / / / / / / / / / b b Y.Y.Y.|.Y.|.|.|.|.|.|.v v / ^ Q . . R. ",
+" 1+1+1+1+!+y + y 1+!+!+y y (.. %+B+B+_./ B+/ / / B+/ / / / / _./ / / / / / / / / / / / / / / / Y./ Y.Y.Y.Y.Y.Y.|.Y.|.|.Y.Y.|.|.|._.)+).. . K. ",
+" 1++ 1+1+1+y y 1+y y 1+!+y D.K. x B+B+/ B+B+/ B+/ B+/ / _.Y./ / Y./ Y.Y./ / Y./ Y./ Y.Y.Y.Y./ |.Y.Y.Y.Y.Y.|./ |.Y.|.|.|.J.++K.. . K. ",
+" 1+!+1+1+1+1+1+!+y y y y :.. ^+V W / / / / B+/ / _./ _./ Y./ / Y./ / / / Y.Y./ Y.Y.Y./ Y.Y.Y.Y.|.Y.|./ |.0+)+D.. . . ",
+" 1+!+!++ y 1+y 1+1+y 1+y Q R. ` 9 :./ / / / / / / / / / / / Y.Y.Y.Y.Y.Y./ Y.Y.Y.Y.Y.Y.|.0+J.D.B.. . . R. ",
+" 1+1+y + 1+!+y !+!+y 1+y :.. _ D.D.^+~ J.^+/ Y./ / Y./ / / Y.0+x J.)+D.D.Q . . . R. ",
+" !+1++ y y 1+1+!+!+y y !+!+K.R. . . . . . . . . . Q ",
+" 1+y + 1+y !+y 1+1+y 1+y y r.. ",
+" y + y 1+1+1+1+y y y y 1+y $+. ",
+" y + 1+!+!+y 1+1+1+y 1+y 1+y m+K. ",
+" + y !+!+1+1+y !+y 1+y 1+y y r.. ",
+" 1+1+1+y 1+1+1+!+y y y y y y $+. ",
+" !+!+1+1+1+1+y y 1+1+y y 1+y y m+K. ",
+" 1+!+!+y !+!+1+y y !+y 1+y 1+y D.. ",
+" !+1+1++ y 1+y 1+y 1+1+y y y y ~ . ",
+" !+y + y 1+y 1+y y !+y 1+y y 1+. ",
+" 1++ y 1+1++ y 1+y y y y y y y m+. ",
+" y + 1+!+y 1+y 1+1+1+y 1+y 1+y w.. ",
+" + y 1+y 1+y !+!+y y 1+y y y y <+. ",
+" 1+1+!+1+1+y 1+y !+y y 1+y y y :.. ",
+" !+1+!+1+1+y 1+1+y 1+y 1+y !+y . R. ",
+" !+y 1+y 1+y y y y 1+y y y y !+. . ",
+" 1+1+y + y 1+y + y y y y 1+y y m+. ",
+" 1+1+y + y 1+y y 1+1+y y y y y w.. ",
+" 1+1+y + y 1+1+y y 1+y y !+y w.. ",
+" y !+1+!+y y 1+y y 1+y y y y w.. ",
+" 1+1+y y 1+1+y y 1+y 1+y !+y w.. ",
+" 1+1+y y y + y y y y y y y w.. ",
+" !+1+1+1+!+y y 1+y y y !+y w.. ",
+" y y !+y y 1+y y !+y y y B.. ",
+" 1+1+1+1+!+y 1+y y y y 1+K.. ",
+" y y y y y !+y 1+y y y . . ",
+" 1+1+1+1+y y y y y y ~ . . ",
+" y 1+y 1+y 1+y 1+y Q . ",
+" y 1+1+y y y y ^+. . ",
+" y y 1+y y :.K.. R. ",
+" ~ w.m+. . Q ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" "};
(save-excursion
(if (buffer-live-p wl-current-summary-buffer)
(set-buffer wl-current-summary-buffer))
- wl-message-buf-name)))
+ wl-message-buffer)))
(cur-win (selected-window))
(b (current-buffer)))
(and mes-win (select-window mes-win))
(save-excursion
(if (buffer-live-p wl-current-summary-buffer)
(set-buffer wl-current-summary-buffer))
- wl-message-buf-name))
+ wl-message-buffer))
(intern (format
"%s-%d"
wl-current-summary-buffer
"Display the contents of the BBDB for the sender of this message.
This buffer will be in `bbdb-mode', with associated keybindings."
(interactive)
- (wl-summary-redisplay)
+ (wl-summary-set-message-buffer-or-redisplay)
(set-buffer (wl-message-get-original-buffer))
(let ((record (bbdb-wl-update-record t))
bbdb-win)
(save-excursion
(if (buffer-live-p wl-current-summary-buffer)
(set-buffer wl-current-summary-buffer))
- wl-message-buf-name)))
+ wl-message-buffer)))
(cur-win (selected-window))
(b (current-buffer)))
(and mes-win
;;; @ bbdb-extract-field-value -- stolen from tm-bbdb.
;;;
-(and (not (fboundp 'bbdb-wl-extract-field-value-internal))
-;;; (not (fboundp 'PLEASE_REPLACE_WITH_SEMI-BASED_MIME-BBDB)) ;; mime-bbdb
+(if (and (string< bbdb-version "1.58")
+ ;; (not (fboundp 'bbdb-extract-field-value) ; defined as autoload
+ (not (fboundp 'bbdb-header-start)))
(progn
- (if (and (string< bbdb-version "1.58")
- ;; (not (fboundp 'bbdb-extract-field-value) ; defined as autoload
- (not (fboundp 'bbdb-header-start)))
- (load "bbdb-hooks")
- (require 'bbdb-hooks))
- (fset 'bbdb-wl-extract-field-value-internal
- (cond
- ((fboundp 'tm:bbdb-extract-field-value)
- (symbol-function 'tm:bbdb-extract-field-value))
- (t (symbol-function 'bbdb-extract-field-value))))
- (defun bbdb-extract-field-value (field)
- (let ((value (bbdb-wl-extract-field-value-internal field)))
- (with-temp-buffer ; to keep raw buffer unibyte.
- (elmo-set-buffer-multibyte
- default-enable-multibyte-characters)
- (and value
- (eword-decode-string value)))))
- ))
+ (load "bbdb-hooks")
+ (require 'bbdb-hooks)))
+
+(static-cond ((fboundp 'tm:bbdb-extract-field-value)
+ (defun bbdb-wl-extract-field-value-internal (field)
+ (funcall (symbol-function 'tm:bbdb-extract-field-value)
+ field)))
+ (t
+ (defun bbdb-wl-extract-field-value-internal (field)
+ (funcall (symbol-function 'bbdb-extract-field-value)
+ field))))
+
+(defun bbdb-extract-field-value (field)
+ (let ((value (bbdb-wl-extract-field-value-internal field)))
+ (with-temp-buffer ; to keep raw buffer unibyte.
+ (elmo-set-buffer-multibyte
+ default-enable-multibyte-characters)
+ (and value
+ (eword-decode-string value)))))
(provide 'bbdb-wl)
2001-02-06 Yuuichi Teranishi <teranisi@gohome.org>
+ * wl-summary.el (wl-summary-save-view): Renamed from
+ `wl-summary-save-status'.
+
+2001-01-23 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-expire.el (wl-expire-refile): Don't call
+ elmo-msgdb-add-msgs-to-seen-list;
+ Pass wl-expire-add-seen-list to elmo-folder-move-messages.
+ (wl-expire-refile-with-copy-reserve-msg): Ditto.
+
+2001-01-19 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-message.el (wl-message-prev-page): Ignore errors while
+ scroll-down.
+
+2001-01-14 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-mime.el: Use elmo-original-message-mode instead of
+ mmelmo-original-mode.
+
+ * wl-fldmgr.el: Use `wl-folder-get-elmo-folder' instead of
+ `elmo-folder-get-spec';
+ (wl-fldmgr-add-completion-all-completions):
+ Use `elmo-folder-list-subfolders' instead of `elmo-list-folders'.
+
+ * wl-e21.el (wl-plugged-set-folder-icon): Use `elmo-folder-type' instead
+ of `elmo-folder-get-type'.
+
+ * wl-draft.el: Use `wl-folder-get-elmo-folder' instead of
+ `elmo-folder-get-spec';
+ Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path';
+ Use `elmo-folder-append-message' instead of `elmo-append-msg';
+ Use `elmo-folder-list-messages' instead of `elmo-list-folder';
+ Use `elmo-message-fetch' instead of `elmo-read-msg-with-cache' or
+ `elmo-read-msg-no-cache';
+ Use `elmo-message-file-name' instead of `elmo-get-msg-filename';
+ Use `elmo-folder-delete-messages' instead of `elmo-delete-msgs'.
+ (wl-default-draft-cite): Use `elmo-msgdb-overview-get-entity'.
+ (wl-draft-dispatch-message): Use `elmo-file-cache-save' instead of
+ `elmo-cache-save';
+ (wl-draft-reedit): Use `elmo-message-file-name'.
+
+ * wl-expire.el: Use `elmo-folder-name-internal';
+ Use `elmo-folder-list-messages' instead of `elmo-list-folder';
+ Use macro `wl-summary-buffer-msgdb' instead of variable
+ `wl-summary-buffer-msgdb';
+ Use `wl-folder-get-elmo-folder' instead of `elmo-folder-get-spec';
+ Use macro `wl-summary-buffer-folder-name' instead of variable
+ `wl-summary-buffer-folder-name'.
+ * wl-score.el: Likewise.
+
+ * wl-message.el: Rewrite for new message buffer cache mechanism.
+ (wl-message-buffer-cache-buffer-get): New macro.
+ (wl-message-buffer-cache-folder-get): Ditto.
+ (wl-message-buffer-cache-message-get): Ditto.
+ (wl-message-buffer-cache-entry-make): Ditto.
+ (wl-message-buffer-cache-hit): Ditto.
+ (wl-message-buffer-cache-sort): New function.
+ (wl-message-buffer-cache-add): Ditto.
+ (wl-message-buffer-cache-delete): Ditto.
+ (wl-message-buffer-cache-clean-up): Ditto.
+ (wl-message-buffer-window): Rewrite.
+ (wl-message-select-buffer): Renamed from `wl-select-buffer'.
+ (wl-message-buffer-display): New function.
+ (wl-message-display-internal): New function.
+
+2001-01-12 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-folder.el: Use `elmo-folder-name-internal';
+ Use `wl-folder-get-elmo-folder';
+ Use `elmo-folder-list-messages' instead of
+ `elmo-list-folder';
+ Use `elmo-folder-get-primitive-list' instead of
+ `elmo-folder-get-primitive-spec-list';
+ Use `elmo-folder-list-subfolders' instead of `elmo-list-folders';
+ Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path';
+ Use `elmo-folder-create' instead of `elmo-create-folder'.
+ (wl-folder-create-newsgroups-from-nntp-access2): Abolish.
+ (wl-folder-get-elmo-folder): New macro.
+ (wl-folder-elmo-folder-cache-get): Ditto.
+ (wl-folder-elmo-folder-cache-put): Ditto.
+ (wl-folder-suspend): Call `elmo-quit'.
+
+ * wl.el: Use `elmo-folder-msgdb-path' instead of `elmo-msgdb-expand-path';
+ Use `elmo-folder-list-messages' instead of `elmo-list-folder';
+ Use `elmo-net-port-info' instead of `elmo-folder-portinfo';
+ Use `wl-folder-get-elmo-folder' instead of `elmo-folder-get-spec'.
+ (toplevel): require 'cl.
+ (wl-exit): Call `wl-message-buffer-cache-clean-up' and `elmo-quit'.
+
+ * wl-summary.el: Rewrite to use new elmo interface.
+
+\f
+2001-02-06 Yuuichi Teranishi <teranisi@gohome.org>
+
* wl-mime.el (wl-draft-preview-message):
Run `wl-draft-send-hook' before collecting recipients information;
Bind `wl-draft-config-exec-flag' while running `wl-draft-send-hook'.
(defun wl-draft-insert-current-message (dummy)
(interactive)
- (let ((mail-reply-buffer (wl-message-get-original-buffer))
+ (let (mail-reply-buffer
mail-citation-hook mail-yank-hooks
wl-draft-add-references wl-draft-cite-func)
+ (with-current-buffer wl-draft-buffer-cur-summary-buffer
+ (with-current-buffer wl-message-buffer
+ (setq mail-reply-buffer (wl-message-get-original-buffer))))
(if (eq 0
(save-excursion
(set-buffer mail-reply-buffer)
(buffer-size)))
(error "No current message")
- (wl-draft-yank-from-mail-reply-buffer nil
- wl-ignored-forwarded-headers))))
+ (wl-draft-yank-from-mail-reply-buffer
+ nil
+ wl-ignored-forwarded-headers))))
(defun wl-draft-insert-get-message (dummy)
(let ((fld (completing-read
wl-draft-cite-func)
(unwind-protect
(progn
- (save-excursion
- (elmo-read-msg-with-cache fld number mail-reply-buffer nil))
+ (elmo-message-fetch (wl-folder-get-elmo-folder fld)
+ number
+ ;; No cache.
+ (elmo-make-fetch-strategy 'entire)
+ nil mail-reply-buffer)
(wl-draft-yank-from-mail-reply-buffer nil))
(kill-buffer mail-reply-buffer))))
(save-excursion
(set-buffer message-buf)
wl-message-buffer-cur-number))
- (setq entity (assoc (cdr (assq num
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
- (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
+ (setq entity (elmo-msgdb-overview-get-entity
+ num (wl-summary-buffer-msgdb)))
(setq from (elmo-msgdb-overview-entity-get-from entity))
(setq date (elmo-msgdb-overview-entity-get-date entity)))
(setq cite-title (format "At %s,\n%s wrote:"
(if wl-draft-use-cache
(let ((id (std11-field-body "Message-ID"))
(elmo-enable-disconnected-operation t))
- (elmo-cache-save id nil nil nil))))
+ (elmo-file-cache-save id nil))))
;; If one unplugged, append queue.
(when (and unplugged-via
wl-sent-message-modified)
(point)))
fcc-list))
(save-match-data
- (wl-folder-confirm-existence (eword-decode-string (car fcc-list))))
+ (wl-folder-confirm-existence
+ (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list)))))
(delete-region (match-beginning 0)
(progn (forward-line 1) (point)))))
fcc-list))
cache-saved)
(while fcc-list
(unless (or cache-saved
- (elmo-folder-plugged-p (car fcc-list)))
- (elmo-cache-save id nil nil nil) ;; for disconnected operation
+ (elmo-folder-plugged-p
+ (wl-folder-get-elmo-folder (car fcc-list))))
+ (elmo-file-cache-save id nil) ;; for disconnected operation
(setq cache-saved t))
- (if (elmo-append-msg (eword-decode-string (car fcc-list))
- (buffer-substring
- (point-min) (point-max))
- id)
+ (if (elmo-folder-append-buffer
+ (wl-folder-get-elmo-folder
+ (eword-decode-string (car fcc-list)))
+ id)
(wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id)
(wl-draft-write-sendlog 'failed 'fcc nil (car fcc-list) id))
(setq fcc-list (cdr fcc-list)))))
(wl-load-profile))
(wl-init 'wl-draft) ;; returns immediately if already initialized.
(if (interactive-p)
- (setq summary-buf (wl-summary-get-buffer wl-summary-buffer-folder-name)))
- (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder))
+ (setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name))))
+ (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
buf-name file-name num wl-demo change-major-mode-hook)
- (if (not (eq (car draft-folder-spec) 'localdir))
+ (if (not (elmo-folder-message-file-p draft-folder))
(error "%s folder cannot be used for draft folder" wl-draft-folder))
- (setq num (elmo-max-of-list (or (elmo-list-folder wl-draft-folder) '(0))))
+ (setq num (elmo-max-of-list
+ (or (elmo-folder-list-messages draft-folder) '(0))))
(setq num (+ 1 num))
;; To get unused buffer name.
(while (get-buffer (concat wl-draft-folder "/" (int-to-string num)))
(setq num (+ 1 num)))
(setq buf-name (find-file-noselect
(setq file-name
- (elmo-get-msg-filename wl-draft-folder
- num))))
+ (elmo-message-file-name
+ (wl-folder-get-elmo-folder wl-draft-folder)
+ num))))
(if wl-draft-use-frame
(switch-to-buffer-other-frame buf-name)
(switch-to-buffer buf-name))
(current-buffer))))
(defun wl-draft-reedit (number)
- (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder))
+ (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
(wl-draft-reedit t)
buf-name file-name change-major-mode-hook)
- (setq file-name (expand-file-name
- (int-to-string number)
- (expand-file-name
- (nth 1 draft-folder-spec)
- elmo-localdir-folder-path)))
+ (setq file-name (elmo-message-file-name draft-folder number))
(unless (file-exists-p file-name)
(error "File %s does not exist" file-name))
(setq buf-name (find-file-noselect file-name))
(insert (concat field ": " content "\n"))))))))
(defun wl-draft-config-info-operation (msg operation)
- (let* ((msgdb-dir (elmo-msgdb-expand-path wl-draft-folder))
+ (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-folder-get-elmo-folder
+ wl-draft-folder)))
(filename
(expand-file-name
(format "%s-%d" wl-draft-config-save-filename msg)
(defun wl-draft-queue-info-operation (msg operation
&optional add-sent-message-via)
- (let* ((msgdb-dir (elmo-msgdb-expand-path wl-queue-folder))
+ (let* ((msgdb-dir (elmo-folder-msgdb-path
+ (wl-folder-get-elmo-folder wl-queue-folder)))
(filename
(expand-file-name
(format "%s-%d" wl-draft-queue-save-filename msg)
(if wl-draft-verbose-send
(message "Queuing..."))
(let ((send-buffer (current-buffer))
+ (folder (wl-folder-get-elmo-folder wl-queue-folder))
(message-id (std11-field-body "Message-ID")))
- (if (elmo-append-msg wl-queue-folder
- (buffer-substring (point-min) (point-max))
- message-id)
+ (if (elmo-folder-append-buffer folder t)
(progn
(if message-id
(elmo-dop-lock-message message-id))
(wl-draft-queue-info-operation
- (car (elmo-max-of-folder wl-queue-folder))
+ (car (elmo-folder-status folder))
'save wl-sent-message-via)
(wl-draft-write-sendlog 'ok 'queue nil wl-queue-folder message-id)
(when wl-draft-verbose-send
(defun wl-draft-queue-flush ()
"Flush draft queue."
(interactive)
- (let ((msgs2 (elmo-list-folder wl-queue-folder))
- (i 0)
- (performed 0)
- (wl-draft-queue-flushing t)
- msgs failure len buffer msgid sent-via)
+ (let* ((queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
+ (msgs2 (elmo-folder-list-messages queue-folder))
+ (i 0)
+ (performed 0)
+ (wl-draft-queue-flushing t)
+ msgs failure len buffer msgid sent-via)
;; get plugged send message
(while msgs2
(setq sent-via (wl-draft-queue-info-operation (car msgs2) 'get-sent-via))
failure nil)
(setq wl-sent-message-via nil)
(wl-draft-queue-info-operation (car msgs) 'load)
- (elmo-read-msg-no-cache wl-queue-folder (car msgs)
- (current-buffer))
+ (elmo-message-fetch queue-folder
+ (car msgs)
+ (elmo-make-fetch-strategy 'entire))
(condition-case err
(setq failure (funcall
wl-draft-queue-flush-send-func
(quit
(setq failure t)))
(unless failure
- (elmo-delete-msgs wl-queue-folder (cons (car msgs) nil))
+ (elmo-folder-delete-messages
+ queue-folder (cons (car msgs) nil))
(wl-draft-queue-info-operation (car msgs) 'delete)
(elmo-dop-unlock-message (std11-field-body "Message-ID"))
(setq performed (+ 1 performed)))
(let ((bufs (buffer-list))
(draft-regexp (concat
"^" (regexp-quote
- (expand-file-name
- (nth 1 (elmo-folder-get-spec wl-draft-folder))
- (expand-file-name
- elmo-localdir-folder-path)))))
+ (elmo-localdir-folder-directory-internal
+ (wl-folder-get-elmo-folder wl-draft-folder)))))
buf draft-bufs)
(while bufs
(if (and
(switch-to-buffer buf))))))
(defun wl-jump-to-draft-folder ()
- (let ((msgs (reverse (elmo-list-folder wl-draft-folder)))
+ (let ((msgs (reverse (elmo-folder-list-messages (wl-folder-get-elmo-folder
+ wl-draft-folder))))
(mybuf (buffer-name))
msg buf)
(if (not msgs)
;;; Code:
;;
+(require 'elmo)
(eval-when-compile
(require 'wl-folder)
(require 'wl-summary)
((string= fld-name wl-queue-folder);; queue folder
(get 'wl-folder-queue-image 'image))
(;; and one of many other folders
- (setq type (elmo-folder-get-type fld-name))
+ (setq type (elmo-folder-type fld-name))
(get (intern (format "wl-folder-%s-image" type))
'image)))))
(overlay-put overlay 'before-string image)))
(concat (propertize " " 'display
(get 'wl-folder-queue-image 'image))
string))
- ((setq type (elmo-folder-get-type folder))
+ ((setq type (elmo-folder-type folder))
(concat (propertize " " 'display
(get (intern (format "wl-folder-%s-image"
type))
(wl-folder-archive-image . wl-archive-folder-icon)
(wl-folder-pipe-image . wl-pipe-folder-icon)
(wl-folder-maildir-image . wl-maildir-folder-icon)
+ (wl-folder-nmz-image . wl-nmz-folder-icon)
(wl-folder-trash-empty-image . wl-empty-trash-folder-icon)
(wl-folder-draft-image . wl-draft-folder-icon)
(wl-folder-queue-image . wl-queue-folder-icon)
(defun wl-message-wheel-up (event)
(interactive "e")
- (if (string-match wl-message-buf-name (buffer-name))
+ (if (string-match (regexp-quote wl-message-buffer-cache-name)
+ (regexp-quote (buffer-name)))
(wl-message-next-page)
(let ((cur-buf (current-buffer))
proceed)
(defun wl-message-wheel-down (event)
(interactive "e")
- (if (string-match wl-message-buf-name (buffer-name))
+ (if (string-match (regexp-quote wl-message-buffer-cache-name)
+ (regexp-quote (buffer-name)))
(wl-message-prev-page)
(let ((cur-buf (current-buffer))
proceed)
(require 'wl-summary)
(require 'wl-thread)
(require 'wl-folder)
+(require 'elmo)
;;; Code:
(format "Expiring (delete) %s msgs..."
(length delete-list))))
(message "%s" mess)
- (if (elmo-delete-msgs folder
- delete-list
- msgdb)
+ (if (elmo-folder-delete-messages folder
+ delete-list)
(progn
(elmo-msgdb-delete-msgs folder
- delete-list
- msgdb
- t)
+ delete-list)
(wl-expire-append-log folder delete-list nil 'delete)
(message "%s" (concat mess "done")))
(error (concat mess "failed!")))))
refile-list (elmo-msgdb-get-mark-alist msgdb))))
(when refile-list
(let* ((doingmes (if copy
- "Copying %s"
- "Expiring (move %s)"))
- (mess (format (concat doingmes " %s msgs...")
- dst-folder (length refile-list))))
- (message "%s" mess)
- (unless (or (elmo-folder-exists-p dst-folder)
- (elmo-create-folder dst-folder))
- (error "%s: create folder failed" dst-folder))
- (if wl-expire-add-seen-list
- (elmo-msgdb-add-msgs-to-seen-list
- dst-folder
- refile-list
- msgdb
- (concat wl-summary-important-mark
- wl-summary-read-uncached-mark)))
- (if (elmo-move-msgs folder
- refile-list
- dst-folder
- msgdb
- nil nil t
- copy
- preserve-number)
- (progn
- (wl-expire-append-log folder refile-list dst-folder (if copy 'copy 'move))
- (message "%s" (concat mess "done")))
- (error (concat mess "failed!")))))
+ "Copying %s"
+ "Expiring (move %s)"))
+ (mess (format (concat doingmes " %s msgs...")
+ (elmo-folder-name-internal dst-folder)
+ (length refile-list))))
+ (message "%s" mess)
+ (unless (or (elmo-folder-exists-p dst-folder)
+ (elmo-folder-create dst-folder))
+ (error "%s: create folder failed" dst-folder))
+ (if (elmo-folder-move-messages folder
+ refile-list
+ dst-folder
+ msgdb
+ nil nil t
+ copy
+ preserve-number
+ nil
+ wl-expire-add-seen-list)
+ (progn
+ (wl-expire-append-log
+ folder refile-list dst-folder (if copy 'copy 'move))
+ (message "%s" (concat mess "done")))
+ (error (concat mess "failed!")))))
(cons refile-list (length refile-list))))
(defun wl-expire-refile-with-copy-reserve-msg
&optional no-reserve-marks preserve-number copy)
"Refile message for expire.
If REFILE-LIST includes reserve mark message, so copy."
- (when (not (string= folder dst-folder))
+ (when (not (string= (elmo-folder-name-internal folder) dst-folder))
(let ((msglist refile-list)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
+ (mark-alist (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder)))
+ (number-alist (elmo-msgdb-get-number-alist (elmo-folder-msgdb-internal folder)))
+ (dst-folder (wl-folder-get-elmo-folder dst-folder))
(ret-val t)
(copy-reserve-message)
(copy-len 0)
msg msg-id)
(message "Expiring (move %s) %s msgs..."
- dst-folder (length refile-list))
+ (elmo-folder-name-internal dst-folder) (length refile-list))
(unless (or (elmo-folder-exists-p dst-folder)
- (elmo-create-folder dst-folder))
- (error "%s: create folder failed" dst-folder))
+ (elmo-folder-create dst-folder))
+ (error "%s: create folder failed" (elmo-folder-name-internal
+ dst-folder)))
(while (setq msg (wl-pop msglist))
(unless (wl-expire-msg-p msg mark-alist)
(setq msg-id (cdr (assq msg number-alist)))
;; reserve mark message already refiled or expired
(setq refile-list (delq msg refile-list))
;; reserve mark message not refiled
- (wl-append wl-expired-alist (list (cons msg-id dst-folder)))
+ (wl-append wl-expired-alist (list (cons msg-id
+ (elmo-folder-name-internal
+ dst-folder))))
(setq copy-reserve-message t))))
(when refile-list
- (if wl-expire-add-seen-list
- (elmo-msgdb-add-msgs-to-seen-list
- dst-folder
- refile-list
- msgdb
- (concat wl-summary-important-mark
- wl-summary-read-uncached-mark)))
(unless
(setq ret-val
- (elmo-move-msgs folder
- refile-list
- dst-folder
- msgdb
- nil nil t
- copy-reserve-message
- preserve-number))
- (error "Expire: move msgs to %s failed" dst-folder))
- (wl-expire-append-log folder refile-list dst-folder
- (if copy-reserve-message 'copy 'move))
+ (elmo-folder-move-messages folder
+ refile-list
+ dst-folder
+ msgdb
+ nil nil t
+ copy-reserve-message
+ preserve-number
+ nil
+ wl-expire-add-seen-list
+ ))
+ (error "Expire: move msgs to %s failed"
+ (elmo-folder-name-internal dst-folder)))
+ (wl-expire-append-log (elmo-folder-name-internal folder)
+ refile-list
+ (elmo-folder-name-internal dst-folder)
+ (if copy-reserve-message 'copy 'move))
(setq copy-len (length refile-list))
(when copy-reserve-message
(setq refile-list
mark-alist))
(when refile-list
(if (setq ret-val
- (elmo-delete-msgs folder
- refile-list
- msgdb))
- (progn
- (elmo-msgdb-delete-msgs folder
- refile-list
- msgdb
- t)
- (wl-expire-append-log folder refile-list nil 'delete))))))
+ (elmo-folder-delete-messages folder
+ refile-list))
+ (progn
+ (elmo-msgdb-delete-msgs folder
+ refile-list)
+ (wl-expire-append-log folder refile-list nil 'delete))))))
(let ((mes (format "Expiring (move %s) %s msgs..."
- dst-folder (length refile-list))))
+ (elmo-folder-name-internal dst-folder)
+ (length refile-list))))
(if ret-val
(message (concat mes "done"))
(error (concat mes "failed!"))))
(defun wl-expire-archive-get-folder (src-folder &optional fmt)
"Get archive folder name from SRC-FOLDER."
- (let* ((spec (elmo-folder-get-spec src-folder))
- (fmt (or fmt wl-expire-archive-folder-name-fmt))
+ (let* ((fmt (or fmt wl-expire-archive-folder-name-fmt))
(archive-spec (char-to-string
- (car (rassq 'archive elmo-spec-alist))))
+ (car (rassq 'archive elmo-folder-type-alist))))
dst-folder-base dst-folder-fmt prefix)
- (cond ((eq (car spec) 'localdir)
- (setq dst-folder-base (concat archive-spec (nth 1 spec))))
- ((stringp (nth 1 spec))
+ (cond ((eq (elmo-folder-type-internal src-folder) 'localdir)
(setq dst-folder-base
- (elmo-concat-path (format "%s%s" archive-spec (car spec))
- (nth 1 spec))))
+ (concat archive-spec
+ (elmo-folder-name-internal src-folder))))
(t
(setq dst-folder-base
- (elmo-concat-path (format "%s%s" archive-spec (car spec))
- (elmo-replace-msgid-as-filename
- src-folder)))))
+ (elmo-concat-path
+ (format "%s%s" archive-spec (elmo-folder-type-internal
+ src-folder))
+ (substring (elmo-folder-name-internal src-folder)
+ (length (elmo-folder-prefix-internal src-folder)))))))
(setq dst-folder-fmt (format fmt
dst-folder-base
wl-expire-archive-folder-type))
(setq dst-folder-base (format "%s;%s"
dst-folder-base
wl-expire-archive-folder-type))
- (when (and wl-expire-archive-folder-prefix
- (stringp (nth 1 spec)))
+ (when wl-expire-archive-folder-prefix
(cond ((eq wl-expire-archive-folder-prefix 'short)
- (setq prefix (file-name-nondirectory (nth 1 spec))))
+ (setq prefix (file-name-nondirectory
+ (elmo-folder-name-internal src-folder))))
(t
- (setq prefix (nth 1 spec))))
+ (setq prefix (elmo-folder-name-internal src-folder))))
(setq dst-folder-fmt (concat dst-folder-fmt ";" prefix))
(setq dst-folder-base (concat dst-folder-base ";" prefix)))
(cons dst-folder-base dst-folder-fmt)))
(defsubst wl-expire-archive-get-max-number (dst-folder-base &optional regexp)
- (let ((files (reverse (sort (elmo-list-folders dst-folder-base)
+ (let ((files (reverse (sort (elmo-folder-list-subfolders
+ (elmo-make-folder dst-folder-base))
'string<)))
(regexp (or regexp wl-expire-archive-folder-num-regexp))
filenum in-folder)
(while files
(when (string-match regexp (car files))
(setq filenum (elmo-match-string 1 (car files)))
- (setq in-folder (elmo-max-of-folder (car files)))
+ (setq in-folder (elmo-folder-status
+ (wl-folder-get-elmo-folder (car files))))
(throw 'done (cons in-folder filenum)))
(setq files (cdr files))))))
(let ((len 0) (max-num 0)
folder-info dels)
(if (or (and file (setq folder-info
- (cons (elmo-max-of-folder file) nil)))
- (setq folder-info (wl-expire-archive-get-max-number dst-folder-base
- regexp)))
+ (cons (elmo-folder-status
+ (wl-folder-get-elmo-folder file))
+ nil)))
+ (setq folder-info (wl-expire-archive-get-max-number
+ dst-folder-base
+ regexp)))
(progn
(setq len (cdar folder-info))
(when preserve-number
hide-list (elmo-msgdb-get-mark-alist msgdb))))
(let ((mess (format "Hiding %s msgs..." (length hide-list))))
(message mess)
- (elmo-msgdb-delete-msgs folder hide-list msgdb t)
+ (elmo-msgdb-delete-msgs folder hide-list)
(elmo-msgdb-append-to-killed-list folder hide-list)
- (elmo-msgdb-save folder msgdb)
+ (elmo-folder-commit folder)
(message (concat mess "done"))
(cons hide-list (length hide-list))))
-(defsubst wl-expire-folder-p (folder)
- "Return non-nil, when FOLDER matched `wl-expire-alist'."
- (wl-get-assoc-list-value wl-expire-alist folder))
+(defsubst wl-expire-folder-p (entity)
+ "Return non-nil, when ENTITY matched `wl-expire-alist'."
+ (wl-get-assoc-list-value wl-expire-alist entity))
-(defun wl-summary-expire (&optional folder-name notsummary nolist)
+(defun wl-summary-expire (&optional folder notsummary nolist)
""
(interactive)
- (let ((folder (or folder-name wl-summary-buffer-folder-name))
- (alist wl-expire-alist)
+ (let ((folder (or folder wl-summary-buffer-elmo-folder))
(deleting-info "Expiring...")
expires)
- (when (and (or (setq expires (wl-expire-folder-p folder))
+ (when (and (or (setq expires (wl-expire-folder-p
+ (elmo-folder-name-internal folder)))
(progn (and (interactive-p)
(message "no match %s in wl-expire-alist"
folder))
nil))
(or (not (interactive-p))
- (y-or-n-p (format "Expire %s? " folder))))
- (let* ((msgdb (or wl-summary-buffer-msgdb
- (elmo-msgdb-load folder)))
+ (y-or-n-p (format "Expire %s? " (elmo-folder-name-internal
+ folder)))))
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
expval rm-type val-type value more args
((eq val-type nil))
((eq val-type 'number)
(let* ((msgs (if (not nolist)
- (elmo-list-folder folder)
+ (elmo-folder-list-messages folder)
(mapcar 'car number-alist)))
(msglen (length msgs))
(more (or more (1+ value)))
(wl-expired-alist-save))
(run-hooks 'wl-summary-expire-hook)
(if delete-list
- (message "Expiring %s is done" folder)
+ (message "Expiring %s is done" (elmo-folder-name-internal
+ folder))
(and (interactive-p)
(message "No expire"))))
+
+
+
delete-list
))))
(setq flist (cdr flist)))))
((stringp entity)
(when (wl-expire-folder-p entity)
- (let ((update-msgdb (cond
+ (let* ((folder (wl-folder-get-elmo-folder entity))
+ (update-msgdb (cond
((consp wl-expire-folder-update-msgdb)
(wl-string-match-member
entity
wl-expire-folder-update-msgdb))
(t
wl-expire-folder-update-msgdb)))
- (wl-summary-highlight (if (or (wl-summary-sticky-p entity)
+ (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
(wl-summary-always-sticky-folder-p
- entity))
+ folder))
wl-summary-highlight))
wl-auto-select-first ret-val)
(save-window-excursion
(save-excursion
(and update-msgdb
(wl-summary-goto-folder-subr entity 'force-update nil))
- (setq ret-val (wl-summary-expire entity (not update-msgdb)))
+ (setq ret-val (wl-summary-expire folder (not update-msgdb)))
(if update-msgdb
- (wl-summary-save-status 'keep)
+ (progn
+ (wl-summary-save-view 'keep)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder))
(if ret-val
(wl-folder-check-entity entity))))))))))
copied-list
))
-(defun wl-summary-archive (&optional arg folder-name notsummary nolist)
+(defun wl-summary-archive (&optional arg folder notsummary nolist)
(interactive "P")
- (let* ((folder (or folder-name wl-summary-buffer-folder-name))
- (msgdb (or wl-summary-buffer-msgdb
+ (let* ((folder (or folder wl-summary-buffer-elmo-folder))
+ (msgdb (or (wl-summary-buffer-msgdb)
(elmo-msgdb-load folder)))
(msgs (if (not nolist)
- (elmo-list-folder folder)
+ (elmo-folder-list-messages folder)
(mapcar 'car (elmo-msgdb-get-number-alist msgdb))))
(alist wl-archive-alist)
func dst-folder archive-list)
(if arg
(let ((wl-default-spec (char-to-string
- (car (rassq 'archive elmo-spec-alist)))))
+ (car (rassq 'archive elmo-folder-type-alist)))))
(setq dst-folder (wl-summary-read-folder
(concat wl-default-spec (substring folder 1))
"for archive"))))
(wl-folder-archive-entity (car flist))
(setq flist (cdr flist)))))
((stringp entity)
- (wl-summary-archive nil entity t))))
+ (wl-summary-archive nil (wl-folder-get-elmo-folder entity) t))))
;; append log
(defvar wl-fldmgr-add-completion-hashtb (make-vector 7 0))
-(defun wl-fldmgr-add-completion-all-completions (string)
- (let ((table
- (catch 'found
- (mapatoms
- (function
- (lambda (atom)
- (if (string-match (symbol-name atom) string)
- (throw 'found (symbol-value atom)))))
- wl-fldmgr-add-completion-hashtb)))
- (pattern
- (if (string-match "\\.$"
- (car (elmo-network-get-spec
- string nil nil nil nil)))
- (substring string 0 (match-beginning 0))
- (concat string nil))))
- (or table
- (setq table (elmo-list-folders pattern))
- (and table
- (or (/= (length table) 1)
- (elmo-folder-exists-p (car table))))
- (setq pattern
- (if (string-match "\\.[^\\.]+$" string)
- (substring string 0 (match-beginning 0))
- (char-to-string (aref string 0)))
- table (elmo-list-folders pattern)))
- (setq pattern (concat "^" (regexp-quote pattern)))
- (unless (intern-soft pattern wl-fldmgr-add-completion-hashtb)
- (set (intern pattern wl-fldmgr-add-completion-hashtb) table))
- table))
-
-(defun wl-fldmgr-add-completion-subr (string predicate flag)
- (let ((table
- (if (string= string "")
- (mapcar (function (lambda (spec)
- (list (char-to-string (car spec)))))
- elmo-spec-alist)
- (when (assq (aref string 0) elmo-spec-alist)
- (delq nil (mapcar
- (function list)
- (condition-case nil
- (wl-fldmgr-add-completion-all-completions string)
- (error nil))))))))
- (if (null flag)
- (try-completion string table predicate)
- (if (eq flag 'lambda)
- (eq t (try-completion string table predicate))
- (if flag
- (all-completions string table predicate))))))
+;(defun wl-fldmgr-add-completion-all-completions (string)
+; (let ((table
+; (catch 'found
+; (mapatoms
+; (function
+; (lambda (atom)
+; (if (string-match (symbol-name atom) string)
+; (throw 'found (symbol-value atom)))))
+; wl-fldmgr-add-completion-hashtb)))
+; (pattern
+; (if (string-match "\\.$"
+; (car (elmo-network-get-spec
+; string nil nil nil nil)))
+; (substring string 0 (match-beginning 0))
+; (concat string nil))))
+; (or table
+; (setq table (elmo-folder-list-subfolders (wl-folder-get-elmo-folder
+; pattern)))
+; (and table
+; (or (/= (length table) 1)
+; (elmo-folder-exists-p (wl-folder-get-elmo-folder
+; (car table)))))
+; (setq pattern
+; (if (string-match "\\.[^\\.]+$" string)
+; (substring string 0 (match-beginning 0))
+; (char-to-string (aref string 0)))
+; table (elmo-folder-list-subfolders
+; (wl-folder-get-elmo-folder pattern))))
+; (setq pattern (concat "^" (regexp-quote pattern)))
+; (unless (intern-soft pattern wl-fldmgr-add-completion-hashtb)
+; (set (intern pattern wl-fldmgr-add-completion-hashtb) table))
+; table))
+
+;(defun wl-fldmgr-add-completion-subr (string predicate flag)
+; (let ((table
+; (if (string= string "")
+; (mapcar (function (lambda (spec)
+; (list (char-to-string (car spec)))))
+; elmo-spec-alist)
+; (when (assq (aref string 0) elmo-spec-alist)
+; (delq nil (mapcar
+; (function list)
+; (condition-case nil
+; (wl-fldmgr-add-completion-all-completions string)
+; (error nil))))))))
+; (if (null flag)
+; (try-completion string table predicate)
+; (if (eq flag 'lambda)
+; (eq t (try-completion string table predicate))
+; (if flag
+; (all-completions string table predicate))))))
(defun wl-fldmgr-add (&optional name)
(interactive)
(setq name (wl-fldmgr-read-string
(wl-summary-read-folder wl-default-folder "to add"))))
;; maybe add elmo-plugged-alist.
- (when (stringp name)
- (elmo-folder-set-plugged name wl-plugged t))
+ (elmo-folder-set-plugged (wl-folder-get-elmo-folder name) wl-plugged t)
(when (setq diffs
(wl-add-entity
path (list name) wl-folder-entity (nth 3 tmp) t))
(let* ((inhibit-read-only t)
(tmp (wl-fldmgr-get-path-from-buffer))
(entity (elmo-string (nth 4 tmp)))
- (msgs (and (elmo-folder-exists-p entity)
- (elmo-list-folder entity))))
+ (folder (wl-folder-get-elmo-folder entity))
+ (msgs (and (elmo-folder-exists-p folder)
+ (elmo-folder-list-messages folder))))
(when (yes-or-no-p (format "%sDo you really delete \"%s\"? "
(if (> (length msgs) 0)
(format "%d msg(s) exists. " (length msgs))
"")
entity))
- (elmo-delete-folder entity)
+ (elmo-folder-delete folder)
(wl-fldmgr-cut tmp nil t)))))
(defun wl-fldmgr-rename ()
(wl-fldmgr-read-string
(wl-summary-read-folder old-folder "to rename" t t old-folder)))
(if (or (wl-folder-entity-exists-p new-folder)
- (file-exists-p (elmo-msgdb-expand-path new-folder)))
+ (file-exists-p (elmo-folder-msgdb-path
+ (wl-folder-get-elmo-folder new-folder))))
(error "Already exists folder: %s" new-folder))
- (elmo-rename-folder old-folder new-folder)
+ (elmo-folder-rename (wl-folder-get-elmo-folder old-folder)
+ (wl-folder-get-elmo-folder new-folder))
(wl-folder-set-entity-info
new-folder
(wl-folder-get-entity-info old-folder))
(message "Can't make multi included group folder")
(throw 'done nil))
(t
- (let ((spec (elmo-folder-get-spec (car cut-entity)))
+ (let ((folder (wl-folder-get-elmo-folder
+ (car cut-entity)))
multi-fld)
- (if (eq (car spec) 'multi)
+ (if (eq (elmo-folder-type-internal folder) 'multi)
(setq multi-fld
(substring (car cut-entity) 1)))
(setq new-entity
(require 'elmo-vars)
(require 'elmo-util)
-(require 'elmo2)
+(require 'elmo)
(require 'wl-vars)
(condition-case ()
(require 'easymenu) ; needed here.
(require 'wl-util)
(provide 'wl-folder)
(require 'wl)
- (require 'elmo-nntp)
- (if wl-use-semi
- (require 'mmelmo))
- (unless (boundp ':file)
- (set (make-local-variable ':file) nil))
- (defun-maybe mmelmo-cleanup-entity-buffers ()))
+ (require 'elmo-nntp))
(defvar wl-folder-buffer-name "Folder")
(defvar wl-folder-entity nil) ; desktop entity.
(defvar wl-folder-entity-id nil) ; id
(defvar wl-folder-entity-hashtb nil)
(defvar wl-folder-entity-id-name-hashtb nil)
+(defvar wl-folder-elmo-folder-hashtb nil) ; name => elmo folder structure
+
(defvar wl-folder-newsgroups-hashtb nil)
(defvar wl-folder-info-alist-modified nil)
(defvar wl-folder-completion-func nil)
["Next Folder" wl-folder-next-entity t]
["Check Current Folder" wl-folder-check-current-entity t]
["Sync Current Folder" wl-folder-sync-current-entity t]
- ["Drop Current Folder" wl-folder-drop-unsync-current-entity t]
+; ["Drop Current Folder" wl-folder-drop-unsync-current-entity t]
["Prefetch Current Folder" wl-folder-prefetch-current-entity t]
["Mark as Read all Current Folder" wl-folder-mark-as-read-all-current-entity t]
["Expire Current Folder" wl-folder-expire-current-entity t]
(define-key wl-folder-mode-map "rs" 'wl-folder-check-region)
(define-key wl-folder-mode-map "s" 'wl-folder-check-current-entity)
(define-key wl-folder-mode-map "I" 'wl-folder-prefetch-current-entity)
- (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
+; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
(define-key wl-folder-mode-map "p" 'wl-folder-prev-entity)
(define-key wl-folder-mode-map "n" 'wl-folder-next-entity)
(define-key wl-folder-mode-map "v" 'wl-folder-toggle-disp-summary)
hashtb))))
(defun wl-folder-persistent-p (folder)
- (or (elmo-get-hash-val folder wl-folder-entity-hashtb) ; on Folder mode.
+ (or (and (wl-folder-search-entity-by-name folder wl-folder-entity
+ 'folder)
+ t) ; on Folder mode.
(catch 'found
(let ((li wl-save-folder-list))
(while li
(throw 'found t))
(setq li (cdr li))))))))
+;;; ELMO folder structure with cache.
+(defmacro wl-folder-get-elmo-folder (entity)
+ "Get elmo folder structure from entity."
+ (` (or (wl-folder-elmo-folder-cache-get (, entity))
+ (let* ((name (elmo-string (, entity)))
+ (folder (elmo-make-folder name)))
+ (wl-folder-elmo-folder-cache-put name folder)
+ folder))))
+
+(defmacro wl-folder-elmo-folder-cache-get (name &optional hashtb)
+ "Returns a elmo folder structure associated with NAME from HASHTB.
+Default HASHTB is `wl-folder-elmo-folder-hashtb'."
+ (` (elmo-get-hash-val (, name)
+ (or (, hashtb) wl-folder-elmo-folder-hashtb))))
+
+(defmacro wl-folder-elmo-folder-cache-put (name folder &optional hashtb)
+ "Get folder elmo folder structure on HASHTB for folder with NAME.
+Default HASHTB is `wl-folder-elmo-folder-hashtb'."
+ (` (elmo-set-hash-val (, name) (, folder)
+ (or (, hashtb) wl-folder-elmo-folder-hashtb))))
+
(defun wl-folder-prev-entity ()
(interactive)
(forward-line -1))
emptied)
(if elmo-enable-disconnected-operation
(elmo-dop-queue-flush 'force)) ; Try flushing all queue.
- (if (not (elmo-list-folder wl-queue-folder))
+ (if (not (elmo-folder-list-messages
+ (wl-folder-get-elmo-folder wl-queue-folder)))
(message "No sending queue exists.")
(if wl-stay-folder-window
(wl-folder-select-buffer
(setq wl-thread-entities nil
wl-thread-entity-list nil)
(if wl-summary-cache-use (wl-summary-save-view-cache))
- (wl-summary-msgdb-save))
+ (elmo-folder-commit wl-summary-buffer-elmo-folder))
(if (get-buffer-window cur-buf)
(select-window (get-buffer-window cur-buf)))
(set-buffer cur-buf)
(goto-char (point-max))))
(defsubst wl-folder-update-group (entity diffs &optional is-group)
- (let ((path (wl-folder-get-path
- wl-folder-entity
- (wl-folder-get-entity-id entity)
- entity)))
- (if (not is-group)
- ;; delete itself from path
- (setq path (delete (nth (- (length path) 1) path) path)))
- (goto-char (point-min))
- (catch 'done
- (while path
- ;; goto the path line.
- (if (or (eq (car path) 0) ; update desktop
- (wl-folder-buffer-search-group
- (wl-folder-get-petname
- (if (stringp (car path))
- (car path)
- (wl-folder-get-folder-name-by-id
- (car path))))))
- ;; update it.
- (wl-folder-update-diff-line diffs)
- (throw 'done t))
- (setq path (cdr path))))))
+ (save-excursion
+ (let ((path (wl-folder-get-path
+ wl-folder-entity
+ (wl-folder-get-entity-id entity)
+ entity)))
+ (if (not is-group)
+ ;; delete itself from path
+ (setq path (delete (nth (- (length path) 1) path) path)))
+ (goto-char (point-min))
+ (catch 'done
+ (while path
+ ;; goto the path line.
+ (if (or (eq (car path) 0) ; update desktop
+ (wl-folder-buffer-search-group
+ (wl-folder-get-petname
+ (if (stringp (car path))
+ (car path)
+ (wl-folder-get-folder-name-by-id
+ (car path))))))
+ ;; update it.
+ (wl-folder-update-diff-line diffs)
+ (throw 'done t))
+ (setq path (cdr path)))))))
(defun wl-folder-maybe-load-folder-list (entity)
(when (null (caddr entity))
(setq beg (point))
(if arg
(wl-folder-update-recursive-current-entity entity)
- ;; insert as opened
- (setcdr (assoc (car entity) wl-folder-group-alist) t)
- (if (eq 'access (cadr entity))
- (wl-folder-maybe-load-folder-list entity))
- (condition-case errobj
- (progn
- (if (or (wl-folder-force-fetch-p (car entity))
- (and
- (eq 'access (cadr entity))
- (null (caddr entity))))
- (wl-folder-update-newest indent entity)
- (wl-folder-insert-entity indent entity))
- (wl-highlight-folder-path wl-folder-buffer-cur-path))
- (quit
- (setq err t)
- (setcdr (assoc fname wl-folder-group-alist) nil))
- (error
- (elmo-display-error errobj t)
- (ding)
- (setq err t)
- (setcdr (assoc fname wl-folder-group-alist) nil)))
- (if (not err)
- (let ((buffer-read-only nil))
- (delete-region (save-excursion (beginning-of-line)
- (point))
- (save-excursion (end-of-line)
- (+ 1 (point))))))))
+ ;; insert as opened
+ (setcdr (assoc (car entity) wl-folder-group-alist) t)
+ (if (eq 'access (cadr entity))
+ (wl-folder-maybe-load-folder-list entity))
+ ;(condition-case errobj
+ (progn
+ (if (or (wl-folder-force-fetch-p (car entity))
+ (and
+ (eq 'access (cadr entity))
+ (null (caddr entity))))
+ (wl-folder-update-newest indent entity)
+ (wl-folder-insert-entity indent entity))
+ (wl-highlight-folder-path wl-folder-buffer-cur-path))
+ ; (quit
+ ; (setq err t)
+ ; (setcdr (assoc fname wl-folder-group-alist) nil))
+ ; (error
+ ; (elmo-display-error errobj t)
+ ; (ding)
+ ; (setq err t)
+ ; (setcdr (assoc fname wl-folder-group-alist) nil)))
+ (if (not err)
+ (let ((buffer-read-only nil))
+ (delete-region (save-excursion (beginning-of-line)
+ (point))
+ (save-excursion (end-of-line)
+ (+ 1 (point))))))))
(setq beg (point))
(end-of-line)
(save-match-data
(get-buffer-window summary-buf))
(delete-window)))
(wl-summary-goto-folder-subr fld-name
- (wl-summary-get-sync-range fld-name)
+ (wl-summary-get-sync-range
+ (wl-folder-get-elmo-folder fld-name))
nil arg t)))))
(set-buffer-modified-p nil))
;(wl-folder-buffer-search-entity (car entity))
;(wl-folder-update-line ret-val)
))
- ((and (stringp entity)
- (elmo-folder-plugged-p entity))
+ ((stringp entity)
(message "Checking \"%s\"" entity)
- (setq ret-val (wl-folder-check-one-entity entity))
+ (setq ret-val (wl-folder-check-one-entity
+ entity))
(goto-char start-pos)
(sit-for 0))
(t
(run-hooks 'wl-folder-check-entity-hook)
ret-val))
-;; All contained folders are imap4 and persistent flag, then
-;; use server diff.
-(defun wl-folder-use-server-diff-p (folder)
- (let ((spec (elmo-folder-get-spec folder)))
- (cond
- ((eq (car spec) 'multi)
- (let ((folders (cdr spec)))
- (catch 'done
- (while folders
- (if (wl-folder-use-server-diff-p (car folders))
- (throw 'done t))
- (setq folders (cdr folders)))
- nil)))
- ((eq (car spec) 'filter)
- (wl-folder-use-server-diff-p (nth 2 spec)))
- ((eq (car spec) 'imap4)
- (and wl-folder-use-server-diff
- (elmo-imap4-use-flag-p spec)))
- (t nil))))
-
(defun wl-folder-check-one-entity (entity)
- (let* ((elmo-use-server-diff (wl-folder-use-server-diff-p entity))
+ (let* ((folder (wl-folder-get-elmo-folder entity))
(nums (condition-case err
(if (wl-string-match-member entity wl-strict-diff-folders)
- (elmo-strict-folder-diff entity)
- (elmo-folder-diff entity))
+ (elmo-strict-folder-diff folder)
+ (elmo-folder-diff folder))
(error
;; maybe not exist folder.
(if (and (not (memq 'elmo-open-error
(get (car err) 'error-conditions)))
- (not (elmo-folder-exists-p entity)))
- (wl-folder-create-subr entity)
+ (not (elmo-folder-exists-p folder)))
+ (wl-folder-create-subr folder)
(signal (car err) (cdr err))))))
unread unsync nomif)
(if (and (eq wl-folder-notify-deleted 'sync)
(or (> 0 (car nums)) (> 0 (cdr nums))))
(progn
(wl-folder-sync-entity entity)
- (setq nums (elmo-folder-diff entity)))
+ (setq nums (elmo-folder-diff folder)))
(unless wl-folder-notify-deleted
(setq unsync (if (and (car nums) (> 0 (car nums))) 0 (car nums)))
(setq nomif (if (and (car nums) (> 0 (cdr nums))) 0 (cdr nums)))
(or
;; If server diff, All unreads are
;; treated as unsync.
- (if elmo-use-server-diff 0)
- (elmo-folder-get-info-unread entity)
+ (if (elmo-folder-use-flag-p folder)
+ 0)
+ (elmo-folder-get-info-unread
+ folder)
(wl-summary-count-unread
(elmo-msgdb-mark-load
- (elmo-msgdb-expand-path entity))
- entity)))
+ (elmo-folder-msgdb-path
+ folder)))))
(cdr nums))
(current-buffer)))
(setq wl-folder-info-alist-modified t)
(wl-folder-get-entity-list entity))
(wl-folder-get-entity-list entity)))
(nntp-connection-keys nil)
- folder spec-list local-elist net-elist server
+ name folder folder-list
+ sync-folder-list
+ async-folder-list
+ server
ret-val)
(while elist
- (if (not (elmo-folder-plugged-p (car elist)))
+ (setq folder (wl-folder-get-elmo-folder (car elist)))
+ (if (not (elmo-folder-plugged-p folder))
(message "Uncheck \"%s\"" (car elist))
- (setq spec-list
- (elmo-folder-get-primitive-spec-list (elmo-string (car elist))))
- (cond ((assq 'nntp spec-list)
- (wl-append net-elist (list (car elist)))
- (while spec-list
- (when (eq (caar spec-list) 'nntp)
- (when (not (string= server (elmo-nntp-spec-hostname (car spec-list))))
- (setq server (elmo-nntp-spec-hostname (car spec-list)))
+ (setq folder-list
+ (elmo-folder-get-primitive-list folder))
+ (cond ((elmo-folder-contains-type folder 'nntp)
+ (wl-append async-folder-list (list folder))
+ (while folder-list
+ (when (eq (elmo-folder-type-internal (car folder-list))
+ 'nntp)
+ (when (not (string=
+ server
+ (elmo-net-folder-server-internal
+ (car folder-list))))
+ (setq server (elmo-net-folder-server-internal
+ (car folder-list)))
(message "Checking on \"%s\"" server))
(setq nntp-connection-keys
(elmo-nntp-get-folders-info-prepare
- (car spec-list)
+ (car folder-list)
nntp-connection-keys)))
- (setq spec-list (cdr spec-list))))
+ (setq folder-list (cdr folder-list))))
(t
- (wl-append local-elist (list (car elist))))))
+ (wl-append sync-folder-list (list folder)))))
(setq elist (cdr elist)))
;; check local entity at first
- (while (setq folder (pop local-elist))
+ (while (setq folder (pop sync-folder-list))
(if (not (elmo-folder-plugged-p folder))
- (message "Uncheck \"%s\"" folder)
- (message "Checking \"%s\"" folder)
+ (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
+ (message "Checking \"%s\"" (elmo-folder-name-internal folder))
(setq ret-val
(wl-folder-add-folder-info
ret-val
- (wl-folder-check-one-entity folder)))
+ (wl-folder-check-one-entity (elmo-folder-name-internal
+ folder))))
;;(sit-for 0)
))
;; check network entity at last
- (when net-elist
+ (when async-folder-list
(elmo-nntp-get-folders-info nntp-connection-keys)
- (while (setq folder (pop net-elist))
+ (while (setq folder (pop async-folder-list))
(if (not (elmo-folder-plugged-p folder))
- (message "Uncheck \"%s\"" folder)
- (message "Checking \"%s\"" folder)
+ (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
+ (message "Checking \"%s\"" (elmo-folder-name-internal folder))
(setq ret-val
(wl-folder-add-folder-info
ret-val
- (wl-folder-check-one-entity folder)))
+ (wl-folder-check-one-entity (elmo-folder-name-internal
+ folder))))
;;(sit-for 0)
)))
ret-val))
(wl-folder-sync-entity (car flist) unread-only)
(setq flist (cdr flist)))))
((stringp entity)
- (let ((nums (wl-folder-get-entity-info entity))
- (wl-summary-highlight (if (or (wl-summary-sticky-p entity)
- (wl-summary-always-sticky-folder-p
- entity))
- wl-summary-highlight))
- wl-auto-select-first new unread)
+ (let* ((folder (wl-folder-get-elmo-folder entity))
+ (nums (wl-folder-get-entity-info entity))
+ (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
+ (wl-summary-always-sticky-folder-p
+ folder))
+ wl-summary-highlight))
+ wl-auto-select-first new unread)
(setq new (or (car nums) 0))
(setq unread (or (cadr nums) 0))
(if (or (not unread-only)
(save-excursion
(let ((wl-summary-buffer-name (concat
wl-summary-buffer-name
- (symbol-name this-command)))
- (wl-message-buf-name (concat wl-message-buf-name
- (symbol-name this-command))))
+ (symbol-name this-command))))
(wl-summary-goto-folder-subr entity
- (wl-summary-get-sync-range entity)
+ (wl-summary-get-sync-range
+ folder)
nil nil nil t)
(wl-summary-exit)))))))))
(wl-folder-mark-as-read-all-entity (car flist))
(setq flist (cdr flist)))))
((stringp entity)
- (let ((nums (wl-folder-get-entity-info entity))
- (wl-summary-highlight (if (or (wl-summary-sticky-p entity)
- (wl-summary-always-sticky-folder-p
- entity))
- wl-summary-highlight))
- wl-auto-select-first new unread)
+ (let* ((nums (wl-folder-get-entity-info entity))
+ (folder (wl-folder-get-elmo-folder entity))
+ (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
+ (wl-summary-always-sticky-folder-p
+ folder))
+ wl-summary-highlight))
+ wl-auto-select-first new unread)
(setq new (or (car nums) 0))
(setq unread (or (cadr nums) 0))
(if (or (< 0 new) (< 0 unread))
- (save-window-excursion
- (save-excursion
- (let ((wl-summary-buffer-name (concat
+ (save-window-excursion
+ (save-excursion
+ (let ((wl-summary-buffer-name (concat
wl-summary-buffer-name
- (symbol-name this-command)))
- (wl-message-buf-name (concat wl-message-buf-name
- (symbol-name this-command))))
- (wl-summary-goto-folder-subr entity
- (wl-summary-get-sync-range entity)
- nil)
- (wl-summary-mark-as-read-all)
- (wl-summary-exit))))
+ (symbol-name this-command))))
+ (wl-summary-goto-folder-subr entity
+ (wl-summary-get-sync-range folder)
+ nil)
+ (wl-summary-mark-as-read-all)
+ (wl-summary-exit))))
(sit-for 0))))))
(defun wl-folder-mark-as-read-all-current-entity ()
(if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
(save-excursion
(setq entity (wl-folder-get-entity-from-buffer))
- (if (not (elmo-folder-plugged-p entity))
+ (if (not (elmo-folder-plugged-p (wl-folder-get-elmo-folder
+ entity)))
(message "Uncheck %s" entity)
(message "Checking %s" entity)
(wl-folder-check-one-entity entity)
(and (interactive-p) (wl-folder-buffer-group-p)))
(error "This command is not available on Group"))
(beginning-of-line)
- (let (wl-auto-select-first)
+ (let (wl-auto-select-first
+ (wl-stay-folder-window t))
(cond
((eq arg 'on)
(setq wl-folder-buffer-disp-summary t))
(setcdr (assoc (car wl-folder-entity) wl-folder-group-alist) t)
(save-excursion
(wl-folder-insert-entity " " wl-folder-entity)))
+ (sit-for 0)
(set-buffer-modified-p nil)
- ;(sit-for 0)
(setq initialize t))
initialize))
(if (setq buf (get-buffer wl-folder-buffer-name))
(wl-folder-entity-hashtb-set
wl-folder-entity-hashtb name value buf))
-;;; (elmo-folder-set-info-hashtb (elmo-string name)
-;;; nil
-;;; (nth 2 value)
-;;; (nth 0 value)
-;;; (nth 1 value))
(setq wl-folder-info-alist-modified t))))
(defun wl-folder-calc-finfo (entity)
(if as-opened
(let (update-flist flist-unsub new-flist removed group-name-end)
(when (and (eq (cadr entity) 'access)
- (elmo-folder-plugged-p (car entity)))
+ (elmo-folder-plugged-p
+ (wl-folder-get-elmo-folder (car entity))))
(message "Fetching folder entries...")
(when (setq new-flist
- (elmo-list-folders
- (elmo-string (car entity))
+ (elmo-folder-list-subfolders
+ (wl-folder-get-elmo-folder (car entity))
(wl-string-member
(car entity)
wl-folder-hierarchy-access-folders)))
(equal diffs '(0 0 0)))
(wl-folder-set-entity-info name value entity-hashtb)
(save-match-data
- (save-excursion
- (set-buffer buffer)
- (setq entity-list (wl-folder-search-entity-list-by-name
- name wl-folder-entity))
- (while entity-list
- (wl-folder-update-group (car entity-list) diffs)
- (setq entity-list (cdr entity-list)))
- (goto-char (point-min))
- (while (wl-folder-buffer-search-entity name)
- (wl-folder-update-line value)))))))
-
+ (with-current-buffer buffer
+ (save-excursion
+ (setq entity-list (wl-folder-search-entity-list-by-name
+ name wl-folder-entity))
+ (while entity-list
+ (wl-folder-update-group (car entity-list) diffs)
+ (setq entity-list (cdr entity-list)))
+ (goto-char (point-min))
+ (while (wl-folder-buffer-search-entity name)
+ (wl-folder-update-line value))))))))
+
(defun wl-folder-update-unread (folder unread)
- (save-window-excursion
+; (save-window-excursion
(let ((buf (get-buffer wl-folder-buffer-name))
cur-unread
(unread-diff 0)
(setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0))
(setq unread-diff (- (or unread 0) cur-unread))
(setq value (wl-folder-get-entity-info folder))
-
(setq newvalue (list (nth 0 value)
unread
(nth 2 value)))
(when (and buf
(not (eq unread-diff 0)))
(save-match-data
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(save-excursion
(setq entity-list (wl-folder-search-entity-list-by-name
folder wl-folder-entity))
(setq entity-list (cdr entity-list)))
(goto-char (point-min))
(while (wl-folder-buffer-search-entity folder)
- (wl-folder-update-line newvalue)))))))))
+ (wl-folder-update-line newvalue))))))));)
(defun wl-folder-create-entity-hashtb (entity &optional hashtb reconst)
(let ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
;; (setq entities (wl-pop entity-stack))))
;; hashtb))
-(defun wl-folder-create-newsgroups-from-nntp-access2 (entity)
- (let ((flist (nth 2 entity))
- folders)
- (and
- (setq folders
- (delq
- nil
- (mapcar
- '(lambda (fld)
- (if (consp fld)
- (wl-folder-create-newsgroups-from-nntp-access2 fld)
- (nth 1 (elmo-folder-get-spec fld))))
- flist)))
- (elmo-nntp-make-groups-hashtb folders 1024))
- nil))
-
(defun wl-folder-create-newsgroups-from-nntp-access (entity)
(let ((flist (nth 2 entity))
folders)
((consp (car flist))
(wl-folder-create-newsgroups-from-nntp-access (car flist)))
(t
- (list (nth 1 (elmo-folder-get-spec (car flist)))))))
+ (list
+ (elmo-nntp-folder-group-internal
+ (wl-folder-get-elmo-folder (car flist)))))))
(setq flist (cdr flist)))
folders))
(defun wl-folder-create-newsgroups-hashtb (entity &optional is-list info)
+ "Create NNTP group hashtable for ENTITY."
(let ((entities (if is-list entity (list entity)))
- entity-stack spec-list folders fld make-hashtb)
+ entity-stack folder-list newsgroups newsgroup make-hashtb)
(and info (message "Creating newsgroups..."))
(while entities
(setq entity (wl-pop entities))
(cond
((consp entity)
(if (eq (nth 1 entity) 'access)
- (when (eq (elmo-folder-get-type (car entity)) 'nntp)
- (wl-append folders
+ (when (eq (elmo-folder-type-internal
+ (elmo-make-folder (car entity))) 'nntp)
+ (wl-append newsgroups
(wl-folder-create-newsgroups-from-nntp-access entity))
(setq make-hashtb t))
(and entities
(wl-push entities entity-stack))
(setq entities (nth 2 entity))))
((stringp entity)
- (setq spec-list (elmo-folder-get-primitive-spec-list entity))
- (while spec-list
- (when (and (eq (caar spec-list) 'nntp)
- (setq fld (nth 1 (car spec-list))))
- (wl-append folders (list (elmo-string fld))))
- (setq spec-list (cdr spec-list)))))
+ (setq folder-list (elmo-folder-get-primitive-list
+ (elmo-make-folder entity)))
+ (while folder-list
+ (when (and (eq (elmo-folder-type-internal (car folder-list))
+ 'nntp)
+ (setq newsgroup (elmo-nntp-folder-group-internal
+ (car folder-list))))
+ (wl-append newsgroups (list (elmo-string newsgroup))))
+ (setq folder-list (cdr folder-list)))))
(unless entities
(setq entities (wl-pop entity-stack))))
(and info (message "Creating newsgroups...done"))
- (if (or folders make-hashtb)
- (elmo-nntp-make-groups-hashtb folders))))
+ (if (or newsgroups make-hashtb)
+ (elmo-nntp-make-groups-hashtb newsgroups))))
(defun wl-folder-get-path (entity target-id &optional string)
(let ((entities (list entity))
(add (not wl-reset-plugged-alist)))
(while entity-list
(elmo-folder-set-plugged
- (elmo-string (car entity-list)) wl-plugged add)
+ (wl-folder-get-elmo-folder (car entity-list)) wl-plugged add)
(setq entity-list (cdr entity-list)))
;; smtp posting server
(when wl-smtp-posting-server
wl-smtp-posting-server ; server
(or (and (boundp 'smtp-service) smtp-service)
"smtp") ; port
+ wl-smtp-connection-type
nil nil "smtp" add))
;; nntp posting server
(when wl-nntp-posting-server
(elmo-set-plugged wl-plugged
wl-nntp-posting-server
+ wl-nntp-posting-stream-type
elmo-default-nntp-port
nil nil "nntp" add))
(run-hooks 'wl-make-plugged-hook)))
(wl-folder-entity-assign-id wl-folder-entity)
(setq wl-folder-entity-hashtb
(wl-folder-create-entity-hashtb entity))
+ (setq wl-folder-elmo-folder-hashtb (elmo-make-hash wl-folder-entity-id))
(setq wl-folder-group-alist
(wl-folder-create-group-alist entity))
(setq wl-folder-newsgroups-hashtb
wl-folder-petname-alist))
petname))
-(defun wl-folder-get-petname (folder)
+(defun wl-folder-get-petname (name)
(or (cdr
(wl-string-assoc
- folder
+ name
wl-folder-petname-alist))
- folder))
+ name))
(defun wl-folder-get-entity-with-petname ()
(let ((alist wl-folder-petname-alist)
(defun wl-folder-get-newsgroups (folder)
"Return Newsgroups field value string for FOLDER newsgroup.
If FOLDER is multi, return comma separated string (cross post)."
- (let ((flist (elmo-folder-get-primitive-folder-list folder)) ; multi
+ (let ((flist (elmo-folder-get-primitive-list
+ (wl-folder-get-elmo-folder folder))) ; multi
newsgroups fld ret)
(while (setq fld (car flist))
(if (setq ret
- (cond ((eq 'nntp (elmo-folder-get-type fld))
- (nth 1 (elmo-folder-get-spec fld)))
- ((eq 'localnews (elmo-folder-get-type fld))
+ (cond ((eq 'nntp (elmo-folder-type-internal fld))
+ (elmo-nntp-folder-group-internal fld))
+ ((eq 'localnews (elmo-folder-type-internal fld))
(elmo-replace-in-string
- (nth 1 (elmo-folder-get-spec fld)) "/" "\\."))))
+ (elmo-nntp-folder-group-internal fld)
+ "/" "\\."))))
;; append newsgroup
(setq newsgroups (if (stringp newsgroups)
(concat newsgroups "," ret)
"Return ML address guess by FOLDER.
Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'.
Don't care multi."
- (setq folder (car (elmo-folder-get-primitive-folder-list folder)))
- (unless (memq (elmo-folder-get-type folder)
+ (setq folder (car
+ (elmo-folder-get-primitive-list
+ (wl-folder-get-elmo-folder folder))))
+ (unless (memq (elmo-folder-type-internal folder)
'(localnews nntp))
(let ((rules wl-refile-rule-alist)
mladdress tokey toalist histkey)
(defun wl-folder-guess-mailing-list-by-folder-name (folder)
"Return ML address guess by FOLDER name's last hierarchy.
Use `wl-subscribed-mailing-list'."
- (setq folder (car (elmo-folder-get-primitive-folder-list folder)))
- (when (memq (elmo-folder-get-type folder)
+ (setq folder (car (elmo-folder-get-primitive-list
+ (wl-folder-get-elmo-folder folder))))
+ (when (memq (elmo-folder-type-internal folder)
'(localdir imap4 maildir))
(let (key mladdress)
- (when (string-match "[^\\./]+$" folder)
+ (when (string-match "[^\\./]+$" (elmo-folder-name-internal folder))
(setq key (regexp-quote
(concat (substring folder (match-beginning 0)) "@")))
(setq mladdress
;; update only colors
(wl-highlight-folder-group-line nums)
(wl-highlight-folder-current-line nums))
+ (beginning-of-line)
(set-buffer-modified-p nil))))))
(defun wl-folder-goto-folder (&optional arg)
(get-buffer-window summary-buf))
(delete-window)))
(wl-summary-goto-folder-subr fld-name
- (wl-summary-get-sync-range fld-name)
+ (wl-summary-get-sync-range
+ (wl-folder-get-elmo-folder fld-name))
nil sticky t)))
-
+
(defun wl-folder-suspend ()
(interactive)
(run-hooks 'wl-folder-suspend-hook)
(wl-folder-info-save)
(wl-crosspost-alist-save)
- (wl-kill-buffers
- (format "^\\(%s\\)$"
- (mapconcat 'identity
- (list (format "%s\\(:.*\\)?"
- (default-value 'wl-message-buf-name))
- wl-original-buf-name)
- "\\|")))
- (if (fboundp 'mmelmo-cleanup-entity-buffers)
- (mmelmo-cleanup-entity-buffers))
+ (elmo-quit)
+ ;(if (fboundp 'mmelmo-cleanup-entity-buffers)
+ ;(mmelmo-cleanup-entity-buffers))
(bury-buffer wl-folder-buffer-name)
(delete-windows-on wl-folder-buffer-name t))
(wl-push entities entity-stack))
(setq entities (nth 2 entity)))
((stringp entity)
- (when (and (setq info (elmo-folder-get-info entity))
+ (when (and (setq info (elmo-folder-get-info
+ (wl-folder-get-elmo-folder entity)))
(not (equal info '(nil))))
(wl-append info-alist (list (list (elmo-string entity)
(list (nth 3 info) ;; max
(save-excursion
(let ((wl-summary-buffer-name (concat
wl-summary-buffer-name
- (symbol-name this-command)))
- (wl-message-buf-name (concat wl-message-buf-name
- (symbol-name this-command))))
+ (symbol-name this-command))))
(wl-summary-goto-folder-subr entity
(wl-summary-get-sync-range entity)
nil)
(cons 0 0))))))
(defun wl-folder-count-incorporates (folder)
- (let ((marks (elmo-msgdb-mark-load (elmo-msgdb-expand-path folder)))
+ (let ((marks (elmo-msgdb-mark-load
+ (elmo-folder-msgdb-path
+ (wl-folder-get-elmo-folder folder))))
(sum 0))
(while marks
(if (member (cadr (car marks))
(wl-folder-check-entity entity))
(wl-folder-prefetch-entity entity)))))
-(defun wl-folder-drop-unsync-entity (entity)
- "Drop all unsync messages in the ENTITY."
- (cond
- ((consp entity)
- (let ((flist (nth 2 entity)))
- (while flist
- (wl-folder-drop-unsync-entity (car flist))
- (setq flist (cdr flist)))))
- ((stringp entity)
- (let ((nums (wl-folder-get-entity-info entity))
- wl-summary-highlight wl-auto-select-first new)
- (setq new (or (car nums) 0))
- (if (< 0 new)
- (save-window-excursion
- (save-excursion
- (let ((wl-summary-buffer-name (concat
- wl-summary-buffer-name
- (symbol-name this-command)))
- (wl-message-buf-name (concat wl-message-buf-name
- (symbol-name this-command))))
- (wl-summary-goto-folder-subr entity 'no-sync nil)
- (wl-summary-drop-unsync)
- (wl-summary-exit)))))))))
-
-(defun wl-folder-drop-unsync-current-entity (&optional force-check)
- "Drop all unsync messages in the folder at position.
-If current line is group folder, all subfolders are dropped.
-If optional arg exists, don't check any folders."
- (interactive "P")
- (save-excursion
- (let ((entity-name (wl-folder-get-entity-from-buffer))
- (group (wl-folder-buffer-group-p))
- wl-folder-check-entity-hook
- summary-buf entity)
- (when (and entity-name
- (y-or-n-p (format
- "Drop all unsync messages in %s?" entity-name)))
- (setq entity
- (if group
- (wl-folder-search-group-entity-by-name entity-name
- wl-folder-entity)
- entity-name))
- (if (null force-check)
- (wl-folder-check-entity entity))
- (wl-folder-drop-unsync-entity entity)
- (message "All unsync messages in %s are dropped!" entity-name)))))
+;(defun wl-folder-drop-unsync-entity (entity)
+; "Drop all unsync messages in the ENTITY."
+; (cond
+; ((consp entity)
+; (let ((flist (nth 2 entity)))
+; (while flist
+; (wl-folder-drop-unsync-entity (car flist))
+; (setq flist (cdr flist)))))
+; ((stringp entity)
+; (let ((nums (wl-folder-get-entity-info entity))
+; wl-summary-highlight wl-auto-select-first new)
+; (setq new (or (car nums) 0))
+; (if (< 0 new)
+; (save-window-excursion
+; (save-excursion
+; (let ((wl-summary-buffer-name (concat
+; wl-summary-buffer-name
+; (symbol-name this-command))))
+; (wl-summary-goto-folder-subr entity 'no-sync nil)
+; (wl-summary-drop-unsync)
+; (wl-summary-exit)))))))))
+
+;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
+; "Drop all unsync messages in the folder at position.
+;If current line is group folder, all subfolders are dropped.
+;If optional arg exists, don't check any folders."
+; (interactive "P")
+; (save-excursion
+; (let ((entity-name (wl-folder-get-entity-from-buffer))
+; (group (wl-folder-buffer-group-p))
+; wl-folder-check-entity-hook
+; summary-buf entity)
+; (when (and entity-name
+; (y-or-n-p (format
+; "Drop all unsync messages in %s?" entity-name)))
+; (setq entity
+; (if group
+; (wl-folder-search-group-entity-by-name entity-name
+; wl-folder-entity)
+; entity-name))
+; (if (null force-check)
+; (wl-folder-check-entity entity))
+; (wl-folder-drop-unsync-entity entity)
+; (message "All unsync messages in %s are dropped!" entity-name)))))
(defun wl-folder-write-current-folder ()
""
(wl-exit)
(kill-buffer bufname))))
-(defun wl-folder-create-subr (entity)
- (if (not (elmo-folder-creatable-p entity))
- (error "Folder %s is not found" entity)
+(defun wl-folder-create-subr (folder)
+ (if (not (elmo-folder-creatable-p folder))
+ (error "Folder %s is not found" (elmo-folder-name-internal folder))
(if (y-or-n-p
(format "Folder %s does not exist, create it?"
- entity))
+ (elmo-folder-name-internal folder)))
(progn
(setq wl-folder-entity-hashtb
(wl-folder-create-entity-hashtb
- entity wl-folder-entity-hashtb))
- (unless (elmo-create-folder entity)
+ (elmo-folder-name-internal folder)
+ wl-folder-entity-hashtb))
+ (unless (elmo-folder-create folder)
(error "Create folder failed")))
- (error "Folder %s is not created" entity))))
+ (error "Folder %s is not created" (elmo-folder-name-internal folder)))))
(defun wl-folder-confirm-existence (folder &optional force)
(if force
(unless (elmo-folder-exists-p folder)
(wl-folder-create-subr folder))
- (unless (or (wl-folder-entity-exists-p folder)
- (file-exists-p (elmo-msgdb-expand-path folder))
+ (unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal folder))
+ (file-exists-p (elmo-folder-msgdb-path folder))
(elmo-folder-exists-p folder))
(wl-folder-create-subr folder))))
(require 'wl-vars)
(require 'wl-highlight)
+(require 'elmo)
+(require 'elmo-mime) ; XXX should modify for tm.
(eval-when-compile
(if wl-use-semi
(progn
(require 'wl-mime)
- (require 'mime-view)
- (require 'mmelmo-imap4))
+ (require 'mime-view))
(require 'tm-wl))
(defalias-maybe 'event-window 'ignore)
(defalias-maybe 'posn-window 'ignore)
(defalias-maybe 'event-start 'ignore)
(defalias-maybe 'mime-open-entity 'ignore))
-(defvar wl-original-buf-name "*Message*")
-(defvar wl-message-buf-name "Message")
+(defconst wl-message-buffer-prefetch-idle-time
+ (if (featurep 'lisp-float-type) (/ (float 1) (float 5)) 1))
+(defvar wl-message-buffer-prefetch-get-next-func
+ 'wl-summary-default-get-next-msg)
+
+(defvar wl-message-buffer-prefetch-folder-type-list t)
+
+(defvar wl-message-buffer-prefetch-debug
+ t)
+(defvar wl-message-buffer-prefetch-threshold
+ 30000)
+
+(defvar wl-message-buffer nil) ; message buffer.
+
(defvar wl-message-buffer-cur-summary-buffer nil)
(defvar wl-message-buffer-cur-folder nil)
(defvar wl-message-buffer-cur-number nil)
-
-(defvar wl-original-buffer-cur-folder nil)
-(defvar wl-original-buffer-cur-number nil)
-(defvar wl-original-buffer-cur-msgdb nil)
-
-(defvar mmelmo-imap4-skipped-parts)
+(defvar wl-message-buffer-cur-flag nil)
+(defvar wl-message-buffer-cur-summary-buffer nil)
+(defvar wl-message-buffer-original-buffer nil) ; original buffer.
(make-variable-buffer-local 'wl-message-buffer-cur-folder)
(make-variable-buffer-local 'wl-message-buffer-cur-number)
+(make-variable-buffer-local 'wl-message-buffer-cur-flag)
+(make-variable-buffer-local 'wl-message-buffer-cur-summary-buffer)
+(make-variable-buffer-local 'wl-message-buffer-original-buffer)
(defvar wl-fixed-window-configuration nil)
+(defvar wl-message-buffer-cache-size 10) ; At least 1.
+
+;;; Message buffer cache.
+
+(defvar wl-message-buffer-cache nil
+ "Message cache. (old ... new) order alist.
+With association ((\"folder\" message \"message-id\") . cache-buffer).")
+
+(defmacro wl-message-buffer-cache-buffer-get (entry)
+ (` (cdr (, entry))))
+
+(defmacro wl-message-buffer-cache-folder-get (entry)
+ (` (car (car (, entry)))))
+
+(defmacro wl-message-buffer-cache-message-get (entry)
+ (` (cdr (car (, entry)))))
+
+(defmacro wl-message-buffer-cache-entry-make (key buf)
+ (` (cons (, key) (, buf))))
+
+(defmacro wl-message-buffer-cache-hit (key)
+ "Return value assosiated with key."
+ (` (wl-message-buffer-cache-buffer-get
+ (assoc (, key) wl-message-buffer-cache))))
+
+(defun wl-message-buffer-cache-sort (entry)
+ "Move ENTRY to the top of `wl-message-buffer-cache'."
+ (setq wl-message-buffer-cache
+ (cons entry (delete entry wl-message-buffer-cache))))
+; (let* ((pointer (cons nil wl-message-buffer-cache))
+; (top pointer))
+; (while (cdr pointer)
+; (if (equal (car (cdr pointer)) entry)
+; (setcdr pointer (cdr (cdr pointer)))
+; (setq pointer (cdr pointer))))
+; (setcdr pointer (list entry))
+; (setq wl-message-buffer-cache (cdr top))))
+
+(defconst wl-message-buffer-cache-name " *WL:Message*")
+(defconst wl-original-message-buffer-name " *Original*")
+
+(defun wl-original-message-mode ()
+ "A major mode for original message buffer."
+ (setq major-mode 'wl-original-message-mode)
+ (setq buffer-read-only t)
+ (elmo-set-buffer-multibyte nil)
+ (setq mode-name "Wanderlust original message"))
+
+(defun wl-original-message-buffer-get (name)
+ "Get original message buffer for NAME.
+If original message buffer already exists, it is re-used."
+ (let* ((name (concat wl-original-message-buffer-name name))
+ (buffer (get-buffer name)))
+ (unless (and buffer (buffer-live-p buffer))
+ (with-current-buffer (setq buffer (get-buffer-create name))
+ (wl-original-message-mode)))
+ buffer))
+
+(defun wl-message-buffer-create ()
+ "Create a new message buffer."
+ (let* ((buffer (generate-new-buffer wl-message-buffer-cache-name))
+ (name (buffer-name buffer)))
+ (with-current-buffer buffer
+ (setq wl-message-buffer-original-buffer
+ (wl-original-message-buffer-get name)))
+ buffer))
+
+(defun wl-message-buffer-cache-add (key)
+ "Add (KEY . buf) to the top of `wl-message-buffer-cache'.
+Return its cache buffer."
+ (let ((len (length wl-message-buffer-cache))
+ (buf nil))
+ (if (< len wl-message-buffer-cache-size)
+ (setq buf (wl-message-buffer-create))
+ (setq buf (wl-message-buffer-cache-buffer-get
+ (nth (1- len) wl-message-buffer-cache)))
+ (setcdr (nthcdr (- len 2) wl-message-buffer-cache) nil))
+ (setq wl-message-buffer-cache
+ (cons (wl-message-buffer-cache-entry-make key buf)
+ wl-message-buffer-cache))
+ buf))
+
+(defun wl-message-buffer-cache-delete (&optional key)
+ "Delete the most recent cache entry"
+ (if key
+ (setq wl-message-buffer-cache
+ (delq (assoc key wl-message-buffer-cache)
+ wl-message-buffer-cache))
+ (let ((buf (wl-message-buffer-cache-buffer-get
+ (car wl-message-buffer-cache))))
+ (setq wl-message-buffer-cache
+ (nconc (cdr wl-message-buffer-cache)
+ (list (wl-message-buffer-cache-entry-make nil buf)))))))
+
+(defun wl-message-buffer-cache-clean-up ()
+ "A function to flush all decoded messages in cache list."
+ (interactive)
+ (if (and (eq major-mode 'wl-summary-mode)
+ wl-message-buffer
+ (get-buffer-window wl-message-buffer))
+ (delete-window (get-buffer-window wl-message-buffer)))
+ (wl-kill-buffers (regexp-quote wl-message-buffer-cache-name))
+ (setq wl-message-buffer-cache nil))
+
+;;; Message buffer handling from summary buffer.
+
(defun wl-message-buffer-window ()
- (let* ((mes-buf (concat "^" (default-value 'wl-message-buf-name)))
- (start-win (selected-window))
+ "Get message buffer window if any."
+ (let* ((start-win (selected-window))
(cur-win start-win))
(catch 'found
(while (progn
(setq cur-win (next-window cur-win))
- (if (string-match mes-buf (buffer-name (window-buffer cur-win)))
- (throw 'found cur-win))
+ (with-current-buffer (window-buffer cur-win)
+ (if (or (eq major-mode 'wl-message-mode)
+ (eq major-mode 'mime-view-mode))
+ (throw 'found cur-win)))
(not (eq cur-win start-win)))))))
-(defun wl-select-buffer (buffer)
- (let ((gbw (or (get-buffer-window buffer)
- (wl-message-buffer-window)))
+(defun wl-message-select-buffer (buffer)
+ "Select BUFFER as a message buffer."
+ (let ((window (get-buffer-window buffer))
(sum (car wl-message-window-size))
(mes (cdr wl-message-window-size))
whi)
- (when (and gbw
- (not (eq (save-excursion (set-buffer (window-buffer gbw))
+ (when (and window
+ (not (eq (save-excursion (set-buffer (window-buffer window))
wl-message-buffer-cur-summary-buffer)
(current-buffer))))
- (delete-window gbw)
+ (delete-window window)
(run-hooks 'wl-message-window-deleted-hook)
- (setq gbw nil))
- (if gbw
- (select-window gbw)
-;;; (if (or (null mes)
-;;; wl-stay-folder-window)
-;;; (delete-other-windows))
+ (setq window nil))
+ (if window
+ (select-window window)
(when wl-fixed-window-configuration
(delete-other-windows)
(and wl-stay-folder-window
(wl-summary-toggle-disp-folder)))
- (setq whi (1- (window-height)))
- (if mes
- (progn
- (let ((total (+ sum mes)))
- (setq sum (max window-min-height (/ (* whi sum) total)))
- (setq mes (max window-min-height (/ (* whi mes) total))))
- (if (< whi (+ sum mes))
- (enlarge-window (- (+ sum mes) whi)))))
- (split-window (get-buffer-window (current-buffer)) sum)
- (other-window 1))
+ ;; There's no buffer window. Search for message window and snatch it.
+ (if (setq window (wl-message-buffer-window))
+ (select-window window)
+ (setq whi (1- (window-height)))
+ (if mes
+ (progn
+ (let ((total (+ sum mes)))
+ (setq sum (max window-min-height (/ (* whi sum) total)))
+ (setq mes (max window-min-height (/ (* whi mes) total))))
+ (if (< whi (+ sum mes))
+ (enlarge-window (- (+ sum mes) whi)))))
+ (split-window (get-buffer-window (current-buffer)) sum)
+ (other-window 1)))
(switch-to-buffer buffer)))
-;;
-;; called by wl-summary-mode buffer
-;;
-(defvar wl-message-func-called-hook nil)
-
-(defun wl-message-scroll-down (amount)
- (let ((view-message-buffer (get-buffer-create wl-message-buf-name))
- (cur-buf (current-buffer)))
- (wl-select-buffer view-message-buffer)
- (if (bobp)
- ()
- (scroll-down))
- (select-window (get-buffer-window cur-buf))))
-
-(defun wl-message-scroll-up (amount)
- (let ((view-message-buffer (get-buffer-create wl-message-buf-name))
- (cur-buf (current-buffer)))
- (wl-select-buffer view-message-buffer)
- (save-excursion
- (save-restriction
- (widen)
- (forward-page 1)
- (if (pos-visible-in-window-p (point))
- (wl-message-narrow-to-page 1)))) ; Go to next page.
- (if (eobp)
- ()
- (scroll-up))
- (select-window (get-buffer-window cur-buf))))
-
+(defun wl-message-narrow-to-page (&optional arg)
+ "Narrow to page.
+If ARG is specified, narrow to ARGth page."
+ (interactive "P")
+ (setq arg (if arg (prefix-numeric-value arg) 0))
+ (save-excursion
+ (condition-case ()
+ (forward-page -1) ; Beginning of current page.
+ (beginning-of-buffer
+ (goto-char (point-min))))
+ (forward-char 1) ; for compatibility with emacs-19.28 and emacs-19.29
+ (widen)
+ (cond
+ ((> arg 0) (forward-page arg))
+ ((< arg 0) (forward-page (1- arg))))
+ (forward-page)
+ (if wl-break-pages
+ (narrow-to-region (point)
+ (progn
+ (forward-page -1)
+ (if (and (eolp) (not (bobp)))
+ (forward-line))
+ (point))))))
+
+(defun wl-message-prev-page (&optional lines)
+ "Scroll down current message by LINES.
+Returns non-nil if top of message."
+ (interactive)
+ (if (buffer-live-p wl-message-buffer)
+ (let ((cur-buf (current-buffer))
+ top)
+ (wl-message-select-buffer wl-message-buffer)
+ (move-to-window-line 0)
+ (if (and wl-break-pages
+ (bobp)
+ (not (save-restriction (widen) (bobp))))
+ (progn
+ (wl-message-narrow-to-page -1)
+ (goto-char (point-max))
+ (recenter -1))
+ (if (not (bobp))
+ (condition-case nil
+ (scroll-down lines)
+ (error))
+ (setq top t)))
+ (select-window (get-buffer-window cur-buf))
+ top)))
+
+(defun wl-message-next-page (&optional lines)
+ "Scroll up current message by LINES.
+Returns non-nil if bottom of message."
+ (interactive)
+ (if (buffer-live-p wl-message-buffer)
+ (let ((cur-buf (current-buffer))
+ bottom)
+ (wl-message-select-buffer wl-message-buffer)
+ (move-to-window-line -1)
+ (if (save-excursion
+ (end-of-line)
+ (and (pos-visible-in-window-p)
+ (eobp)))
+ (if (or (null wl-break-pages)
+ (save-excursion
+ (save-restriction
+ (widen) (forward-line) (eobp))))
+ (setq bottom t)
+ (wl-message-narrow-to-page 1)
+ (setq bottom nil))
+ (condition-case ()
+ (static-if (boundp 'window-pixel-scroll-increment)
+ ;; XEmacs 21.2.20 and later.
+ (let (window-pixel-scroll-increment)
+ (scroll-up lines))
+ (scroll-up lines))
+ (end-of-buffer
+ (goto-char (point-max))))
+ (setq bottom nil))
+ (select-window (get-buffer-window cur-buf))
+ bottom)))
+
+
(defun wl-message-follow-current-entity (buffer)
"Follow to current message."
(wl-draft-reply (wl-message-get-original-buffer)
(let ((mail-reply-buffer buffer))
(wl-draft-yank-from-mail-reply-buffer nil)))
-(defun wl-message-original-mode ()
- (setq major-mode 'wl-message-original-mode)
- (setq mode-name "Original")
- (setq buffer-read-only t)
- (if (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system wl-cs-noconv)))
+;;
(defun wl-message-mode ()
+ "A major mode for message displaying."
(interactive)
(setq major-mode 'wl-message-mode)
(setq buffer-read-only t)
(setq mode-name "Message"))
-(defun wl-message-get-buffer-create ()
- (let ((buf-name wl-message-buf-name))
- (or (get-buffer buf-name)
- (save-excursion
- (set-buffer (get-buffer-create buf-name))
- (wl-message-mode)
- (run-hooks 'wl-message-buffer-created-hook)
- (get-buffer buf-name)))))
-
-(defun wl-message-original-get-buffer-create ()
- (or (get-buffer wl-original-buf-name)
- (save-excursion
- (set-buffer (get-buffer-create wl-original-buf-name))
- (wl-message-original-mode)
- (get-buffer wl-original-buf-name))))
-
(defun wl-message-exit ()
+ "Move to summary buffer."
(interactive)
(let (summary-buf summary-win)
(if (setq summary-buf wl-message-buffer-cur-summary-buffer)
(if (setq summary-win (get-buffer-window summary-buf))
(select-window summary-win)
(switch-to-buffer summary-buf)
- (wl-select-buffer wl-message-buf-name)
+ (wl-message-select-buffer wl-message-buffer)
(select-window (get-buffer-window summary-buf))))
(run-hooks 'wl-message-exit-hook)))
-(defvar wl-message-mode-map nil)
-(if wl-message-mode-map
- ()
- (setq wl-message-mode-map (make-sparse-keymap))
- (define-key wl-message-mode-map "q" 'wl-message-exit)
- (define-key wl-message-mode-map "n" 'wl-message-exit)
- (define-key wl-message-mode-map "p" 'wl-message-exit))
-
-(defun wl-message-decode (outbuf inbuf flag)
- (cond
- ((eq flag 'all-header)
- (save-excursion
- (set-buffer inbuf)
- (let ((buffer-read-only nil))
- (decode-mime-charset-region (point-min)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "^$" nil t)
- (point))
- wl-mime-charset)))
- (wl-message-decode-with-all-header outbuf inbuf))
- ((eq flag 'no-mime)
- (save-excursion
- (set-buffer inbuf)
- (let ((buffer-read-only nil))
- (save-excursion
- (set-buffer outbuf)
- (elmo-set-buffer-multibyte nil))
- (copy-to-buffer outbuf (point-min) (point-max))
- (set-buffer outbuf)
- (use-local-map wl-message-mode-map)
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
-;;; (decode-mime-charset-region (point-min) (point-max) wl-mime-charset)
- ;; we can call decode-coding-region() directly, because multibyte flag is t.
- (decode-coding-region (point-min) (point-max) wl-cs-autoconv)
- (wl-highlight-message (point-min)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "^$" nil t)) nil))))
- (t ; normal
- (save-excursion
- (set-buffer inbuf)
- (let ((buffer-read-only nil))
- (decode-mime-charset-region (point-min)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "^$" nil t)
- (point))
- wl-mime-charset)))
- (wl-message-decode-mode outbuf inbuf))))
-
-(defun wl-message-prev-page (&optional lines)
- "Scroll down this message. Returns non-nil if top of message."
- (interactive)
- (let ((cur-buf (current-buffer))
- (view-message-buffer (get-buffer-create wl-message-buf-name))
- ret-val)
- (wl-select-buffer view-message-buffer)
- (move-to-window-line 0)
- (if (and wl-break-pages
- (bobp)
- (not (save-restriction (widen) (bobp))))
- (progn
- (wl-message-narrow-to-page -1)
- (goto-char (point-max))
- (recenter -1))
- (if (not (bobp))
- (scroll-down lines)
- (setq ret-val t)))
- (select-window (get-buffer-window cur-buf))
- ret-val))
-
-(static-if (fboundp 'luna-make-entity)
- (defsubst wl-message-make-mime-entity (backend number backend folder msgdb)
- (luna-make-entity (mm-expand-class-name 'elmo)
- :location (get-buffer-create
- (concat mmelmo-entity-buffer-name "0"))
- :imap (eq backend 'elmo-imap4)
- :folder folder
- :number number
- :msgdb msgdb :size 0))
- (defsubst wl-message-make-mime-entity (backend number backend folder msgdb)
- (mime-open-entity backend (list folder number msgdb nil))))
-
-(defun wl-message-next-page (&optional lines)
- "Scroll up this message. Returns non-nil if bottom of message."
- (interactive)
- (let ((cur-buf (current-buffer))
- (view-message-buffer (get-buffer-create wl-message-buf-name))
- ret-val)
- (wl-select-buffer view-message-buffer)
- (move-to-window-line -1)
- (if (save-excursion
- (end-of-line)
- (and (pos-visible-in-window-p)
- (eobp)))
- (if (or (null wl-break-pages)
- (save-excursion
- (save-restriction
- (widen) (forward-line) (eobp))))
- (setq ret-val t)
- (wl-message-narrow-to-page 1)
- (setq ret-val nil))
- (condition-case ()
- (static-if (boundp 'window-pixel-scroll-increment)
- ;; XEmacs 21.2.20 and later.
- (let (window-pixel-scroll-increment)
- (scroll-up lines))
- (scroll-up lines))
- (end-of-buffer
- (goto-char (point-max))))
- (setq ret-val nil))
- (select-window (get-buffer-window cur-buf))
- ret-val
- ))
-
-(defun wl-message-narrow-to-page (&optional arg)
- (interactive "P")
- (setq arg (if arg (prefix-numeric-value arg) 0))
- (save-excursion
- (condition-case ()
- (forward-page -1) ; Beginning of current page.
- (beginning-of-buffer
- (goto-char (point-min))))
- (forward-char 1) ; for compatibility with emacs-19.28 and emacs-19.29
- (widen)
- (cond
- ((> arg 0) (forward-page arg))
- ((< arg 0) (forward-page (1- arg))))
- (forward-page)
- (if wl-break-pages
- (narrow-to-region (point)
- (progn
- (forward-page -1)
- (if (and (eolp) (not (bobp)))
- (forward-line))
- (point)))) ))
-
(defun wl-message-toggle-disp-summary ()
(interactive)
(let ((summary-buf (get-buffer wl-message-buffer-cur-summary-buffer))
(if (setq summary-win (get-buffer-window summary-buf))
(delete-window summary-win)
(switch-to-buffer summary-buf)
- (wl-select-buffer wl-message-buf-name))
+ (wl-message-select-buffer wl-message-buffer))
(wl-summary-goto-folder-subr wl-message-buffer-cur-folder 'no-sync
nil nil t)
; no summary-buf
(let ((sum-buf (current-buffer)))
- (wl-select-buffer wl-message-buf-name)
+ (wl-message-select-buffer wl-message-buffer)
(setq wl-message-buffer-cur-summary-buffer sum-buf)))))
-(defun wl-message-normal-get-original-buffer ()
- (let ((ret-val (get-buffer wl-original-buf-name)))
- (if (not ret-val)
- (save-excursion
- (set-buffer (setq ret-val
- (get-buffer-create wl-original-buf-name)))
- (wl-message-original-mode)))
- ret-val))
-
-
-(if wl-use-semi
- (defalias 'wl-message-get-original-buffer
- 'mmelmo-get-original-buffer)
- (defalias 'wl-message-get-original-buffer
- 'wl-message-normal-get-original-buffer))
-
-(defvar wl-message-redisplay-func 'wl-normal-message-redisplay)
-(defvar wl-message-cache-used nil) ;whether cache is used or not.
-
-(defun wl-message-redisplay (folder number flag msgdb &optional force-reload)
- (let ((default-mime-charset wl-mime-charset)
- (buffer-read-only nil))
- (setq wl-message-cache-used nil)
- (if wl-message-redisplay-func
- (funcall wl-message-redisplay-func
- folder number flag msgdb force-reload))))
-
-;; nil means don't fetch all.
-(defun wl-message-decide-backend (folder number message-id size)
- (let ((dont-do-that (and
- (not (setq wl-message-cache-used
- (or
- (elmo-buffer-cache-hit
- (list folder number message-id))
- (elmo-cache-exists-p message-id
- folder number))))
- (integerp size)
- (not (elmo-local-file-p folder number))
- wl-fetch-confirm-threshold
- (>= size wl-fetch-confirm-threshold)
- (not (y-or-n-p
- (format "Fetch entire message? (%dbytes)"
- size))))))
- (message "")
- (cond ((and dont-do-that
- (eq (elmo-folder-number-get-type folder number) 'imap4)
- (not (and (elmo-use-cache-p folder number)
- (elmo-cache-exists-p message-id folder number))))
- 'elmo-imap4)
- (t (if (not dont-do-that) 'elmo)))))
-
-(defmacro wl-message-original-buffer-folder ()
- wl-original-buffer-cur-folder)
-
-(defmacro wl-message-original-buffer-number ()
- wl-original-buffer-cur-number)
-
-(defun wl-message-set-original-buffer-information (folder number)
- (when (or (not (string= folder (or wl-original-buffer-cur-folder "")))
- (not (eq number (or wl-original-buffer-cur-number 0))))
- (setq wl-original-buffer-cur-folder folder)
- (setq wl-original-buffer-cur-number number)))
-
-;; Works on FLIM-1.9.0/SEMI-1.8.2 or later (maybe).
-(defun wl-mmelmo-message-redisplay (folder number flag msgdb
- &optional force-reload)
- (let* ((cur-buf (current-buffer))
- (view-message-buffer (wl-message-get-buffer-create))
- (message-id (cdr (assq number
- (elmo-msgdb-get-number-alist msgdb))))
- (size (elmo-msgdb-overview-entity-get-size
- (elmo-msgdb-overview-get-entity number msgdb)))
- (backend (wl-message-decide-backend folder number message-id size))
- cur-entity ret-val header-end real-fld-num summary-win)
- (require 'mmelmo)
- (wl-select-buffer view-message-buffer)
- (set-buffer view-message-buffer)
- (unwind-protect
- (progn
- (setq wl-message-buffer-cur-summary-buffer cur-buf)
- (setq wl-message-buffer-cur-folder folder)
- (setq wl-message-buffer-cur-number number)
- (setq buffer-read-only nil)
- (erase-buffer)
- (if backend
- (let (mime-display-header-hook ;; bind to nil...
- (wl-message-ignored-field-list
- (if (eq flag 'all-header)
- nil
- wl-message-ignored-field-list))
- (mmelmo-force-reload force-reload)
- (mmelmo-imap4-threshold wl-fetch-confirm-threshold))
- (setq real-fld-num (elmo-get-real-folder-number
- folder number))
- (setq cur-entity
- (wl-message-make-mime-entity
- backend
- (if (eq backend 'elmo-imap4)
- (cdr real-fld-num)
- number)
- backend
- (if (eq backend 'elmo-imap4)
- (car real-fld-num)
- folder)
- msgdb))
- (setq mmelmo-imap4-skipped-parts nil)
- ;; mime-display-message sets buffer-read-only variable as t.
- ;; which makes buffer read-only status confused...
- (mime-display-message cur-entity view-message-buffer
- nil nil 'mmelmo-original-mode)
- (if mmelmo-imap4-skipped-parts
- (progn
- (message "Skipped fetching of %s."
- (mapconcat
- (lambda (x)
- (format "[%s]" x))
- mmelmo-imap4-skipped-parts ","))))
- (if (and (eq backend 'elmo-imap4)
- (null mmelmo-imap4-skipped-parts))
- (message "No required part was skipped."))
- (setq ret-val (not (eq backend 'elmo-imap4))))
- (message "Skipped fetching.")
- (setq ret-val nil)))
- (setq buffer-read-only nil)
- (wl-message-set-original-buffer-information folder number)
- (wl-message-overload-functions)
- ;; highlight body
- (when wl-highlight-body-too
- (wl-highlight-body))
- (condition-case ()
- (wl-message-narrow-to-page)
- (error nil));; ignore errors.
- (setq mode-line-buffer-identification
- (format "Wanderlust: << %s / %s >>"
- (if (memq 'modeline wl-use-folder-petname)
- (wl-folder-get-petname folder)
- folder) number))
- (goto-char (point-min))
- (unwind-protect
- (save-excursion
- (run-hooks 'wl-message-redisplay-hook))
- ;; go back to summary mode
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (set-buffer cur-buf)
- (setq summary-win (get-buffer-window cur-buf))
- (if (window-live-p summary-win)
- (select-window summary-win))))
- ret-val
- ))
-
-(defun wl-normal-message-redisplay (folder number flag msgdb
- &optional force-reload)
- (interactive)
- (let* ((cur-buf (current-buffer))
- (original-message-buffer (wl-message-get-original-buffer))
- (view-message-buffer (wl-message-get-buffer-create))
- (message-id (cdr (assq number
- (elmo-msgdb-get-number-alist msgdb))))
- (size (elmo-msgdb-overview-entity-get-size
- (elmo-msgdb-overview-get-entity number msgdb)))
- header-end ret-val summary-win)
- (wl-select-buffer view-message-buffer)
+(defun wl-message-get-original-buffer ()
+ "Get original buffer for current message buffer."
+ (current-buffer)
+ wl-message-buffer-original-buffer)
+
+(defun wl-message-redisplay (folder number flag &optional force-reload)
+ (let* ((default-mime-charset wl-mime-charset)
+ (buffer-read-only nil)
+ (summary-buf (current-buffer))
+ message-buf
+ strategy entity
+ cache-used
+ header-end real-fld-num summary-win)
+ (setq buffer-read-only nil)
+ (setq cache-used (wl-message-buffer-display
+ folder number flag force-reload))
+ (setq wl-message-buffer (car cache-used))
+ (setq message-buf wl-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
+
+ (set-buffer message-buf)
+ (setq buffer-read-only nil)
+ (setq wl-message-buffer-cur-summary-buffer summary-buf)
+ (setq wl-message-buffer-cur-folder (elmo-folder-name-internal folder))
+ (setq wl-message-buffer-cur-number number)
+ (wl-message-overload-functions)
+ (setq mode-line-buffer-identification
+ (format "Wanderlust: << %s / %s >>"
+ (if (memq 'modeline wl-use-folder-petname)
+ (wl-folder-get-petname (elmo-folder-name-internal
+ folder))
+ (elmo-folder-name-internal folder)) number))
+ ;; highlight body
+; (when wl-highlight-body-too
+; (wl-highlight-body))
+ (condition-case ()
+ (wl-message-narrow-to-page)
+ (error nil)); ignore errors.
+ (setq cache-used (cdr cache-used))
+ (goto-char (point-min))
(unwind-protect
+ (save-excursion
+ (run-hooks 'wl-message-redisplay-hook))
+ ;; go back to summary mode
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (set-buffer summary-buf)
+ (setq summary-win (get-buffer-window summary-buf))
+ (if (window-live-p summary-win)
+ (select-window summary-win)))
+ cache-used))
+
+;; Use message buffer cache.
+(defun wl-message-buffer-display (folder number flag &optional force-reload)
+ (let* ((msg-id (elmo-message-field folder number 'message-id))
+ (fname (elmo-folder-name-internal folder))
+ (hit (wl-message-buffer-cache-hit (list fname number msg-id)))
+ (read nil)
+ cache-used)
+ (when (and hit (not (buffer-live-p hit)))
+ (wl-message-buffer-cache-delete (list fname number msg-id))
+ (setq hit nil))
+ (if hit
(progn
- (setq wl-message-buffer-cur-summary-buffer cur-buf)
- (setq wl-message-buffer-cur-folder folder)
- (setq wl-message-buffer-cur-number number)
- (setq buffer-read-only nil)
- (erase-buffer)
- (if (or (eq (elmo-folder-number-get-type folder number) 'localdir)
- (not (and (integerp size)
- wl-fetch-confirm-threshold
- (>= size wl-fetch-confirm-threshold)
- (not (elmo-cache-exists-p message-id
- folder number))
- (not (y-or-n-p
- (format "Fetch entire message? (%dbytes)"
- size))))))
- (progn
- (save-excursion
- (set-buffer original-message-buffer)
- (let ((buffer-read-only nil))
- (elmo-read-msg-with-buffer-cache
- folder number original-message-buffer msgdb force-reload)))
- ;; decode MIME message.
- (wl-message-decode
- view-message-buffer
- original-message-buffer flag)
- (setq ret-val t))
+ ;; move hit to the top.
+ (wl-message-buffer-cache-sort
+ (wl-message-buffer-cache-entry-make (list fname number msg-id) hit))
+ ;; buffer cache is used.
+ (setq cache-used t)
+ (with-current-buffer hit
+ (unless (eq wl-message-buffer-cur-flag flag)
+ (setq read t))))
+ ;; delete tail and add new to the top.
+ (setq hit (wl-message-buffer-cache-add (list fname number msg-id)))
+ (setq read t))
+ (if (or force-reload read)
+ ;(condition-case err
(save-excursion
- (set-buffer view-message-buffer)
- (insert "\n\n"))))
- (setq buffer-read-only nil)
- (wl-message-set-original-buffer-information folder number)
- (wl-message-overload-functions)
- ;; highlight body
- (and wl-highlight-body-too (wl-highlight-body))
- (condition-case ()
- (wl-message-narrow-to-page)
- (error nil)) ; ignore errors.
- (setq mode-line-buffer-identification
- (format "Wanderlust: << %s / %s >>"
- (if (memq 'modeline wl-use-folder-petname)
- (wl-folder-get-petname folder)
- folder)
- number))
- (goto-char (point-min))
- (unwind-protect
- (run-hooks 'wl-message-redisplay-hook)
- ;; go back to summary mode
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (set-buffer cur-buf)
- (setq summary-win (get-buffer-window cur-buf))
- (if (window-live-p summary-win)
- (select-window summary-win)))
- ret-val
- )))
+ (set-buffer hit)
+ (setq
+ cache-used
+ (wl-message-display-internal folder number flag force-reload))
+ (setq wl-message-buffer-cur-flag flag))
+; (quit
+; (wl-message-buffer-cache-delete)
+; (error "Display message %s/%s is quitted" fname number))
+; (error
+; (wl-message-buffer-cache-delete)
+; (signal (car err) (cdr err))
+; nil))) ;; will not be used
+ )
+ (cons hit cache-used)))
+
+(defun wl-message-display-internal (folder number flag &optional force-reload)
+ (let ((elmo-message-ignored-field-list
+ (if (eq flag 'all-header)
+ nil
+ wl-message-ignored-field-list))
+ (elmo-message-visible-field-list wl-message-visible-field-list)
+ (elmo-message-sorted-field-list wl-message-sort-field-list)
+ (elmo-fetch-threshold wl-fetch-confirm-threshold))
+ (prog1
+ (if (eq flag 'as-is)
+ (let (wl-highlight-x-face-func)
+ (elmo-mime-display-as-is folder number
+ (current-buffer)
+ (wl-message-get-original-buffer)
+ 'wl-original-message-mode
+ force-reload))
+ (elmo-mime-message-display folder number
+ (current-buffer)
+ (wl-message-get-original-buffer)
+ 'wl-original-message-mode
+ force-reload))
+ (setq buffer-read-only t))))
+
+(defsubst wl-message-buffer-prefetch-p (folder &optional number)
+ (cond
+ ((eq wl-message-buffer-prefetch-folder-type-list t)
+ t)
+ ((and number wl-message-buffer-prefetch-folder-type-list)
+ (memq (elmo-folder-type-internal
+ (elmo-message-folder folder number))
+ wl-message-buffer-prefetch-folder-type-list))
+ (wl-message-buffer-prefetch-folder-type-list
+ (let ((list wl-message-buffer-prefetch-folder-type-list)
+ type)
+ (catch 'done
+ (while (setq type (pop list))
+ (if (elmo-folder-contains-type folder type)
+ (throw 'done t))))))
+ ((consp wl-message-buffer-prefetch-folder-type-list)
+ (wl-string-match-member (elmo-folder-name-internal folder)
+ wl-message-buffer-prefetch-folder-type-list))
+ (t wl-message-buffer-prefetch-folder-type-list)))
+
+(defun wl-message-buffer-prefetch-next (folder number &optional
+ summary charset)
+ (if (wl-message-buffer-prefetch-p folder)
+ (with-current-buffer (or summary (get-buffer wl-summary-buffer-name))
+ (let* ((next (funcall wl-message-buffer-prefetch-get-next-func
+ number)))
+ (when (and next (wl-message-buffer-prefetch-p folder next))
+ (if (not (fboundp 'run-with-idle-timer))
+ (when (sit-for wl-message-buffer-prefetch-idle-time)
+ (wl-message-buffer-prefetch folder next summary charset))
+ (run-with-idle-timer
+ wl-message-buffer-prefetch-idle-time
+ nil
+ 'wl-message-buffer-prefetch folder next summary charset)
+ (sit-for 0)))))))
+
+(defun wl-message-buffer-prefetch (folder number summary charset)
+ (when (buffer-live-p summary)
+ (save-excursion
+ (set-buffer summary)
+ (when (string= (elmo-folder-name-internal folder)
+ (wl-summary-buffer-folder-name))
+ (let ((message-id (elmo-message-field folder number 'message-id))
+ (wl-mime-charset charset)
+ (default-mime-charset charset)
+ result time1 time2 sec micro)
+ (if (not (wl-message-buffer-cache-hit (list folder
+ number message-id)))
+ (let* ((size (elmo-message-field folder number 'size)))
+ (when (or (elmo-message-file-p folder number)
+ (not
+ (and (integerp size)
+ wl-message-buffer-prefetch-threshold
+ (>= size
+ wl-message-buffer-prefetch-threshold))))
+ ;;(not (elmo-file-cache-exists-p message-id)))))
+ (when wl-message-buffer-prefetch-debug
+ (setq time1 (current-time))
+ (message "Prefetching %d..." number))
+ (setq result (wl-message-buffer-display folder number 'mime))
+ (when wl-message-buffer-prefetch-debug
+ (setq time2 (current-time))
+ (setq sec (- (nth 1 time2)(nth 1 time1)))
+ (setq micro (- (nth 2 time2)(nth 2 time1)))
+ (setq micro (+ micro (* 1000000 sec)))
+ (message "Prefetching %d...done(%f msec)."
+ number
+ (/ micro 1000.0)))))))))))
(defvar wl-message-button-map (make-sparse-keymap))
By setting following-method as yank-content."
(let ((wl-draft-buffer (current-buffer))
(mime-view-following-method-alist
- (list (cons 'mmelmo-original-mode
+ (list (cons 'wl-original-message-mode
(function wl-draft-yank-to-draft-buffer))))
(mime-preview-following-method-alist
- (list (cons 'mmelmo-original-mode
+ (list (cons 'wl-original-message-mode
(function wl-draft-yank-to-draft-buffer)))))
(if (get-buffer (wl-current-message-buffer))
(save-excursion
(defun wl-message-request-partial (folder number)
(elmo-set-work-buf
- (elmo-read-msg-no-cache folder number (current-buffer))
-;;;(mime-parse-buffer nil 'mime-buffer-entity)
+ (elmo-message-fetch (wl-folder-get-elmo-folder folder)
+ number
+ (elmo-make-fetch-strategy 'entire)
+ nil
+ (current-buffer)
+ 'unread)
(mime-parse-buffer nil)))
(defalias 'wl-message-read 'mime-preview-scroll-up-entity)
(message (format "Bursting...%s" (setq number (+ 1 number))))
(setq message-entity
(car (mime-entity-children (car children))))
- (elmo-append-msg target
- (mime-entity-body (car children))
- (mime-entity-fetch-field message-entity
- "Message-ID"))))
+ (with-temp-buffer
+ (insert (mime-entity-body (car children)))
+ (elmo-folder-append-buffer
+ target
+ (mime-entity-fetch-field message-entity
+ "Message-ID")))))
(setq children (cdr children)))
number))
(let ((raw-buf (wl-message-get-original-buffer))
children message-entity content-type target)
(save-excursion
- (setq target wl-summary-buffer-folder-name)
- (while (not (elmo-folder-writable-p target))
+ (setq target wl-summary-buffer-elmo-folder)
+ (while (not (elmo-folder-message-appendable-p target))
(setq target
(wl-summary-read-folder wl-default-folder "to extract to")))
(wl-summary-set-message-buffer-or-redisplay)
(save-excursion
- (set-buffer (get-buffer wl-message-buf-name))
+ (set-buffer (get-buffer wl-message-buffer))
(setq message-entity (get-text-property (point-min) 'mime-view-entity)))
(set-buffer raw-buf)
(setq children (mime-entity-children message-entity))
(wl-summary-burst-subr children target 0)
(message "Bursting...done"))
(if (elmo-folder-plugged-p target)
- (elmo-commit target)))
- (wl-summary-sync-update3)))
+ (elmo-folder-check target)))
+ (wl-summary-sync-update)))
;; internal variable.
(defvar wl-mime-save-dir nil "Last saved directory.")
(interactive)
(let* ((msgdb (save-excursion
(set-buffer wl-message-buffer-cur-summary-buffer)
- wl-summary-buffer-msgdb))
+ (wl-summary-buffer-msgdb)))
(mime-display-header-hook 'wl-highlight-headers)
(folder wl-message-buffer-cur-folder)
(id (or (cdr (assoc "id" situation)) ""))
(mother (current-buffer))
+ (summary-buf wl-message-buffer-cur-summary-buffer)
subject-id overviews
(root-dir (expand-file-name
(concat "m-prts-" (user-login-name))
temporary-file-directory))
- full-file)
+ full-file point)
(setq root-dir (concat root-dir "/" (replace-as-filename id)))
(setq full-file (concat root-dir "/FULL"))
(if (or (file-exists-p full-file)
(not (y-or-n-p "Merge partials? ")))
(with-current-buffer mother
- (mime-store-message/partial-piece entity situation))
+ (mime-store-message/partial-piece entity situation)
+ (setq wl-message-buffer-cur-summary-buffer summary-buf)
+ (make-variable-buffer-local 'mime-preview-over-to-next-method-alist)
+ (setq mime-preview-over-to-next-method-alist
+ (cons (cons 'mime-show-message-mode 'wl-message-exit)
+ mime-preview-over-to-next-method-alist))
+ (make-variable-buffer-local 'mime-preview-over-to-previous-method-alist)
+ (setq mime-preview-over-to-previous-method-alist
+ (cons (cons 'mime-show-message-mode 'wl-message-exit)
+ mime-preview-over-to-previous-method-alist)))
(setq subject-id
(eword-decode-string
(decode-mime-charset-string
;; request message at the cursor in Subject buffer.
(wl-message-request-partial
folder
- (elmo-msgdb-overview-entity-get-number (car overviews))))
+ (elmo-msgdb-overview-entity-get-number
+ (car overviews))))
(situation (mime-entity-situation message))
(the-id (or (cdr (assoc "id" situation)) "")))
(when (string= (downcase the-id)
;;; Setup methods.
(defun wl-mime-setup ()
(set-alist 'mime-preview-quitting-method-alist
- 'mmelmo-original-mode 'wl-message-exit)
+ 'wl-original-message-mode 'wl-message-exit)
(set-alist 'mime-view-over-to-previous-method-alist
- 'mmelmo-original-mode 'wl-message-exit)
+ 'wl-original-message-mode 'wl-message-exit)
(set-alist 'mime-view-over-to-next-method-alist
- 'mmelmo-original-mode 'wl-message-exit)
+ 'wl-original-message-mode 'wl-message-exit)
(set-alist 'mime-preview-over-to-previous-method-alist
- 'mmelmo-original-mode 'wl-message-exit)
+ 'wl-original-message-mode 'wl-message-exit)
(set-alist 'mime-preview-over-to-next-method-alist
- 'mmelmo-original-mode 'wl-message-exit)
+ 'wl-original-message-mode 'wl-message-exit)
(add-hook 'wl-summary-redisplay-hook 'wl-message-delete-mime-out-buf)
(add-hook 'wl-message-exit-hook 'wl-message-delete-mime-out-buf)
'((type . message) (subtype . partial)
(method . wl-mime-combine-message/partial-pieces)
(request-partial-message-method . wl-message-request-partial)
- (major-mode . mmelmo-original-mode)))
+ (major-mode . wl-original-message-mode)))
(ctree-set-calist-strictly
'mime-acting-condition
'((mode . "extract")
- (major-mode . mmelmo-original-mode)
+ (major-mode . wl-original-message-mode)
(method . wl-mime-save-content)))
(set-alist 'mime-preview-following-method-alist
- 'mmelmo-original-mode
+ 'wl-original-message-mode
(function wl-message-follow-current-entity))
(set-alist 'mime-view-following-method-alist
- 'mmelmo-original-mode
+ 'wl-original-message-mode
(function wl-message-follow-current-entity))
(set-alist 'mime-edit-message-inserter-alist
'wl-draft-mode (function wl-draft-insert-current-message))
'wl-draft-mode
(cdr (assq 'mail-mode mime-edit-split-message-sender-alist)))
(set-alist 'mime-raw-representation-type-alist
- 'mmelmo-original-mode 'binary)
+ 'wl-original-message-mode 'binary)
;; Sort and highlight header fields.
(or wl-message-ignored-field-list
(setq wl-message-ignored-field-list
(setq wl-message-visible-field-list
mime-view-visible-field-list))
(set-alist 'mime-header-presentation-method-alist
- 'mmelmo-original-mode
- (function wl-mime-header-presentation-method))
- (add-hook 'mmelmo-entity-content-inserted-hook 'wl-highlight-body))
+ 'wl-original-message-mode
+ (function elmo-mime-insert-header))
+ (add-hook 'elmo-message-text-content-inserted-hook 'wl-highlight-body-all)
+ (add-hook 'elmo-message-header-inserted-hook 'wl-highlight-headers))
+
(require 'product)
(defun wl-score-get-score-alist (&optional folder)
(interactive)
- (let* ((fld (or folder wl-summary-buffer-folder-name))
+ (let* ((fld (or folder (wl-summary-buffer-folder-name)))
(score-alist (reverse
(wl-score-get-score-files wl-score-folder-alist fld)))
alist scores)
(expire (and wl-score-expiry-days
(- now wl-score-expiry-days)))
(overview (elmo-msgdb-get-overview
- (or msgdb wl-summary-buffer-msgdb)))
+ (or msgdb (wl-summary-buffer-msgdb))))
(mark-alist (elmo-msgdb-get-mark-alist
- (or msgdb wl-summary-buffer-msgdb)))
+ (or msgdb (wl-summary-buffer-msgdb))))
(wl-score-stop-add-entry not-add)
entries
news new num entry ov header)
(expire (and wl-score-expiry-days
(- now wl-score-expiry-days)))
(roverview (reverse (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
msgs)
(if (not expire)
(mapcar 'car (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)) ;; all messages
+ (wl-summary-buffer-msgdb))) ;; all messages
(catch 'break
(while roverview
(if (< (wl-day-number
(let ((num (wl-summary-message-number)))
(if num
(assoc (cdr (assq num (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
- (elmo-msgdb-get-overview wl-summary-buffer-msgdb)))))
+ (wl-summary-buffer-msgdb))))
+ (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))))))
(defun wl-score-get-header (header &optional extra)
(let ((index (nth 2 (assoc header wl-score-header-index)))
(setq alist (cdr alist))
(setq i (1+ i))
(set-buffer-modified-p nil)))
- (when (and (get-buffer wl-message-buf-name)
+ (when (and (get-buffer wl-message-buffer)
(setq mes-win (get-buffer-window
- (get-buffer wl-message-buf-name))))
+ (get-buffer wl-message-buffer))))
(select-window mes-win)
(unless (eq (next-window) cur-win)
(delete-window (next-window))))
(wl-score-save)
(setq wl-score-cache nil)
(setq wl-summary-scored nil)
- (setq number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- (wl-summary-score-headers nil wl-summary-buffer-msgdb
+ (setq number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))
+ (wl-summary-score-headers nil (wl-summary-buffer-msgdb)
(unless arg
(wl-summary-rescore-msgs number-alist)))
(setq expunged (wl-summary-score-update-all-lines t))
(defun wl-summary-score-headers (&optional folder msgdb force-msgs not-add)
"Do scoring if scoring is required."
(let ((scores (wl-score-get-score-alist
- (or folder wl-summary-buffer-folder-name))))
+ (or folder (wl-summary-buffer-folder-name)))))
(when scores
(wl-score-headers scores msgdb force-msgs not-add))))
(defun wl-summary-score-update-all-lines (&optional update)
(let* ((alist wl-summary-scored)
(count (length alist))
- (folder wl-summary-buffer-folder-name)
(i 0)
(update-unread nil)
num score dels visible score-mark mark-alist)
score (cdar alist))
(when wl-score-debug
(message "Scored %d with %d" score num)
- (wl-push (list (elmo-string wl-summary-buffer-folder-name) num score)
+ (wl-push (list (elmo-string (wl-summary-buffer-folder-name)) num score)
wl-score-trace))
(setq score-mark (wl-summary-get-score-mark num))
(and (setq visible (wl-summary-jump-to-msg num))
(/ (* i 100) count))))
(when dels
(setq mark-alist
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(let ((marks dels))
(while marks
(setq mark-alist
(elmo-msgdb-mark-set mark-alist (pop marks) nil))))
- (elmo-mark-as-read wl-summary-buffer-folder-name
- dels wl-summary-buffer-msgdb)
- (elmo-msgdb-set-mark-alist wl-summary-buffer-msgdb mark-alist)
+ (elmo-folder-mark-as-read wl-summary-buffer-elmo-folder
+ dels)
+ (elmo-msgdb-set-mark-alist (wl-summary-buffer-msgdb) mark-alist)
(wl-summary-delete-messages-on-buffer dels))
(when (and update update-unread)
(let ((num-db (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))
+ (wl-summary-buffer-msgdb)))
(mark-alist (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
;; Update Folder mode
- (wl-folder-set-folder-updated wl-summary-buffer-folder-name
+ (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
(list 0
(wl-summary-count-unread
mark-alist)
(find-file-noselect file)))
(sum-buf (current-buffer)))
(if (string-match (concat "^" wl-summary-buffer-name) (buffer-name))
- (let ((cur-buf (current-buffer))
- (view-message-buffer (get-buffer wl-message-buf-name)))
- (when view-message-buffer
- (wl-select-buffer view-message-buffer)
+ (let ((cur-buf (current-buffer)))
+ (when wl-message-buffer
+ (wl-message-select-buffer wl-message-buffer)
(delete-window)
(select-window (get-buffer-window cur-buf)))
- (wl-select-buffer edit-buffer))
+ (wl-message-select-buffer edit-buffer))
(switch-to-buffer edit-buffer))
(wl-score-mode)
(setq wl-score-edit-exit-func 'wl-score-edit-done)
;;; Code:
;;
-(require 'elmo2)
+(require 'elmo)
(require 'elmo-multi)
(require 'wl-message)
(require 'wl-vars)
(condition-case nil (require 'timezone) (error nil))
(condition-case nil (require 'easymenu) (error nil))
(require 'elmo-date)
+(require 'elmo-dop)
(condition-case nil (require 'ps-print) (error nil))
(eval-when-compile
(defvar wl-summary-mode-map nil)
(defvar wl-current-summary-buffer nil)
-(defvar wl-summary-buffer-msgdb nil)
-(defvar wl-summary-buffer-folder-name nil)
+;; (defvar wl-summary-buffer-msgdb nil) obsolete.
+;; (defvar wl-summary-buffer-folder-name nil) obsolete.
+(defvar wl-summary-buffer-elmo-folder nil)
+
+(defmacro wl-summary-buffer-folder-name ()
+ (` (and wl-summary-buffer-elmo-folder
+ (elmo-folder-name-internal wl-summary-buffer-elmo-folder))))
+
+(defmacro wl-summary-buffer-msgdb ()
+ (` (and wl-summary-buffer-elmo-folder
+ (elmo-folder-msgdb wl-summary-buffer-elmo-folder))))
+
(defvar wl-summary-buffer-folder-indicator nil)
(defvar wl-summary-buffer-disp-msg nil)
(defvar wl-summary-buffer-disp-folder nil)
(defvar wl-summary-alike-hashtb nil)
(defvar wl-summary-search-buf-name " *wl-search-subject*")
(defvar wl-summary-delayed-update nil)
+(defvar wl-summary-search-buf-folder-name nil)
(defvar wl-summary-get-petname-func 'wl-address-get-petname-1)
(defvar wl-ps-preprint-hook nil)
(defvar wl-ps-print-hook nil)
-(make-variable-buffer-local 'wl-summary-buffer-msgdb)
+(make-variable-buffer-local 'wl-summary-buffer-elmo-folder)
+(make-variable-buffer-local 'wl-summary-search-buf-folder-name)
(make-variable-buffer-local 'wl-summary-buffer-disp-msg)
(make-variable-buffer-local 'wl-summary-buffer-disp-folder)
(make-variable-buffer-local 'wl-summary-buffer-refile-list)
(make-variable-buffer-local 'wl-summary-buffer-copy-list)
(make-variable-buffer-local 'wl-summary-buffer-target-mark-list)
(make-variable-buffer-local 'wl-summary-buffer-delete-list)
-(make-variable-buffer-local 'wl-summary-buffer-folder-name)
(make-variable-buffer-local 'wl-summary-buffer-folder-indicator)
(make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg)
(make-variable-buffer-local 'wl-summary-buffer-unread-status)
(make-variable-buffer-local 'wl-summary-buffer-mime-charset)
(make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang)
(make-variable-buffer-local 'wl-summary-buffer-thread-indent-set)
-(make-variable-buffer-local 'wl-summary-buffer-message-redisplay-func)
(make-variable-buffer-local 'wl-summary-buffer-view)
(make-variable-buffer-local 'wl-summary-buffer-message-modified)
(make-variable-buffer-local 'wl-summary-buffer-mark-modified)
(defun wl-summary-subject-filter-func-internal (subject)
subject))
-(defmacro wl-summary-sticky-buffer-name (folder)
- (` (concat wl-summary-buffer-name ":" (, folder))))
+(defmacro wl-summary-sticky-buffer-name (name)
+ (` (concat wl-summary-buffer-name ":" (, name))))
(defun wl-summary-default-subject (subject-string)
(if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string)
(and (eq major-mode 'wl-summary-mode)
(stringp wl-summary-showto-folder-regexp)
(string-match wl-summary-showto-folder-regexp
- wl-summary-buffer-folder-name)
+ (wl-summary-buffer-folder-name))
(wl-address-user-mail-address-p from)
(cond
((and (setq tos (elmo-msgdb-overview-entity-get-to entity))
(define-key wl-summary-mode-map "\e\r" 'wl-summary-prev-line-content)
(define-key wl-summary-mode-map "g" 'wl-summary-goto-folder)
(define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all)
- (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync)
+; (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync)
(define-key wl-summary-mode-map "a" 'wl-summary-reply)
(define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation)
(setq mark-alist (cdr mark-alist)))
ret-val))
-(defun wl-summary-count-unread (mark-alist &optional folder)
+(defun wl-summary-count-unread (mark-alist)
(let ((new 0)
(unread 0)
mark)
(interactive "P")
(if arg
(wl-summary-supersedes-message)
- (if (string= wl-summary-buffer-folder-name wl-draft-folder)
+ (if (string= (wl-summary-buffer-folder-name) wl-draft-folder)
(if (wl-summary-message-number)
(unwind-protect
(wl-draft-reedit (wl-summary-message-number))
(kill-buffer (current-buffer)))
(message "Resending message to %s...done" address))))
-(defun wl-summary-msgdb-load-async (folder)
- "Loading msgdb and selecting FOLDER is executed asynchronously in IMAP4."
- (if (and (elmo-folder-plugged-p folder)
- (eq (elmo-folder-get-type folder) 'imap4))
- (let ((spec (elmo-folder-get-spec folder))
- session mailbox
- msgdb response tag)
- (unwind-protect
- (progn
- (setq session (elmo-imap4-get-session spec)
- mailbox (elmo-imap4-spec-mailbox spec)
- tag (elmo-imap4-send-command session
- (list "select "
- (elmo-imap4-mailbox
- mailbox))))
- (setq msgdb (elmo-msgdb-load (elmo-string folder)))
- (setq response (elmo-imap4-read-response session tag)))
- (if response
- (elmo-imap4-session-set-current-mailbox-internal session mailbox)
- (and session
- (elmo-imap4-session-set-current-mailbox-internal session nil))
- (message "Select mailbox %s failed" mailbox)))
- msgdb)
- (elmo-msgdb-load (elmo-string folder))))
-
(defun wl-summary-buffer-set-folder (folder)
- (setq wl-summary-buffer-folder-name folder)
+ (if (stringp folder)
+ (setq folder (wl-folder-get-elmo-folder folder)))
+ (setq wl-summary-buffer-elmo-folder folder)
(setq wl-summary-buffer-folder-indicator
(if (memq 'modeline wl-use-folder-petname)
- (wl-folder-get-petname folder)
- folder))
- (when (wl-summary-sticky-p)
- (make-local-variable 'wl-message-buf-name)
- (setq wl-message-buf-name (format "%s:%s" wl-message-buf-name folder)))
+ (wl-folder-get-petname (elmo-folder-name-internal folder))
+ (elmo-folder-name-internal folder)))
+ (make-local-variable 'wl-message-buffer)
(setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value
wl-folder-mime-charset-alist
- folder)
+ (elmo-folder-name-internal folder))
wl-mime-charset))
(setq wl-summary-buffer-weekday-name-lang
(or (wl-get-assoc-list-value
wl-folder-weekday-name-lang-alist
- folder)
+ (elmo-folder-name-internal folder))
wl-summary-weekday-name-lang))
(setq wl-summary-buffer-thread-indent-set
(wl-get-assoc-list-value
wl-folder-thread-indent-set-alist
- folder))
- (setq wl-summary-buffer-persistent (wl-folder-persistent-p folder))
+ (elmo-folder-name-internal folder)))
+ (setq wl-summary-buffer-persistent
+ (wl-folder-persistent-p (elmo-folder-name-internal folder)))
+ (elmo-folder-set-persistent-internal folder wl-summary-buffer-persistent)
(setq
wl-thread-indent-level-internal
(or (nth 0 wl-summary-buffer-thread-indent-set)
;;;(make-local-variable 'tab-width)
;;;(setq tab-width 1)
(buffer-disable-undo (current-buffer))
- (if wl-use-semi
- (setq wl-summary-buffer-message-redisplay-func
- 'wl-mmelmo-message-redisplay)
- (setq wl-summary-buffer-message-redisplay-func
- 'wl-normal-message-redisplay))
(wl-mode-line-buffer-identification '("Wanderlust: "
wl-summary-buffer-folder-indicator
wl-summary-buffer-unread-status))
"Rescan current folder without updating."
(interactive)
(let* ((cur-buf (current-buffer))
- (msgdb wl-summary-buffer-msgdb)
+ (msgdb (wl-summary-buffer-msgdb))
(overview (elmo-msgdb-get-overview msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
(intern (format "wl-summary-overview-entity-compare-by-%s"
sort-by))))
(message "Sorting by %s...done" sort-by)
- (elmo-msgdb-set-overview wl-summary-buffer-msgdb
+ (elmo-msgdb-set-overview (wl-summary-buffer-msgdb)
overview))
(setq curp overview)
(set-buffer cur-buf)
(setq expunged (wl-summary-score-update-all-lines)))
(message "%d message(s) are expunged by scoring." (length expunged))))
(wl-summary-set-message-modified)
- (wl-summary-count-unread mark-alist)
+ (wl-summary-count-unread
+ (elmo-msgdb-get-mark-alist
+ (elmo-folder-msgdb-internal wl-summary-buffer-elmo-folder)))
(wl-summary-update-modeline)
(goto-char (point-max))
(forward-line -1)
"folder mode"))
(defun wl-summary-set-message-modified ()
+ (elmo-folder-set-message-modified-internal
+ wl-summary-buffer-elmo-folder t)
(setq wl-summary-buffer-message-modified t))
(defun wl-summary-message-modified-p ()
wl-summary-buffer-message-modified)
(defun wl-summary-set-mark-modified ()
+ (elmo-folder-set-mark-modified-internal
+ wl-summary-buffer-elmo-folder t)
(setq wl-summary-buffer-mark-modified t))
(defun wl-summary-mark-modified-p ()
wl-summary-buffer-mark-modified)
(defun wl-summary-thread-modified-p ()
wl-summary-buffer-thread-modified)
-(defun wl-summary-msgdb-save ()
- "Save msgdb if modified."
- (when wl-summary-buffer-msgdb
- (save-excursion
- (let (path)
- (when (wl-summary-message-modified-p)
- (setq path (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
- (elmo-msgdb-overview-save
- path
- (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
- (elmo-msgdb-number-save
- path
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- (elmo-folder-set-info-max-by-numdb
- (elmo-string wl-summary-buffer-folder-name)
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))
- (setq wl-summary-buffer-message-modified nil)
- (run-hooks 'wl-summary-buffer-message-saved-hook))
- (when (wl-summary-mark-modified-p)
- (or path
- (setq path (elmo-msgdb-expand-path
- wl-summary-buffer-folder-name)))
- (elmo-msgdb-mark-save
- path
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
-;;; (elmo-folder-set-info-hashtb
-;;; (elmo-string wl-summary-buffer-folder-name)
-;;; nil nil
-;;; 0
-;;; (+ wl-summary-buffer-new-count wl-summary-buffer-unread-count))
-;;; (setq wl-folder-info-alist-modified t)
- (setq wl-summary-buffer-mark-modified nil)
- (run-hooks 'wl-summary-buffer-mark-saved-hook))))))
-
(defsubst wl-summary-cleanup-temp-marks (&optional sticky)
(if (or wl-summary-buffer-refile-list
wl-summary-buffer-copy-list
(setq wl-summary-scored nil))
;; a subroutine for wl-summary-exit/wl-save-status
-(defun wl-summary-save-status (&optional sticky)
+;; Note that folder is not commited here.
+(defun wl-summary-save-view (&optional sticky)
;; already in summary buffer.
(when wl-summary-buffer-persistent
;; save the current summary buffer view.
(or (wl-summary-message-modified-p)
(wl-summary-mark-modified-p)
(wl-summary-thread-modified-p)))
- (wl-summary-save-view-cache))
- ;; save msgdb ...
- (wl-summary-msgdb-save)))
+ (wl-summary-save-view-cache))))
(defun wl-summary-force-exit ()
"Exit current summary. Buffer is deleted even the buffer is sticky."
(interactive "P")
(let ((summary-buf (current-buffer))
(sticky (wl-summary-sticky-p))
- (message-buf (get-buffer wl-message-buf-name))
summary-win
message-buf message-win
folder-buf folder-win)
(unwind-protect
;; save summary status
(progn
- (wl-summary-save-status sticky)
- (elmo-commit wl-summary-buffer-folder-name)
- (if wl-use-scoring
- (wl-score-save)))
+ (if (or force-exit
+ (not sticky))
+ (elmo-folder-close wl-summary-buffer-elmo-folder)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)
+ (elmo-folder-check wl-summary-buffer-elmo-folder))
+ (wl-summary-save-view sticky)
+ (if wl-use-scoring (wl-score-save)))
;; for sticky summary
(wl-delete-all-overlays)
(setq wl-summary-buffer-disp-msg nil)
(elmo-kill-buffer wl-summary-search-buf-name)
;; delete message window if displayed.
- (if (setq message-buf (get-buffer wl-message-buf-name))
- (if (setq message-win (get-buffer-window message-buf))
- (delete-window message-win)))
+ (if (and wl-message-buffer (get-buffer-window wl-message-buffer))
+ (delete-window (get-buffer-window wl-message-buffer)))
(if (setq folder-buf (get-buffer wl-folder-buffer-name))
(if (setq folder-win (get-buffer-window folder-buf))
;; folder win is already displayed.
(not sticky))
(progn
(set-buffer summary-buf)
- (and (get-buffer wl-message-buf-name)
- (kill-buffer wl-message-buf-name))
- ;; kill buffers of mime-view-caesar
- (wl-kill-buffers
- (format "^%s-([0-9 ]+)$" (regexp-quote wl-message-buf-name)))
(kill-buffer summary-buf)))
(run-hooks 'wl-summary-exit-hook)))))
(defun wl-summary-sync-force-update (&optional unset-cursor)
(interactive)
- (let ((msgdb-dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
- (type (elmo-folder-get-type wl-summary-buffer-folder-name))
- ret-val seen-list)
- (unwind-protect
- (progn
- (if wl-summary-buffer-persistent
- (setq seen-list (elmo-msgdb-seen-load msgdb-dir)))
- (setq ret-val (wl-summary-sync-update3 seen-list unset-cursor))
- (if wl-summary-buffer-persistent
- (progn
- (if (and (eq type 'imap4)
- (not (elmo-folder-plugged-p
- wl-summary-buffer-folder-name)))
- (let* ((msgdb wl-summary-buffer-msgdb)
- (number-alist (elmo-msgdb-get-number-alist msgdb)))
- (elmo-mark-as-read wl-summary-buffer-folder-name
- (mapcar
- (lambda (msgid)
- (car (rassoc msgid number-alist)))
- seen-list) msgdb)))
- (elmo-msgdb-seen-save msgdb-dir nil))))
- (set-buffer (current-buffer)))
- (if (interactive-p)
- (message "%s" ret-val))
- ret-val))
+ (wl-summary-sync-update unset-cursor))
(defsubst wl-summary-sync-all-init ()
(wl-summary-cleanup-temp-marks)
(wl-summary-set-mark-modified)
(setq wl-thread-entity-hashtb (elmo-make-hash
(* (length (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)) 2)))
- (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil))
+ (wl-summary-buffer-msgdb))) 2)))
(setq wl-thread-entity-list nil)
(setq wl-thread-entities nil)
(setq wl-summary-buffer-target-mark-list nil)
(defun wl-summary-sync (&optional unset-cursor force-range)
(interactive)
- (let* ((folder wl-summary-buffer-folder-name)
+ (let* ((folder wl-summary-buffer-elmo-folder)
(inhibit-read-only t)
(buffer-read-only nil)
- (msgdb-dir (elmo-msgdb-expand-path
- folder))
- (range (or force-range (wl-summary-input-range folder)))
- mes seen-list killed-list)
- (cond ((string= range "all")
- ;; initialize buffer local databases.
- (unless (elmo-folder-plugged-p folder) ; forbidden
- (error "Unplugged"))
- (setq seen-list
- (nconc
- (elmo-msgdb-mark-alist-to-seen-list
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)
- (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb)
- (concat wl-summary-important-mark
- wl-summary-read-uncached-mark))
- (elmo-msgdb-seen-load msgdb-dir)))
- (setq killed-list (elmo-msgdb-killed-list-load msgdb-dir))
- (elmo-clear-killed wl-summary-buffer-folder-name)
- (condition-case nil
- (setq mes (wl-summary-sync-update3 seen-list unset-cursor
- 'sync-all))
- (quit
- ;; Resume killed-list if quit.
- (message "") ; clear minibuffer.
- (elmo-msgdb-killed-list-save msgdb-dir killed-list)))
- (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen.
- (if mes (message "%s" mes)))
-;;; (wl-summary-sync-all folder t))
- ((string= range "rescan")
+ (msgdb-dir (elmo-folder-msgdb-path folder))
+ (range (or force-range (wl-summary-input-range
+ (elmo-folder-name-internal folder)))))
+ (cond ((string= range "rescan")
(let ((msg (wl-summary-message-number)))
(wl-summary-rescan)
(and msg (wl-summary-jump-to-msg msg))))
(and msg (wl-summary-jump-to-msg msg))))
((or (string-match "last:" range)
(string-match "first:" range))
- (wl-summary-goto-folder-subr (concat "/" range "/" folder)
- 'force-update nil nil t))
- ((string= range "no-sync")
- ;; do nothing.
- )
+ (wl-summary-goto-folder-subr
+ (wl-folder-get-elmo-folder (concat "/" range "/"
+ (elmo-folder-name-internal
+ folder)))
+ 'force-update nil nil t))
(t
- (setq seen-list (elmo-msgdb-seen-load msgdb-dir))
- (setq mes (wl-summary-sync-update3 seen-list unset-cursor))
- (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen.
- (if mes (message "%s" mes))))))
+ (wl-summary-sync-update unset-cursor
+ (string= range "all"))))))
(defvar wl-summary-edit-addresses-candidate-fields
;; First element becomes default.
(if (null (wl-summary-message-number))
(message "No message.")
(save-excursion
- (wl-summary-set-message-buffer-or-redisplay))
- (let* ((charset wl-summary-buffer-mime-charset)
- (candidates
- (with-current-buffer (wl-message-get-original-buffer)
- (wl-summary-edit-addresses-collect-candidate-fields
- charset)))
- address pair result)
- (if addr-str
- (setq address addr-str)
- (when candidates
- (setq address (car (car candidates)))
- (setq address
- (completing-read
- (format "Target address (%s): " address)
- (mapcar
- (function (lambda (x) (cons (car x) (car x))))
- candidates)
- nil nil nil nil address))))
- (when address
- (setq pair (assoc address candidates))
- (unless pair
- (setq pair (cons address nil)))
- (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
- ;; update alias
- (wl-status-update)
- (setq address (assoc (car pair) wl-address-list))
- (if address
- (message "%s, %s, <%s> is %s."
- (nth 2 address)
- (nth 1 address)
- (nth 0 address)
- result)))
+ (wl-summary-set-message-buffer-or-redisplay)
+ (let* ((charset wl-summary-buffer-mime-charset)
+ (candidates
+ (with-current-buffer (wl-message-get-original-buffer)
+ (wl-summary-edit-addresses-collect-candidate-fields
+ charset)))
+ address pair result)
+ (if addr-str
+ (setq address addr-str)
+ (when candidates
+ (setq address (car (car candidates)))
+ (setq address
+ (completing-read
+ (format "Target address (%s): " address)
+ (mapcar
+ (function (lambda (x) (cons (car x) (car x))))
+ candidates)
+ nil nil nil nil address))))
+ (when address
+ (setq pair (assoc address candidates))
+ (unless pair
+ (setq pair (cons address nil)))
+ (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
+ ;; update alias
+ (wl-status-update)
+ (setq address (assoc (car pair) wl-address-list))
+ (if address
+ (message "%s, %s, <%s> is %s."
+ (nth 2 address)
+ (nth 1 address)
+ (nth 0 address)
+ result)))
;;; i'd like to update summary-buffer, but...
;;; (wl-summary-rescan)
- (run-hooks 'wl-summary-edit-addresses-hook)))))
+ (run-hooks 'wl-summary-edit-addresses-hook))))))
(defun wl-summary-incorporate (&optional arg)
"Check and prefetch all uncached messages.
"Returns status-mark. if skipped, returns nil."
;; prefetching procedure.
(save-excursion
- (let* ((msgdb wl-summary-buffer-msgdb)
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(message-id (cdr (assq number number-alist)))
(< size wl-prefetch-threshold))))
mark new-mark)
(if (or arg
- (null (elmo-cache-exists-p message-id)))
+ (null (elmo-file-cache-exists-p message-id)))
(unwind-protect
(progn
(when (and size (not force-read) wl-prefetch-confirm)
(save-excursion
(save-match-data
(if (and (null (elmo-folder-plugged-p
- wl-summary-buffer-folder-name))
+ wl-summary-buffer-elmo-folder))
elmo-enable-disconnected-operation)
(progn;; append-queue for offline
(elmo-dop-prefetch-msgs
- wl-summary-buffer-folder-name (list number))
- (setq new-mark
- (cond
- ((string= mark
- wl-summary-unread-uncached-mark)
- wl-summary-unread-cached-mark)
- ((string= mark wl-summary-new-mark)
- (setq wl-summary-buffer-new-count
- (- wl-summary-buffer-new-count 1))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- ((or (null mark)
- (string= mark wl-summary-read-uncached-mark))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- (t mark))))
+ wl-summary-buffer-elmo-folder (list number))
+ (setq
+ new-mark
+ (cond
+ ((string= mark
+ wl-summary-unread-uncached-mark)
+ wl-summary-unread-cached-mark)
+ ((string= mark wl-summary-new-mark)
+ (setq wl-summary-buffer-new-count
+ (- wl-summary-buffer-new-count 1))
+ (setq wl-summary-buffer-unread-count
+ (+ wl-summary-buffer-unread-count 1))
+ wl-summary-unread-cached-mark)
+ ((or (null mark)
+ (string= mark wl-summary-read-uncached-mark))
+ (setq wl-summary-buffer-unread-count
+ (+ wl-summary-buffer-unread-count 1))
+ wl-summary-unread-cached-mark)
+ (t mark))))
;; online
- (elmo-prefetch-msg wl-summary-buffer-folder-name
- number
- (wl-message-get-original-buffer)
- msgdb)
+ (elmo-message-encache
+ wl-summary-buffer-elmo-folder
+ number)
(setq new-mark
(cond
((string= mark
(wl-summary-set-mark-modified)
(wl-summary-update-modeline)
(wl-folder-update-unread
- wl-summary-buffer-folder-name
+ (wl-summary-buffer-folder-name)
(+ wl-summary-buffer-unread-count
wl-summary-buffer-new-count)))
new-mark))))))))
(setq msg (string-to-int (wl-match-buffer 1)))
(if (or (and (null prefetch-marks)
msg
- (null (elmo-cache-exists-p
+ (null (elmo-file-cache-exists-p
(cdr (assq msg
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))))))
+ (wl-summary-buffer-msgdb)))))))
(member mark prefetch-marks))
(setq targets (nconc targets (list msg))))
(setq entity (wl-thread-get-entity msg))
(while (not (eobp))
(wl-summary-mark-as-read t)
(forward-line 1)))))
- (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline))
(defun wl-summary-mark-as-unread-region (beg end)
(while (not (eobp))
(wl-summary-mark-as-unread)
(forward-line 1)))))
- (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline))
(defun wl-summary-mark-as-important-region (beg end)
(while (not (eobp))
(wl-summary-mark-as-important)
(forward-line 1)))))
- (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline))
(defun wl-summary-mark-as-read-all ()
(interactive)
(if (or (not (interactive-p))
(y-or-n-p "Mark all messages as read? "))
- (let* ((folder wl-summary-buffer-folder-name)
+ (let* ((folder wl-summary-buffer-elmo-folder)
(cur-buf (current-buffer))
- (msgdb wl-summary-buffer-msgdb)
+ (msgdb (wl-summary-buffer-msgdb))
;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
(malist mark-alist)
(case-fold-search nil)
msg mark)
(message "Setting all msgs as read...")
- (elmo-mark-as-read folder (wl-summary-collect-unread mark-alist)
- msgdb)
+ (elmo-folder-mark-as-read folder (wl-summary-collect-unread mark-alist))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9 ]\\)" nil t)
(when (and (not (string= mark wl-summary-important-mark))
(not (string= mark wl-summary-read-uncached-mark)))
(delete-region (match-beginning 2) (match-end 2))
- (if (or (not (elmo-use-cache-p folder msg))
+ (if (or (not (elmo-message-use-cache-p folder msg))
(string= mark wl-summary-unread-cached-mark))
(progn
(insert " ")
(wl-summary-set-mark-modified)
(set-buffer cur-buf); why is this needed???
(elmo-msgdb-set-mark-alist msgdb mark-alist)
- (wl-folder-update-unread wl-summary-buffer-folder-name 0)
+ (wl-folder-update-unread (wl-summary-buffer-folder-name) 0)
(setq wl-summary-buffer-unread-count 0)
(setq wl-summary-buffer-new-count 0)
(wl-summary-update-modeline)
(save-excursion
(let* ((inhibit-read-only t)
(buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(case-fold-search nil)
(delete-region (match-beginning 2) (match-end 2))
(goto-char (match-beginning 2))
(insert new-mark)
- (elmo-cache-delete (cdr (assq number number-alist))
- wl-summary-buffer-folder-name
- number)
+ (elmo-file-cache-delete
+ (elmo-message-field wl-summary-buffer-elmo-folder
+ number
+ 'message-id))
(setq mark-alist
(elmo-msgdb-mark-set mark-alist number new-mark))
(elmo-msgdb-set-mark-alist msgdb mark-alist)
(defun wl-summary-resume-cache-status ()
"Resume the cache status of all messages in the current folder."
(interactive)
- (let* ((folder wl-summary-buffer-folder-name)
+ (let* ((folder wl-summary-buffer-elmo-folder)
(cur-buf (current-buffer))
- (msgdb wl-summary-buffer-msgdb)
+ (msgdb (wl-summary-buffer-msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
(inhibit-read-only t)
(setq mark (wl-match-buffer 2))
(setq msgid (cdr (assq msg number-alist)))
(setq set-mark nil)
- (if (elmo-cache-exists-p msgid folder msg)
+ (if (elmo-file-cache-exists-p msgid)
(if (or
(string= mark wl-summary-unread-uncached-mark) ; U -> !
(string= mark wl-summary-new-mark) ; N -> !
(set-buffer-modified-p nil))))
(defun wl-summary-resume-marks-and-highlight ()
- (let* ((msgdb wl-summary-buffer-msgdb)
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
(count (count-lines (point-min)(point-max)))
(message "Resuming all marks...done")))
(defun wl-summary-resume-marks ()
- (let* ((msgdb wl-summary-buffer-msgdb)
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(count (length mark-alist))
(unless deleting-info 'no-msg))
(wl-thread-cleanup-symbols msgs2))
(wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline)
(wl-folder-update-unread
- wl-summary-buffer-folder-name
+ (wl-summary-buffer-folder-name)
(+ wl-summary-buffer-unread-count wl-summary-buffer-new-count)))))
(defun wl-summary-set-as-read-mark-alist (mark-alist)
(while mark-alist
(setq entity (car mark-alist))
(when (setq pair (assoc (cadr entity) marks))
- (if (elmo-use-cache-p wl-summary-buffer-folder-name
- (caar mark-alist))
+ (if (elmo-message-use-cache-p wl-summary-buffer-elmo-folder
+ (caar mark-alist))
(if (cdr pair)
(setcar (cdr entity) (cdr pair))
- (setq ret-val (delete entity ret-val)))
+ (setq ret-val (delete entity ret-val)))
(setq ret-val (delete entity ret-val))))
(setq mark-alist (cdr mark-alist)))
ret-val))
(defun wl-summary-sync-marks ()
"Update marks in summary."
(interactive)
- (let ((plugged (elmo-folder-plugged-p wl-summary-buffer-folder-name))
- (last-progress 0)
+ (let ((last-progress 0)
(i 0)
- mark-alist unread-marks msgs mark importants unreads
- importants-in-db unreads-in-db has-imap4 diff diffs
+ mark-alist unread-marks importants unreads
+ importants-in-db unreads-in-db diff diffs
mes num-ma progress)
;; synchronize marks.
- (when (not (eq (elmo-folder-get-type
- wl-summary-buffer-folder-name)
+ (when (not (eq (elmo-folder-type-internal
+ wl-summary-buffer-elmo-folder)
'internal))
(message "Updating marks...")
(setq unread-marks (list wl-summary-unread-cached-mark
wl-summary-unread-uncached-mark
wl-summary-new-mark)
- mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)
+ mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))
num-ma (length mark-alist)
- importants (elmo-list-folder-important
- wl-summary-buffer-folder-name
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- unreads (elmo-list-folder-unread
- wl-summary-buffer-folder-name
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)
+ importants (elmo-folder-list-importants
+ wl-summary-buffer-elmo-folder
+ wl-summary-important-mark)
+ unreads (elmo-folder-list-unreads
+ wl-summary-buffer-elmo-folder
unread-marks))
(while mark-alist
(if (string= (cadr (car mark-alist))
(nthcdr (max (- len in) 0) appends))
appends)))
-(defun wl-summary-sync-update3 (&optional seen-list unset-cursor sync-all)
- "Update the summary view."
+(defun wl-summary-sync-update (&optional unset-cursor sync-all)
+ "Update the summary view to the newest folder status."
(interactive)
- (let* ((folder wl-summary-buffer-folder-name)
- (cur-buf (current-buffer))
- (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
- (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
-;;; (location (elmo-msgdb-get-location msgdb))
+ (let* ((folder wl-summary-buffer-elmo-folder)
(case-fold-search nil)
(elmo-mime-charset wl-summary-buffer-mime-charset)
(inhibit-read-only t)
(buffer-read-only nil)
- diff initial-append-list append-list delete-list has-nntp
- i num result
gc-message
- in-folder
- in-db curp
- overview-append
- entity ret-val crossed crossed2
- update-thread update-top-list mark
- expunged msgs unreads importants)
-;;; (setq seen-list nil) ;for debug.
+ overview number-alist mark-alist
+ curp num i new-msgdb
+ append-list delete-list crossed
+ update-thread update-top-list
+ expunged mes sync-result)
+ (unless wl-summary-buffer-elmo-folder
+ (error "(Internal error) Folder is not set:%s" (buffer-name
+ (current-buffer))))
(fset 'wl-summary-append-message-func-internal
(wl-summary-get-append-message-func))
;; Flush pending append operations (disconnected operation).
- (setq seen-list
- (wl-summary-flush-pending-append-operations seen-list))
+ ;;(setq seen-list
+ ;;(wl-summary-flush-pending-append-operations seen-list))
(goto-char (point-max))
(wl-folder-confirm-existence folder 'force)
- (message "Checking folder diff...")
- (elmo-commit folder)
- (setq in-folder (elmo-list-folder folder))
- (setq in-db (unless sync-all (sort (mapcar 'car number-alist) '<)))
- (if (not elmo-use-killed-list)
- (setq diff (if (eq (elmo-folder-get-type folder) 'multi)
- (elmo-multi-list-bigger-diff in-folder in-db)
- (elmo-list-bigger-diff in-folder in-db)))
- (setq diff (elmo-list-diff in-folder in-db)))
- (setq initial-append-list (car diff))
- (setq delete-list (cadr diff))
- (message "Checking folder diff...done")
- ;; Confirm appended message number.
- (setq append-list (wl-summary-confirm-appends initial-append-list))
- (when (and elmo-use-killed-list
- (not (eq (length initial-append-list)
- (length append-list)))
- (setq diff (elmo-list-diff initial-append-list append-list)))
- (elmo-msgdb-append-to-killed-list folder (car diff)))
- ;; Setup sync-all
- (if sync-all (wl-summary-sync-all-init))
- ;; Don't delete important-marked msgs other than 'internal.
- (unless (eq (elmo-folder-get-type folder) 'internal)
- (setq delete-list
- (wl-summary-delete-important-msgs-from-list delete-list
- mark-alist)))
- (if (and has-nntp
- (elmo-nntp-max-number-precedes-list-active-p))
- ;; XXX this does not work correctly in rare case.
- (setq delete-list
- (wl-summary-delete-canceled-msgs-from-list
- delete-list
- wl-summary-buffer-msgdb)))
- (if (or (equal diff '(nil nil))
- (equal diff '(nil))
- (and (eq (length delete-list) 0)
- (eq (length initial-append-list) 0)))
+ (setq sync-result (elmo-folder-synchronize
+ folder
+ wl-summary-new-mark
+ wl-summary-unread-uncached-mark
+ wl-summary-unread-cached-mark
+ wl-summary-read-uncached-mark
+ wl-summary-important-mark
+ sync-all))
+ (setq new-msgdb (nth 0 sync-result))
+ (setq delete-list (nth 1 sync-result))
+ (setq crossed (nth 2 sync-result))
+ (if (or (and sync-all sync-result)
+ sync-result)
(progn
- ;; For max-number update...
- (if (and (elmo-folder-contains-type folder 'nntp)
- (elmo-nntp-max-number-precedes-list-active-p)
- (elmo-update-number folder wl-summary-buffer-msgdb))
- (wl-summary-set-message-modified)
- (setq ret-val (format "No update is needed for \"%s\"" folder))))
- (when delete-list
- (message "Deleting...")
- (elmo-msgdb-delete-msgs folder delete-list
- wl-summary-buffer-msgdb t) ; reserve cache.
-;;; (set-buffer cur-buf)
- (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
- (message "Deleting...done"))
-;;; (set-buffer cur-buf)
- ;; Change "New" marks to "Uncached Unread" marks.
- (wl-summary-set-status-marks mark-alist
- wl-summary-new-mark
- wl-summary-unread-uncached-mark)
- (wl-summary-set-status-marks-on-buffer
- wl-summary-new-mark
- wl-summary-unread-uncached-mark)
- (setq num (length append-list))
- (if append-list
- (progn
+ ;; Setup sync-all
+ (if sync-all (wl-summary-sync-all-init))
+; (if (and has-nntp
+; (elmo-nntp-max-number-precedes-list-active-p))
+ ;; XXX this does not work correctly in rare case.
+; (setq delete-list
+; (wl-summary-delete-canceled-msgs-from-list
+; delete-list
+; (wl-summary-buffer-msgdb))))
+ (when delete-list
+ (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
+ (message "Deleting...done"))
+ (wl-summary-set-status-marks-on-buffer
+ wl-summary-new-mark
+ wl-summary-unread-uncached-mark)
+ (setq append-list (elmo-msgdb-get-overview new-msgdb))
+ (setq curp append-list)
+ (setq num (length curp))
+ (when append-list
(setq i 0)
- (setq result (elmo-msgdb-create
- folder
- append-list
- wl-summary-new-mark
- wl-summary-unread-cached-mark ; !
- wl-summary-read-uncached-mark ; u ;; XXXX
- wl-summary-important-mark
- seen-list))
- ;; delete duplicated messages.
- (when (elmo-folder-contains-multi folder)
- (setq crossed (elmo-multi-delete-crossposts
- wl-summary-buffer-msgdb result))
- (setq result (cdr crossed))
- (setq crossed (car crossed)))
- (setq overview-append (car result))
- (setq wl-summary-buffer-msgdb
- (elmo-msgdb-append wl-summary-buffer-msgdb result t))
;; set these value for append-message-func
- (setq overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
+ (setq overview (elmo-msgdb-get-overview
+ (elmo-folder-msgdb-internal
+ folder)))
(setq number-alist (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))
+ (elmo-folder-msgdb-internal
+ folder)))
(setq mark-alist (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb))
-;;; (setq location (elmo-msgdb-get-location msgdb))
- (setq curp overview-append)
- (setq num (length curp))
+ (elmo-folder-msgdb-internal
+ folder)))
(setq wl-summary-delayed-update nil)
(elmo-kill-buffer wl-summary-search-buf-name)
(while curp
(wl-append update-top-list update-thread))
(if elmo-use-database
(elmo-database-msgid-put
- (car entity) folder
+ (car entity) (elmo-folder-name-internal folder)
(elmo-msgdb-overview-entity-get-number entity)))
(setq curp (cdr curp))
(when (> num elmo-display-progress-threshold)
(setq i (+ i 1))
(if (or (zerop (% i 5)) (= i num))
(elmo-display-progress
- 'wl-summary-sync-update3 "Updating thread..."
+ 'wl-summary-sync-update "Updating thread..."
(/ (* i 100) num)))))
(when wl-summary-delayed-update
(while wl-summary-delayed-update
update-top-list)
(wl-thread-update-indent-string-thread
(elmo-uniq-list update-top-list)))
- (message "Updating thread...done")
-;;; (set-buffer cur-buf)
- ))
- (wl-summary-set-message-modified)
- (wl-summary-set-mark-modified)
- (when (and sync-all (eq wl-summary-buffer-view 'thread))
- (elmo-kill-buffer wl-summary-search-buf-name)
- (message "Inserting thread...")
- (setq wl-thread-entity-cur 0)
- (wl-thread-insert-top)
- (message "Inserting thread...done"))
- (if elmo-use-database
- (elmo-database-close))
- (run-hooks 'wl-summary-sync-updated-hook)
- (setq ret-val (format "Updated (-%d/+%d) message(s)"
+ (message "Updating thread...done"))
+ (wl-summary-set-message-modified)
+ (wl-summary-set-mark-modified)
+ (when (and sync-all (eq wl-summary-buffer-view 'thread))
+ (elmo-kill-buffer wl-summary-search-buf-name)
+ (message "Inserting thread...")
+ (setq wl-thread-entity-cur 0)
+ (wl-thread-insert-top)
+ (message "Inserting thread...done"))
+ (if elmo-use-database
+ (elmo-database-close))
+ (run-hooks 'wl-summary-sync-updated-hook)
+ (setq mes (format "Updated (-%d/+%d) message(s)"
(length delete-list) num)))
+ (setq mes (format
+ "No updates for \"%s\"" (elmo-folder-name-internal folder))))
;; synchronize marks.
(if wl-summary-auto-sync-marks
(wl-summary-sync-marks))
;; scoring
(when wl-use-scoring
(setq wl-summary-scored nil)
- (wl-summary-score-headers nil wl-summary-buffer-msgdb
+ (wl-summary-score-headers nil (wl-summary-buffer-msgdb)
(and sync-all
(wl-summary-rescore-msgs number-alist))
sync-all)
(when (and wl-summary-scored
(setq expunged (wl-summary-score-update-all-lines)))
- (setq ret-val (concat ret-val
- (format " (%d expunged)"
- (length expunged))))))
- ;; crosspost
- (setq crossed2 (wl-summary-update-crosspost))
- (if (or crossed crossed2)
- (let ((crosses (+ (or crossed 0)
- (or crossed2 0))))
- (setq ret-val
- (if ret-val
- (concat ret-val
- (format " (%d crosspost)" crosses))
- (format "%d crosspost message(s)" crosses))))
- (and ret-val
- (setq ret-val (concat ret-val "."))))
+ (setq mes (concat mes
+ (format " (%d expunged)"
+ (length expunged))))))
+ (if (and crossed (> crossed 0))
+ (setq mes
+ (if mes
+ (concat mes
+ (format " (%d crosspost)" crossed))
+ (format "%d crosspost message(s)" crossed)))
+ (and mes (setq mes (concat mes "."))))
;; Update Folder mode
- (wl-folder-set-folder-updated folder (list 0
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb))
- (length in-folder)))
+ (wl-folder-set-folder-updated
+ (elmo-folder-name-internal folder)
+ (list 0
+ (wl-summary-count-unread
+ (elmo-msgdb-get-mark-alist
+ (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-messages folder)))
(wl-summary-update-modeline)
(wl-summary-buffer-number-column-detect t)
;;
(wl-highlight-summary (point) (point-max))))))
(wl-delete-all-overlays)
(set-buffer-modified-p nil)
- ret-val))
-
+ (if mes (message "%s" mes))))
+
(defun wl-summary-set-score-mark (mark)
(save-excursion
(beginning-of-line)
(defun wl-summary-move (src dsts-msgs)
(let* ((dsts (car dsts-msgs)) ; (+foo +bar)
;;; (msgs (cdr dsts-msgs)) ; (1 2 3)
-;;; (msgdb wl-summary-buffer-msgdb)
+;;; (msgdb (wl-summary-buffer-msgdb))
;;; result)
)
(while dsts
(defun wl-summary-flush-pending-append-operations (&optional seen-list)
"Execute append operations that are done while offline status."
- (when (and (elmo-folder-plugged-p wl-summary-buffer-folder-name)
+ (when (and (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
elmo-enable-disconnected-operation)
(let* ((resumed-list (elmo-dop-append-list-load
- wl-summary-buffer-folder-name t))
+ wl-summary-buffer-elmo-folder t))
(append-list (elmo-dop-append-list-load
- wl-summary-buffer-folder-name))
+ wl-summary-buffer-elmo-folder))
(appends (append resumed-list append-list))
- (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
+ (number-alist (elmo-msgdb-get-number-alist
+ (wl-summary-buffer-msgdb)))
dels pair)
(when appends
(while appends
(setq appends (cdr appends)))
(when dels
(setq seen-list
- (elmo-msgdb-add-msgs-to-seen-list-subr
+ (elmo-msgdb-add-msgs-to-seen-list
dels
- wl-summary-buffer-msgdb
- (concat wl-summary-important-mark
- wl-summary-read-uncached-mark)
+ (wl-summary-buffer-msgdb)
+ (list wl-summary-unread-cached-mark
+ wl-summary-unread-uncached-mark
+ wl-summary-new-mark)
seen-list))
(message "Resuming summary status...")
- (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name
- dels wl-summary-buffer-msgdb t)
+ (elmo-msgdb-delete-msgs wl-summary-buffer-elmo-folder
+ dels)
(wl-summary-delete-messages-on-buffer dels)
(message "Resuming summary status...done"))
;; delete resume-file
- (elmo-dop-append-list-save wl-summary-buffer-folder-name nil t)
+ (elmo-dop-append-list-save wl-summary-buffer-elmo-folder nil t)
(when append-list
(elmo-dop-flush-pending-append-operations
- wl-summary-buffer-folder-name append-list)))))
+ wl-summary-buffer-elmo-folder append-list)))))
seen-list)
(defun wl-summary-delete-all-msgs ()
(interactive)
(let ((cur-buf (current-buffer))
- (dels (elmo-list-folder wl-summary-buffer-folder-name)))
+ (dels (elmo-folder-list-messages wl-summary-buffer-elmo-folder)))
(set-buffer cur-buf)
(if (null dels)
(message "No message to delete.")
(if (y-or-n-p (format "%s has %d message(s). Delete all? "
- wl-summary-buffer-folder-name
+ (wl-summary-buffer-folder-name)
(length dels)))
(progn
(message "Deleting...")
- (elmo-delete-msgs wl-summary-buffer-folder-name dels
- wl-summary-buffer-msgdb)
- (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name
- dels wl-summary-buffer-msgdb)
-;;; (elmo-msgdb-save wl-summary-buffer-folder-name nil)
+ (elmo-folder-delete-messages
+ wl-summary-buffer-elmo-folder dels)
+ (elmo-msgdb-delete-msgs wl-summary-buffer-elmo-folder
+ dels)
+
+;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil)
(wl-summary-set-message-modified)
(wl-summary-set-mark-modified)
- (wl-folder-set-folder-updated wl-summary-buffer-folder-name
+ (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
(list 0 0 0))
;;; for thread.
;;; (setq wl-thread-top-entity '(nil t nil nil))
(wl-folder-get-entity-id entity))))
(wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t))
-(defun wl-summary-sticky-p (&optional fld)
- (if fld
- (get-buffer (wl-summary-sticky-buffer-name fld))
+(defun wl-summary-sticky-p (&optional folder)
+ (if folder
+ (get-buffer (wl-summary-sticky-buffer-name
+ (elmo-folder-name-internal folder)))
(not (string= wl-summary-buffer-name (buffer-name)))))
-(defun wl-summary-always-sticky-folder-p (fld)
+(defun wl-summary-always-sticky-folder-p (folder)
(or (eq t wl-summary-always-sticky-folder-list)
- (wl-string-match-member fld wl-summary-always-sticky-folder-list)))
+ (wl-string-match-member
+ (elmo-folder-name-internal folder)
+ wl-summary-always-sticky-folder-list)))
(defun wl-summary-stick (&optional force)
"Make current summary buffer sticky."
(wl-summary-toggle-disp-msg 'off)
(wl-summary-switch-to-clone-buffer
(wl-summary-sticky-buffer-name
- wl-summary-buffer-folder-name))
+ (wl-summary-buffer-folder-name)))
;;; ???hang up
;;; (rename-buffer (wl-summary-sticky-buffer-name
-;;; wl-summary-buffer-folder-name)))
- (message "Folder `%s' is now sticky." wl-summary-buffer-folder-name))))
+;;; (wl-summary-buffer-folder-name))))
+ (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name)))))
(defun wl-summary-switch-to-clone-buffer (buffer-name)
(let ((cur-buf (current-buffer))
(msg (wl-summary-message-number))
(buf (get-buffer-create buffer-name))
- (folder wl-summary-buffer-folder-name)
+ (folder wl-summary-buffer-elmo-folder)
(copy-variables
(append '(wl-summary-buffer-view
wl-summary-buffer-refile-list
wl-summary-buffer-delete-list
wl-summary-buffer-copy-list
wl-summary-buffer-target-mark-list
- wl-summary-buffer-msgdb
+ wl-summary-buffer-elmo-folder
wl-summary-buffer-number-column
wl-summary-buffer-number-regexp
wl-summary-buffer-message-modified
(switch-to-buffer buf)
(kill-buffer cur-buf)
(wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline)
(if msg
(if (eq wl-summary-buffer-view 'thread)
(get-buffer (wl-summary-sticky-buffer-name folder)))
(get-buffer wl-summary-buffer-name)))
-(defun wl-summary-get-buffer-create (folder &optional force-sticky)
+(defun wl-summary-get-buffer-create (name &optional force-sticky)
(if force-sticky
(get-buffer-create
- (wl-summary-sticky-buffer-name folder))
- (or (get-buffer (wl-summary-sticky-buffer-name folder))
+ (wl-summary-sticky-buffer-name name))
+ (or (get-buffer (wl-summary-sticky-buffer-name name))
(get-buffer-create wl-summary-buffer-name))))
-(defun wl-summary-disp-msg (folder disp-msg)
- (let (disp mes-win)
- (if (and disp-msg
- wl-summary-buffer-disp-msg)
- (let ((view-message-buffer (get-buffer wl-message-buf-name))
- (number (wl-summary-message-number))
- cur-folder cur-number sel-win)
- (when view-message-buffer
- (save-excursion
- (set-buffer view-message-buffer)
- (setq cur-folder wl-message-buffer-cur-folder
- cur-number wl-message-buffer-cur-number))
- (when (and (string= folder cur-folder)
- (eq number cur-number))
- (setq sel-win (selected-window))
- (wl-select-buffer view-message-buffer)
- (select-window sel-win)
- (setq disp t)))))
- (if (not disp)
- (setq wl-summary-buffer-disp-msg nil))
- (when (and (not disp)
- (setq mes-win (wl-message-buffer-window)))
- (delete-window mes-win)
- (run-hooks 'wl-summary-toggle-disp-off-hook))))
-
-(defun wl-summary-goto-folder-subr (&optional folder scan-type other-window
+(defun wl-summary-goto-folder-subr (&optional name scan-type other-window
sticky interactive scoring)
"Display target folder on summary."
(interactive)
(let* ((keep-cursor (memq this-command
wl-summary-keep-cursor-command))
- (fld (or folder (wl-summary-read-folder wl-default-folder)))
- (cur-fld wl-summary-buffer-folder-name)
- buf mes hilit reuse-buf
+ (name (or name (wl-summary-read-folder wl-default-folder)))
+ (cur-fld wl-summary-buffer-elmo-folder)
+ folder buf mes hilit reuse-buf
retval entity)
- (if (string= fld "")
- (setq fld wl-default-folder))
- (when (and (not (string= cur-fld fld)) ; folder is moved.
+ (if (string= name "")
+ (setq name wl-default-folder))
+ (setq folder (wl-folder-get-elmo-folder name))
+ (when (and (not (string=
+ (and cur-fld
+ (elmo-folder-name-internal cur-fld))
+ (elmo-folder-name-internal folder))) ; folder is moved.
(eq major-mode 'wl-summary-mode)) ; called in summary.
- (setq wl-summary-last-visited-folder wl-summary-buffer-folder-name)
+ (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name))
(wl-summary-cleanup-temp-marks (wl-summary-sticky-p))
- (wl-summary-save-status 'keep)) ;; keep current buffer, anyway.
- (setq buf (wl-summary-get-buffer-create fld sticky))
+ (wl-summary-save-view 'keep) ; keep current buffer, anyway.
+ (elmo-folder-commit wl-summary-buffer-elmo-folder))
+ (setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder)
+ sticky))
(setq reuse-buf
(save-excursion
(set-buffer buf)
- (string= fld wl-summary-buffer-folder-name)))
+ (string= (elmo-folder-name-internal folder)
+ (wl-summary-buffer-folder-name))))
(unwind-protect
(if reuse-buf
(if interactive
(set-buffer buf)
(unless (eq major-mode 'wl-summary-mode)
(wl-summary-mode))
- (wl-summary-buffer-set-folder fld)
+ (wl-summary-buffer-set-folder folder)
(setq wl-summary-buffer-disp-msg nil)
(setq wl-summary-buffer-last-displayed-msg nil)
(setq wl-summary-buffer-current-msg nil)
(erase-buffer)
;; resume summary cache
(if wl-summary-cache-use
- (let* ((dir (elmo-msgdb-expand-path fld))
+ (let* ((dir (elmo-folder-msgdb-path folder))
(cache (expand-file-name wl-summary-cache-file dir))
(view (expand-file-name wl-summary-view-file dir)))
(when (file-exists-p cache)
(setq wl-summary-buffer-view
(wl-summary-load-file-object view)))
(if (eq wl-summary-buffer-view 'thread)
- (wl-thread-resume-entity fld))))
- ;; Load msgdb
- (setq wl-summary-buffer-msgdb nil) ; new msgdb
- (setq wl-summary-buffer-msgdb
- (wl-summary-msgdb-load-async fld))
- (if (null wl-summary-buffer-msgdb)
- (setq wl-summary-buffer-msgdb
- (elmo-msgdb-load (elmo-string fld))))
+ (wl-thread-resume-entity folder))))
+ ;; Select folder
+ (elmo-folder-open folder)
(wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline)))
(wl-summary-buffer-number-column-detect t)
- (wl-summary-disp-msg fld (and reuse-buf keep-cursor))
+ (wl-summary-toggle-disp-msg 'on)
(unless (and reuse-buf keep-cursor)
(setq hilit wl-summary-highlight)
(unwind-protect
(if (and (not scan-type)
interactive
(not wl-ask-range))
- (setq scan-type (wl-summary-get-sync-range fld)))
+ (setq scan-type (wl-summary-get-sync-range folder)))
(cond
((eq scan-type nil)
(wl-summary-sync 'unset-cursor))
(switch-to-buffer buf)
(set-buffer buf))
;; stick always-sticky-folder
- (when (wl-summary-always-sticky-folder-p fld)
+ (when (wl-summary-always-sticky-folder-p folder)
(or (wl-summary-sticky-p) (wl-summary-stick t)))
(run-hooks 'wl-summary-prepared-pre-hook)
(set-buffer-modified-p nil)
wl-summary-highlight-partial-threshold)))
(wl-highlight-summary (point) (point-max)))
(wl-highlight-summary (point-min) (point-max))))
- (if (null wl-summary-buffer-msgdb) ;; one more try.
- (setq wl-summary-buffer-msgdb
- (elmo-msgdb-load (elmo-string fld))))
(if (eq retval 'disp-msg)
(wl-summary-redisplay))
(if mes (message "%s" mes))
;; set current entity-id
(if (and (not folder)
(setq entity
- (wl-folder-search-entity-by-name fld
+ (wl-folder-search-entity-by-name (elmo-folder-name-internal
+ folder)
wl-folder-entity
'folder)))
;; entity-id is unknown.
(defun wl-summary-search-by-subject (entity overview)
(let ((buf (get-buffer-create wl-summary-search-buf-name))
- (folder-name wl-summary-buffer-folder-name)
+ (folder-name (wl-summary-buffer-folder-name))
match founds found-entity)
(save-excursion
(set-buffer buf)
(let ((case-fold-search t))
- (when (or (not (string= wl-summary-buffer-folder-name folder-name))
+ (when (or (not (string= wl-summary-search-buf-folder-name folder-name))
(zerop (buffer-size)))
- (setq wl-summary-buffer-folder-name folder-name)
+ (setq wl-summary-search-buf-folder-name folder-name)
(wl-summary-insert-headers
overview
(function
(let* (eol
(inhibit-read-only t)
(buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
new-mark visible mark)
(setq new-mark (if (string= mark
wl-summary-read-uncached-mark)
wl-summary-unread-uncached-mark
- (if (elmo-use-cache-p folder number)
+ (if (elmo-message-use-cache-p folder number)
wl-summary-unread-mark
wl-summary-unread-uncached-mark))))
;; server side mark
(unless no-server-update
- (unless (elmo-mark-as-unread folder (list number)
- msgdb)
- (error "Setting mark failed")))
+ (save-match-data
+ (unless (elmo-folder-unmark-read folder (list number))
+ (error "Setting mark failed"))))
(when visible
(delete-region (match-beginning 2) (match-end 2))
(insert new-mark))
(+ 1 wl-summary-buffer-unread-count))
(wl-summary-update-modeline)
(wl-folder-update-unread
- folder
+ (wl-summary-buffer-folder-name)
(+ wl-summary-buffer-unread-count
wl-summary-buffer-new-count)))
(wl-summary-set-mark-modified)
(message "No marks")
(save-excursion
(let ((del-fld (wl-summary-get-delete-folder
- wl-summary-buffer-folder-name))
+ (wl-summary-buffer-folder-name)))
(start (point))
(unread-marks (list wl-summary-unread-cached-mark
wl-summary-unread-uncached-mark
(goto-char start) ; avoid moving cursor to
; the bottom line.
(while dst-msgs
-;;; (elmo-msgdb-add-msgs-to-seen-list
-;;; (car (car dst-msgs)) ;dst-folder
-;;; (cdr (car dst-msgs)) ;msgs
-;;; wl-summary-buffer-msgdb
-;;; (concat wl-summary-important-mark
-;;; wl-summary-read-uncached-mark))
(setq result nil)
(condition-case nil
- (setq result (elmo-move-msgs wl-summary-buffer-folder-name
- (cdr (car dst-msgs))
- (car (car dst-msgs))
- wl-summary-buffer-msgdb
- refile-len
- refile-executed
- (not (null (cdr dst-msgs)))
- nil ; no-delete
- nil ; same-number
- unread-marks))
+ (setq result (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ (cdr (car dst-msgs))
+ (wl-folder-get-elmo-folder
+ (car (car dst-msgs)))
+ (wl-summary-buffer-msgdb)
+ refile-len
+ refile-executed
+ (not (null (cdr dst-msgs)))
+ nil ; no-delete
+ nil ; same-number
+ unread-marks))
(error nil))
(if result ; succeeded.
(progn
;; update refile-alist.
(setq wl-summary-buffer-refile-list
(wl-delete-associations (cdr (car dst-msgs))
- wl-summary-buffer-refile-list)))
+ wl-summary-buffer-refile-list)))
(setq refile-failures
(+ refile-failures (length (cdr (car dst-msgs))))))
(setq refile-executed (+ refile-executed (length (cdr (car dst-msgs)))))
;; begin cOpy...
(setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
(while dst-msgs
-;;; (elmo-msgdb-add-msgs-to-seen-list
-;;; (car (car dst-msgs)) ;dst-folder
-;;; (cdr (car dst-msgs)) ;msgs
-;;; wl-summary-buffer-msgdb
-;;; (concat wl-summary-important-mark
-;;; wl-summary-read-uncached-mark))
(setq result nil)
(condition-case nil
- (setq result (elmo-move-msgs wl-summary-buffer-folder-name
- (cdr (car dst-msgs))
- (car (car dst-msgs))
- wl-summary-buffer-msgdb
- copy-len
- copy-executed
- (not (null (cdr dst-msgs)))
- t ; t is no-delete (copy)
- nil ; same number
- unread-marks))
+ (setq result (elmo-folder-move-messages
+ (wl-summary-buffer-folder-name)
+ (cdr (car dst-msgs))
+ (car (car dst-msgs))
+ (wl-summary-buffer-msgdb)
+ copy-len
+ copy-executed
+ (not (null (cdr dst-msgs)))
+ t ; t is no-delete (copy)
+ nil ; same number
+ unread-marks))
(error nil))
(if result ; succeeded.
(progn
(error "Not supported folder name: %s" fld))
(unless no-create
(if ignore-error
- (ignore-errors (wl-folder-confirm-existence fld))
- (wl-folder-confirm-existence fld)))
+ (condition-case nil
+ (wl-folder-confirm-existence
+ (wl-folder-get-elmo-folder
+ fld))
+ (error))
+ (wl-folder-confirm-existence (wl-folder-get-elmo-folder
+ fld))))
fld))
(defun wl-summary-print-destination (msg-num folder)
See `wl-refile-policy-alist' for more details."
(interactive)
(let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
- wl-summary-buffer-folder-name)))
+ (wl-summary-buffer-folder-name))))
(cond ((eq policy 'copy)
(if (interactive-p)
(call-interactively 'wl-summary-copy)
(let* ((buffer-num (wl-summary-message-number))
(msg-num (or number buffer-num))
(msgid (and msg-num
- (cdr (assq msg-num
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))))
+ (elmo-message-field wl-summary-buffer-elmo-folder
+ msg-num 'message-id)))
(entity (and msg-num
(elmo-msgdb-overview-get-entity
- msg-num wl-summary-buffer-msgdb)))
+ msg-num (wl-summary-buffer-msgdb))))
(variable
(intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
folder mark already tmp-folder)
(or (wl-refile-guess entity) wl-trash-folder)
(format "for %s" copy-or-refile)))))
;; Cache folder hack by okada@opaopa.org
- (if (and (eq (car (elmo-folder-get-spec
- (wl-folder-get-realname folder))) 'cache)
+ (if (and (eq (elmo-folder-type-internal
+ (wl-folder-get-elmo-folder
+ (wl-folder-get-realname folder))) 'cache)
(not (string= folder
(setq tmp-folder
(concat "'cache/"
(progn
(setq folder tmp-folder)
(message "Force refile to %s." folder)))
- (if (string= folder wl-summary-buffer-folder-name)
+ (if (string= folder (wl-summary-buffer-folder-name))
(error "Same folder"))
- (unless (or (elmo-folder-plugged-p wl-summary-buffer-folder-name)
- (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) 'pipe)
- (elmo-folder-plugged-p
- (elmo-pipe-spec-dst (elmo-folder-get-spec wl-summary-buffer-folder-name))))
- (elmo-cache-exists-p msgid))
- (error "Unplugged (no cache or msgid)"))
(if (or (string= folder wl-queue-folder)
(string= folder wl-draft-folder))
(error "Don't %s messages to %s" copy-or-refile folder))
(if (and (eq wl-summary-buffer-view 'thread)
open-all)
(wl-thread-open-all))
- (let* ((spec wl-summary-buffer-folder-name)
+ (let* ((spec (wl-summary-buffer-folder-name))
(overview (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb))
+ (wl-summary-buffer-msgdb)))
(mark-alist (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb))
+ (wl-summary-buffer-msgdb)))
checked-dsts
(count 0)
number dst thr-entity)
(wl-folder-get-realname
(wl-refile-guess-by-rule
(elmo-msgdb-overview-get-entity
- number wl-summary-buffer-msgdb))))
+ number (wl-summary-buffer-msgdb)))))
(not (equal dst spec)))
(when (not (member dst checked-dsts))
- (wl-folder-confirm-existence dst)
+ (wl-folder-confirm-existence (wl-folder-get-elmo-folder dst))
(setq checked-dsts (cons dst checked-dsts)))
(if (wl-summary-refile dst number)
(incf count))
(when (and (setq dst
(wl-refile-guess-by-rule
(elmo-msgdb-overview-get-entity
- (car messages) wl-summary-buffer-msgdb)))
+ (car messages) (wl-summary-buffer-msgdb))))
(not (equal dst spec)))
(if (wl-summary-refile dst (car messages))
(incf count))
;; guess by first msg
(let* ((msgid (cdr (assq (wl-summary-message-number)
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))))
+ (wl-summary-buffer-msgdb)))))
(function (intern (format "wl-summary-%s" copy-or-refile)))
(entity (assoc msgid (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
folder)
(if entity
(setq folder (wl-summary-read-folder (wl-refile-guess entity)
(wl-summary-target-mark-region (point-min) (point-max))
(setq wl-summary-buffer-target-mark-list
(mapcar 'car
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))))
+ (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))))
(defun wl-summary-delete-all-mark (mark)
(goto-char (point-min))
(defun wl-summary-pick (&optional from-list delete-marks)
(interactive)
(let ((result (elmo-msgdb-search
- wl-summary-buffer-folder-name
+ wl-summary-buffer-elmo-folder
(elmo-read-search-condition wl-summary-pick-field-default)
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
(if delete-marks
(let ((mlist wl-summary-buffer-target-mark-list))
(while mlist
"Exit from current virtual folder."
(interactive)
(if (eq 'filter
- (elmo-folder-get-type wl-summary-buffer-folder-name))
- (wl-summary-goto-folder-subr (nth 2 (elmo-folder-get-spec
- wl-summary-buffer-folder-name))
- 'update nil nil t)
+ (elmo-folder-type-internal wl-summary-buffer-elmo-folder))
+ (wl-summary-goto-folder-subr
+ (elmo-folder-name-internal
+ (elmo-filter-folder-target-internal
+ wl-summary-buffer-elmo-folder))
+ 'update nil nil t)
(error "This folder is not filtered")))
(defun wl-summary-virtual (&optional arg)
(elmo-read-search-condition
wl-summary-pick-field-default)
"/"
- wl-summary-buffer-folder-name)
+ (wl-summary-buffer-folder-name))
'update nil nil t)))
(defun wl-summary-delete-all-temp-marks ()
(when (re-search-forward regexp nil t)
(setq msgid (cdr (assq (setq number (wl-summary-message-number))
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
entity (assoc msgid
(elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
(if (null entity)
(error "Cannot %s" copy-or-refile))
(funcall function
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist)))
(wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline))))
(defun wl-summary-target-mark-mark-as-unread ()
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist)))
(wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline))))
(defun wl-summary-target-mark-mark-as-important ()
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist)))
(wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(wl-summary-update-modeline))))
(defun wl-summary-target-mark-save ()
(let* (eol
(inhibit-read-only t)
(buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
(case-fold-search nil)
(setq number (or number (string-to-int (wl-match-buffer 1))))
;; set server side mark...
(setq new-mark (if (and uncached
- (if (elmo-use-cache-p folder number)
+ (if (elmo-message-use-cache-p folder number)
(not (elmo-folder-local-p folder)))
(not cached))
wl-summary-read-uncached-mark
nil))
(if (not leave-server-side-mark-untouched)
- (setq marked (elmo-mark-as-read folder
- (list number) msgdb)))
+ (save-match-data
+ (setq marked (elmo-folder-mark-as-read
+ folder
+ (list number)))))
(if (or leave-server-side-mark-untouched
marked)
(progn
(1- wl-summary-buffer-new-count))))
(wl-summary-update-modeline)
(wl-folder-update-unread
- folder
+ (wl-summary-buffer-folder-name)
(+ wl-summary-buffer-unread-count
wl-summary-buffer-new-count))
(when (or stat cached)
mark
no-server-update)
(interactive)
- (if (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
'internal)
(error "Cannot process mark in this folder"))
(save-excursion
(let* (eol
(inhibit-read-only t)
(buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
message-id visible)
(progn
(setq number (or number (string-to-int (wl-match-buffer 1))))
(setq mark (or mark (wl-match-buffer 2)))
- (setq message-id (cdr (assq number number-alist)))
+ (setq message-id (elmo-message-field
+ wl-summary-buffer-elmo-folder
+ number
+ 'message-id))
(if (string= mark wl-summary-important-mark)
(progn
;; server side mark
(unless no-server-update
- (elmo-unmark-important folder (list number) msgdb)
+ (elmo-folder-unmark-important folder (list number))
(elmo-msgdb-global-mark-delete message-id))
;; Remove cache if local folder.
- (if (elmo-folder-local-p folder)
- (elmo-cache-delete message-id folder number))
+ (save-match-data
+ (if (and (elmo-folder-local-p folder)
+ (not (eq 'mark
+ (elmo-folder-type-internal folder))))
+ (elmo-file-cache-delete
+ (elmo-file-cache-get-path message-id))))
(when visible
(delete-region (match-beginning 2) (match-end 2))
(insert " "))
nil)))
;; server side mark
(unless no-server-update
- (elmo-mark-as-important folder (list number) msgdb))
+ (elmo-folder-mark-as-important folder (list number)))
(when visible
(delete-region (match-beginning 2) (match-end 2))
(insert wl-summary-important-mark))
(string-to-int (wl-match-buffer 1))
wl-summary-important-mark))
;; Force cache message!!
- (save-match-data
- (unless (elmo-cache-exists-p message-id)
- (elmo-force-cache-msg folder number message-id
- (elmo-msgdb-get-location msgdb))))
+ (elmo-message-encache folder number)
(unless no-server-update
(elmo-msgdb-global-mark-set message-id
wl-summary-important-mark)))
(point))))
(- end (progn (beginning-of-line) (point)) 1))
(wl-get-assoc-list-value wl-summary-number-column-alist
- wl-summary-buffer-folder-name)
+ (wl-summary-buffer-folder-name))
wl-summary-default-number-column))
(setq wl-summary-buffer-number-regexp
(wl-repeat-string "." wl-summary-buffer-number-column)))))
(defmacro wl-summary-cursor-move-regex ()
(` (let ((mark-alist
- (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
+ (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
(cond ((eq wl-summary-move-order 'new)
(list
(list
(defun wl-summary-save-view-cache ()
(save-excursion
- (let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
+ (let* ((dir (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder))
(cache (expand-file-name wl-summary-cache-file dir))
(view (expand-file-name wl-summary-view-file dir))
(save-view wl-summary-buffer-view)
(elmo-folder-plugged-p folder)
(wl-get-assoc-list-value
wl-folder-sync-range-alist
- folder))
+ (elmo-folder-name-internal folder)))
wl-default-sync-range)))
;; redefined for wl-summary-sync-update
"returns update or all or rescan."
;; for the case when parts are expanded in the bottom of the folder
(let ((input-range-list '("update" "all" "rescan" "first:" "last:"
- "no-sync" "rescan-noscore"))
+ "rescan-noscore"))
(default (or (wl-get-assoc-list-value
wl-folder-sync-range-alist
folder)
(defun wl-summary-toggle-disp-folder (&optional arg)
(interactive)
- (let (fld-buf fld-win
- (view-message-buffer (wl-message-get-buffer-create))
- (cur-buf (current-buffer))
- (summary-win (get-buffer-window (current-buffer))))
+ (let ((cur-buf (current-buffer))
+ (summary-win (get-buffer-window (current-buffer)))
+ fld-buf fld-win)
(cond
((eq arg 'on)
(setq wl-summary-buffer-disp-folder t)
((eq arg 'off)
(setq wl-summary-buffer-disp-folder nil)
;; hide your wl-message window!
- (wl-select-buffer view-message-buffer)
- (delete-window)
+ (when (buffer-live-p wl-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
+ (delete-window))
(select-window (get-buffer-window cur-buf))
;; display wl-folder window!!
(if (setq fld-buf (get-buffer wl-folder-buffer-name))
(setq wl-summary-buffer-disp-folder t)))
(if (not wl-summary-buffer-disp-folder)
;; hide message window
- (let ((mes-win (get-buffer-window view-message-buffer))
+ (let ((mes-win (and wl-message-buffer
+ (get-buffer-window wl-message-buffer)))
(wl-stay-folder-window t))
(if mes-win (delete-window mes-win))
;; hide your folder window
(run-hooks 'wl-summary-toggle-disp-folder-off-hook)
;; resume message window.
(when mes-win
- (wl-select-buffer view-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
(run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
(select-window (get-buffer-window cur-buf)))
)
;; hide message window
- (let ((mes-win (get-buffer-window view-message-buffer))
- (wl-stay-folder-window t))
+ (let ((wl-stay-folder-window t)
+ (mes-win (and wl-message-buffer
+ (get-buffer-window wl-message-buffer))))
(if mes-win (delete-window mes-win))
(select-window (get-buffer-window cur-buf))
;; display wl-folder window!!
;; resume message window.
(run-hooks 'wl-summary-toggle-disp-folder-on-hook)
(when mes-win
- (wl-select-buffer view-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
(run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
(select-window (get-buffer-window cur-buf))))
))))
(defun wl-summary-toggle-disp-msg (&optional arg)
(interactive)
- (let (fld-buf fld-win
- (view-message-buffer (wl-message-get-buffer-create))
- (cur-buf (current-buffer))
+ (let ((cur-buf (current-buffer))
+ fld-buf fld-win
summary-win)
(cond
((eq arg 'on)
(setq wl-summary-buffer-disp-msg t)
- ;; hide your folder window
- (if (and (not wl-stay-folder-window)
- (setq fld-buf (get-buffer wl-folder-buffer-name)))
- (if (setq fld-win (get-buffer-window fld-buf))
- (delete-window fld-win))))
+ (save-excursion
+ ;; hide your folder window
+ (if (and (not wl-stay-folder-window)
+ (setq fld-buf (get-buffer wl-folder-buffer-name)))
+ (if (setq fld-win (get-buffer-window fld-buf))
+ (unless (one-window-p fld-win)
+ (delete-window fld-win))))))
((eq arg 'off)
(wl-delete-all-overlays)
(setq wl-summary-buffer-disp-msg nil)
(save-excursion
- (wl-select-buffer view-message-buffer)
- (delete-window)
- (and (get-buffer-window cur-buf)
- (select-window (get-buffer-window cur-buf)))
+ (when (buffer-live-p wl-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
+ (delete-window)
+ (and (get-buffer-window cur-buf)
+ (select-window (get-buffer-window cur-buf))))
(run-hooks 'wl-summary-toggle-disp-off-hook)))
(t
- (if (get-buffer-window view-message-buffer) ; already displayed
+ (if (and wl-message-buffer
+ (get-buffer-window wl-message-buffer)) ; already displayed
(setq wl-summary-buffer-disp-msg nil)
(setq wl-summary-buffer-disp-msg t))
(if wl-summary-buffer-disp-msg
(run-hooks 'wl-summary-toggle-disp-on-hook))
(wl-delete-all-overlays)
(save-excursion
- (wl-select-buffer view-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
(delete-window)
(select-window (get-buffer-window cur-buf))
(run-hooks 'wl-summary-toggle-disp-off-hook))
)))))
(defun wl-summary-next-line-content ()
+ "Show next line of the message."
(interactive)
(let ((cur-buf (current-buffer)))
(wl-summary-toggle-disp-msg 'on)
(wl-message-prev-page))
(defsubst wl-summary-no-mime-p (folder)
- (wl-string-match-member folder wl-summary-no-mime-folder-list))
-
-(defun wl-summary-set-message-buffer-or-redisplay (&optional ignore-original)
- ;; if current message is not displayed, display it.
- ;; return t if exists.
- (let ((folder wl-summary-buffer-folder-name)
+ (wl-string-match-member (elmo-folder-name-internal folder)
+ wl-summary-no-mime-folder-list))
+
+(defun wl-summary-set-message-buffer-or-redisplay (&rest args)
+ "Set message buffer.
+If message is not displayed yet, display it.
+Return t if message exists."
+ (let ((folder wl-summary-buffer-elmo-folder)
(number (wl-summary-message-number))
- cur-folder cur-number message-last-pos
- (view-message-buffer (wl-message-get-buffer-create)))
- (save-excursion
- (set-buffer view-message-buffer)
- (setq cur-folder wl-message-buffer-cur-folder)
- (setq cur-number wl-message-buffer-cur-number))
- (if (and (not ignore-original)
- (not
- (and (eq number (wl-message-original-buffer-number))
- (string= folder (wl-message-original-buffer-folder)))))
+ cur-folder cur-number message-last-pos)
+ (when (buffer-live-p wl-message-buffer)
+ (save-window-excursion
+ (wl-message-select-buffer wl-message-buffer)
+ (setq cur-folder wl-message-buffer-cur-folder)
+ (setq cur-number wl-message-buffer-cur-number)))
+ (if (and (string= (elmo-folder-name-internal folder) (or cur-folder ""))
+ (eq number (or cur-number 0)))
(progn
- (if (wl-summary-no-mime-p folder)
- (wl-summary-redisplay-no-mime folder number)
- (wl-summary-redisplay-internal folder number))
- nil)
- (if (and (string= folder (or cur-folder ""))
- (eq number (or cur-number 0)))
- (progn
- (set-buffer view-message-buffer)
- t)
- (if (wl-summary-no-mime-p folder)
- (wl-summary-redisplay-no-mime folder number)
- (wl-summary-redisplay-internal folder number))
- nil))))
+ (set-buffer wl-message-buffer)
+ t)
+ (if (wl-summary-no-mime-p folder)
+ (wl-summary-redisplay-no-mime folder number)
+ (wl-summary-redisplay-internal folder number))
+ (set-buffer wl-message-buffer)
+ nil)))
(defun wl-summary-target-mark-forward (&optional arg)
(interactive "P")
(interactive)
(let* ((original (wl-summary-message-number))
(msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
- (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
+ (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))
msg otherfld schar
(errmsg
(format "No message with id \"%s\" in the folder." msgid)))
(if (setq msg (car (rassoc msgid number-alist)))
;;; (wl-summary-jump-to-msg-internal
-;;; wl-summary-buffer-folder-name msg 'no-sync)
+;;; (wl-summary-buffer-folder-name) msg 'no-sync)
(progn
(wl-thread-jump-to-msg msg)
t)
t ; succeed.
;; Back to original.
(wl-summary-jump-to-msg-internal
- wl-summary-buffer-folder-name original 'no-sync))
+ (wl-summary-buffer-folder-name) original 'no-sync))
(cond ((eq wl-summary-search-via-nntp 'confirm)
(message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
elmo-default-nntp-server)
user server port type spec)
(if server-spec
(if (string-match "^-" server-spec)
- (setq spec (elmo-nntp-get-spec server-spec)
- user (nth 2 spec)
- server (nth 3 spec)
- port (nth 4 spec)
- type (nth 5 spec))
+ (setq spec (wl-folder-get-elmo-folder server-spec)
+ user (elmo-net-folder-user-internal spec)
+ server (elmo-net-folder-server-internal spec)
+ port (elmo-net-folder-port-internal spec)
+ type (elmo-net-folder-stream-type-internal spec))
(setq server server-spec)))
(when (setq ret (elmo-nntp-get-newsgroup-by-msgid
msgid
(defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
(let (wl-auto-select-first entity)
- (if (or (string= folder wl-summary-buffer-folder-name)
+ (if (or (string= folder (wl-summary-buffer-folder-name))
(y-or-n-p
(format
"Message was found in the folder \"%s\". Jump to it? "
(setq msg
(car (rassoc msgid
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))))
+ (wl-summary-buffer-msgdb))))))
(setq entity (wl-folder-search-entity-by-name folder
wl-folder-entity
'folder))
"Reply to current message. Default is \"wide\" reply.
Reply to author if invoked with ARG."
(interactive "P")
- (let ((folder wl-summary-buffer-folder-name)
+ (let ((folder wl-summary-buffer-elmo-folder)
(number (wl-summary-message-number))
(summary-buf (current-buffer))
mes-buf)
- (if number
- (unwind-protect
- (progn
- (wl-summary-redisplay-internal folder number)
- (wl-select-buffer
- (get-buffer (setq mes-buf (wl-current-message-buffer))))
- (set-buffer mes-buf)
- (goto-char (point-min))
- (or wl-draft-use-frame
- (split-window-vertically))
- (other-window 1)
- (when (setq mes-buf (wl-message-get-original-buffer))
- (wl-draft-reply mes-buf arg summary-buf)
- (unless without-setup-hook
- (run-hooks 'wl-mail-setup-hook)))
- t)))))
+ (when number
+ (save-excursion
+ (wl-summary-redisplay-internal folder number))
+ (setq mes-buf wl-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
+ (set-buffer mes-buf)
+ (goto-char (point-min))
+ (or wl-draft-use-frame
+ (split-window-vertically))
+ (other-window 1)
+ (when (setq mes-buf (wl-message-get-original-buffer))
+ (wl-draft-reply mes-buf arg summary-buf)
+ (unless without-setup-hook
+ (run-hooks 'wl-mail-setup-hook)))
+ t)))
(defun wl-summary-write ()
"Write a new draft from Summary."
(interactive)
(let (newsgroups to cc)
;; default FOLDER is current buffer folder
- (setq folder (or folder wl-summary-buffer-folder-name))
+ (setq folder (or folder (wl-summary-buffer-folder-name)))
(let ((flist wl-summary-write-current-folder-functions)
guess-list)
(while flist
(defun wl-summary-forward (&optional without-setup-hook)
""
(interactive)
- (let ((folder wl-summary-buffer-folder-name)
+ (let ((folder wl-summary-buffer-elmo-folder)
(number (wl-summary-message-number))
(summary-buf (current-buffer))
(wl-draft-forward t)
+ mes-buf
entity subject num)
(if (null number)
(message "No message.")
- (wl-summary-redisplay-internal folder number)
- (wl-select-buffer (get-buffer wl-message-buf-name))
+ (wl-summary-redisplay-internal nil nil 'force-reload)
+ (setq mes-buf wl-message-buffer)
+ (wl-message-select-buffer mes-buf)
(or wl-draft-use-frame
(split-window-vertically))
(other-window 1)
(if summary-buf
(save-excursion
(set-buffer summary-buf)
- (setq num (wl-summary-message-number))
- (setq entity (assoc (cdr (assq num
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
- (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
- (and entity
- (setq subject
- (or (elmo-msgdb-overview-entity-get-subject entity)
- "")))))
+ (setq subject
+ (or (elmo-message-field folder number 'subject) ""))))
+ (set-buffer mes-buf)
(wl-draft-forward subject summary-buf)
(unless without-setup-hook
(run-hooks 'wl-mail-setup-hook)))))
(wl-summary-read))
(defun wl-summary-read ()
- ""
+ "Proceed reading message in the summary buffer."
(interactive)
- (let ((folder wl-summary-buffer-folder-name)
- (number (wl-summary-message-number))
- cur-folder cur-number message-last-pos
- (view-message-buffer (get-buffer-create wl-message-buf-name))
- (sticky-buf-name (and (wl-summary-sticky-p) wl-message-buf-name))
- (summary-buf-name (buffer-name)))
- (save-excursion
- (set-buffer view-message-buffer)
- (when (and sticky-buf-name
- (not (wl-local-variable-p 'wl-message-buf-name
- (current-buffer))))
- (make-local-variable 'wl-message-buf-name)
- (setq wl-message-buf-name sticky-buf-name)
- (make-local-variable 'wl-message-buffer-cur-summary-buffer)
- (setq wl-message-buffer-cur-summary-buffer summary-buf-name))
- (setq cur-folder wl-message-buffer-cur-folder)
- (setq cur-number wl-message-buffer-cur-number))
+ (let ((cur-buf (current-buffer)))
(wl-summary-toggle-disp-msg 'on)
- (if (and (string= folder cur-folder)
- (eq number cur-number))
- (progn
- (if (wl-summary-next-page)
- (wl-summary-down t)))
-;;; (wl-summary-scroll-up-content)))
- (if (wl-summary-no-mime-p folder)
- (wl-summary-redisplay-no-mime folder number)
- (wl-summary-redisplay-internal folder number)))))
+ (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
+ (set-buffer cur-buf)
+ (if (wl-message-next-page)
+ (wl-summary-down t)))))
(defun wl-summary-prev (&optional interactive)
""
(interactive)
(if wl-summary-move-direction-toggle
(setq wl-summary-move-direction-downward nil))
- (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
- (skip-mark-regexp (mapconcat
+ (let ((skip-mark-regexp (mapconcat
'regexp-quote
wl-summary-skip-mark-list ""))
goto-next regex-list regex next-entity finfo)
(beginning-of-line)
- (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
+ (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
(setq regex (format "^%s[^%s]"
wl-summary-buffer-number-regexp
skip-mark-regexp))
(interactive)
(if wl-summary-move-direction-toggle
(setq wl-summary-move-direction-downward t))
- (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
- (skip-mark-regexp (mapconcat
+ (let ((skip-mark-regexp (mapconcat
'regexp-quote
wl-summary-skip-mark-list ""))
goto-next regex regex-list next-entity finfo)
(end-of-line)
- (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
+ (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
(setq regex (format "^%s[^%s]"
wl-summary-buffer-number-regexp
skip-mark-regexp))
(defun wl-summary-redisplay (&optional arg)
(interactive "P")
(if (and (not arg)
- (wl-summary-no-mime-p wl-summary-buffer-folder-name))
+ (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
(wl-summary-redisplay-no-mime)
(wl-summary-redisplay-internal nil nil arg)))
(defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
(interactive)
- (let* ((msgdb wl-summary-buffer-msgdb)
- (fld (or folder wl-summary-buffer-folder-name))
+ (let* ((msgdb (wl-summary-buffer-msgdb))
+ (folder (or folder wl-summary-buffer-elmo-folder))
(num (or number (wl-summary-message-number)))
(wl-mime-charset wl-summary-buffer-mime-charset)
(default-mime-charset wl-summary-buffer-mime-charset)
- (wl-message-redisplay-func
- wl-summary-buffer-message-redisplay-func)
fld-buf fld-win thr-entity)
(if (and wl-thread-open-reading-thread
(eq wl-summary-buffer-view 'thread)
(if (setq fld-win (get-buffer-window fld-buf))
(delete-window fld-win)))
(setq wl-current-summary-buffer (current-buffer))
- (if (wl-message-redisplay fld num 'mime msgdb force-reload)
- (wl-summary-mark-as-read nil
- ;; cached, then change server-mark.
- (if wl-message-cache-used
- nil
- ;; plugged, then leave server-mark.
- (if (and
- (not
- (elmo-folder-local-p
- wl-summary-buffer-folder-name))
- (elmo-folder-plugged-p
- wl-summary-buffer-folder-name))
- 'leave))
- t ; displayed
- nil
- 'cached ; cached by reading.
- )
- )
+ (wl-summary-mark-as-read
+ nil
+ ;; not fetched, then change server-mark.
+ (if (wl-message-redisplay folder num 'mime force-reload)
+ nil
+ ;; plugged, then leave server-mark.
+ (if (and
+ (not
+ (elmo-folder-local-p
+ wl-summary-buffer-elmo-folder))
+ (elmo-folder-plugged-p
+ wl-summary-buffer-elmo-folder))
+ 'leave))
+ t ; displayed
+ nil
+ 'cached ; cached by reading.
+ )
(setq wl-summary-buffer-current-msg num)
(when wl-summary-recenter
(recenter (/ (- (window-height) 2) 2))
(if (not wl-summary-width)
(wl-horizontal-recenter)))
(wl-highlight-summary-displaying)
- (wl-cache-prefetch-next fld num (current-buffer))
+ (wl-message-buffer-prefetch-next folder num (current-buffer)
+ wl-summary-buffer-mime-charset)
(run-hooks 'wl-summary-redisplay-hook))
(message "No message to display."))))
(defun wl-summary-redisplay-no-mime (&optional folder number)
(interactive)
- (let* ((msgdb wl-summary-buffer-msgdb)
- (fld (or folder wl-summary-buffer-folder-name))
+ (let* ((fld (or folder wl-summary-buffer-elmo-folder))
(num (or number (wl-summary-message-number)))
- (wl-mime-charset wl-summary-buffer-mime-charset)
- (default-mime-charset wl-summary-buffer-mime-charset)
wl-break-pages)
(if num
(progn
(setq wl-summary-buffer-last-displayed-msg
wl-summary-buffer-current-msg)
(setq wl-current-summary-buffer (current-buffer))
- (wl-normal-message-redisplay fld num 'no-mime msgdb)
+ (wl-message-redisplay fld num 'as-is)
(wl-summary-mark-as-read nil nil t)
(setq wl-summary-buffer-current-msg num)
(when wl-summary-recenter
(defun wl-summary-redisplay-all-header (&optional folder number)
(interactive)
- (let* ((msgdb wl-summary-buffer-msgdb)
- (fld (or folder wl-summary-buffer-folder-name))
+ (let* ((fld (or folder wl-summary-buffer-elmo-folder))
(num (or number (wl-summary-message-number)))
(wl-mime-charset wl-summary-buffer-mime-charset)
- (default-mime-charset wl-summary-buffer-mime-charset)
- (wl-message-redisplay-func wl-summary-buffer-message-redisplay-func))
+ (default-mime-charset wl-summary-buffer-mime-charset))
(if num
(progn
(setq wl-summary-buffer-disp-msg t)
(setq wl-summary-buffer-last-displayed-msg
wl-summary-buffer-current-msg)
(setq wl-current-summary-buffer (current-buffer))
- (if (wl-message-redisplay fld num 'all-header msgdb); t if displayed.
+ (if (wl-message-redisplay fld num 'all-header); t if displayed.
(wl-summary-mark-as-read nil nil t))
(setq wl-summary-buffer-current-msg num)
(when wl-summary-recenter
(defun wl-summary-jump-to-current-message ()
(interactive)
(let (message-buf message-win)
- (if (setq message-buf (get-buffer wl-message-buf-name))
+ (if (setq message-buf wl-message-buffer)
(if (setq message-win (get-buffer-window message-buf))
(select-window message-win)
- (wl-select-buffer (get-buffer wl-message-buf-name)))
+ (wl-message-select-buffer wl-message-buffer))
(wl-summary-redisplay)
- (wl-select-buffer (get-buffer wl-message-buf-name)))
+ (wl-message-select-buffer wl-message-buffer))
(goto-char (point-min))))
(defun wl-summary-cancel-message ()
(set-buffer message-buf))
(unless (wl-message-news-p)
(set-buffer summary-buf)
- (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
'nntp)
(y-or-n-p "Cannot get Newsgroups. Fetch again? "))
(progn
(set-buffer message-buf))
(unless (wl-message-news-p)
(set-buffer summary-buf)
- (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
'nntp)
(y-or-n-p "Cannot get Newsgroups. Fetch again? "))
(progn
(if (or (not (interactive-p))
(y-or-n-p "Print ok? "))
(progn
- (let* ((message-buffer (get-buffer wl-message-buf-name))
-;;; (summary-buffer (get-buffer wl-summary-buffer-name))
- (buffer (generate-new-buffer " *print*")))
- (set-buffer message-buffer)
+ (let ((buffer (generate-new-buffer " *print*")))
(copy-to-buffer buffer (point-min) (point-max))
(set-buffer buffer)
(funcall wl-print-buffer-func)
(let ((summary-buffer (current-buffer))
wl-break-pages)
(save-excursion
-;;; (wl-summary-set-message-buffer-or-redisplay)
- (wl-summary-redisplay-internal)
- (let* ((message-buffer (get-buffer wl-message-buf-name))
- (buffer (generate-new-buffer " *print*"))
+ (wl-summary-set-message-buffer-or-redisplay)
+ ;; (wl-summary-redisplay-internal)
+ (let* ((buffer (generate-new-buffer " *print*"))
(entity (progn
(set-buffer summary-buffer)
(assoc (cdr (assq
(wl-summary-message-number)
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
(elmo-msgdb-get-overview
- wl-summary-buffer-msgdb))))
+ (wl-summary-buffer-msgdb)))))
(wl-ps-subject
(and entity
(or (elmo-msgdb-overview-entity-get-subject entity)
(and entity
(or (elmo-msgdb-overview-entity-get-date entity) ""))))
(run-hooks 'wl-ps-preprint-hook)
- (set-buffer message-buffer)
+ (set-buffer wl-message-buffer)
(copy-to-buffer buffer (point-min) (point-max))
(set-buffer buffer)
(unwind-protect
(fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
(defun wl-summary-folder-info-update ()
- (let ((folder (elmo-string wl-summary-buffer-folder-name))
+ (let ((folder (elmo-string (wl-summary-buffer-folder-name)))
(num-db (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
(wl-folder-set-folder-updated folder
(list 0
(+ wl-summary-buffer-unread-count
(length num-db)))))
(defun wl-summary-get-newsgroups ()
- (let ((spec-list (elmo-folder-get-primitive-spec-list
- (elmo-string wl-summary-buffer-folder-name)))
+ (let ((folder-list (elmo-folder-get-primitive-list
+ wl-summary-buffer-elmo-folder))
ng-list)
- (while spec-list
- (when (eq (caar spec-list) 'nntp)
- (wl-append ng-list (list (nth 1 (car spec-list)))))
- (setq spec-list (cdr spec-list)))
+ (while folder-list
+ (when (eq (elmo-folder-type-internal (car folder-list)) 'nntp)
+ (wl-append ng-list (list (elmo-nntp-folder-group-internal
+ (car folder-list)))))
+ (setq folder-list (cdr folder-list)))
ng-list))
(defun wl-summary-set-crosspost (&optional type redisplay)
(let* ((number (wl-summary-message-number))
- (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name
- number))
- (folder (nth 1 spec))
message-buf newsgroups)
- (when (eq (car spec) 'nntp)
+ (when (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
+ 'nntp)
(if redisplay
(wl-summary-redisplay))
(save-excursion
(set-buffer message-buf))
(setq newsgroups (std11-field-body "newsgroups")))
(when newsgroups
- (let* ((msgdb wl-summary-buffer-msgdb)
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(num-db (elmo-msgdb-get-number-alist msgdb))
(ng-list (wl-summary-get-newsgroups)) ;; for multi folder
crosspost-folders)
type) ;;not used
(setq wl-crosspost-alist-modified t)))))))
-(defun wl-summary-is-crosspost-folder (spec-list fld-list)
- (let (fld flds)
- (while spec-list
- (if (and (eq (caar spec-list) 'nntp)
- (member (setq fld (nth 1 (car spec-list))) fld-list))
- (wl-append flds (list fld)))
- (setq spec-list (cdr spec-list)))
- flds))
+(defun wl-summary-is-crosspost-folder (folder-list groups)
+ "Returns newsgroup string list of FOLDER-LIST which are contained in GROUPS."
+ (let (group crosses)
+ (while folder-list
+ (if (and (eq (elmo-folder-type-internal (car folder-list)) 'nntp)
+ (member (setq group (elmo-nntp-folder-group-internal
+ (car folder-list))) groups))
+ (wl-append crosses (list group)))
+ (setq folder-list (cdr folder-list)))
+ crosses))
(defun wl-summary-update-crosspost ()
- (let* ((msgdb wl-summary-buffer-msgdb)
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (spec-list (elmo-folder-get-primitive-spec-list
- (elmo-string wl-summary-buffer-folder-name)))
+ (folder-list
+ (elmo-folder-get-primitive-list wl-summary-buffer-elmo-folder))
(alist elmo-crosspost-message-alist)
(crossed 0)
mark ngs num)
- (when (assq 'nntp spec-list)
+ (when (elmo-folder-contains-type wl-summary-buffer-elmo-folder 'nntp)
(while alist
(when (setq ngs
(wl-summary-is-crosspost-folder
- spec-list
+ folder-list
(nth 1 (car alist))))
(when (setq num (car (rassoc (caar alist) number-alist)))
(if (and (setq mark (cadr (assq num mark-alist)))
(defun wl-summary-pack-number (&optional arg)
(interactive "P")
- (setq wl-summary-buffer-msgdb
- (elmo-pack-number
- wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg))
+ (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
(let (wl-use-scoring)
(wl-summary-rescan)))
(message "Saved as %s" filename)))
(kill-buffer tmp-buf)))))
-(defun wl-summary-drop-unsync ()
- "Drop all unsync messages."
- (interactive)
- (if (elmo-folder-pipe-p wl-summary-buffer-folder-name)
- (error "You cannot drop unsync messages in this folder"))
- (if (or (not (interactive-p))
- (y-or-n-p "Drop all unsync messages? "))
- (let* ((folder-list (elmo-folder-get-primitive-folder-list
- wl-summary-buffer-folder-name))
- (is-multi (elmo-multi-p wl-summary-buffer-folder-name))
- (sum 0)
- (multi-num 0)
- pair)
- (message "Dropping...")
- (while folder-list
- (setq pair (elmo-max-of-folder (car folder-list)))
- (when is-multi ;; dirty hack...
- (incf multi-num)
- (setcar pair (+ (* multi-num elmo-multi-divide-number)
- (car pair))))
- (elmo-msgdb-set-number-alist
- wl-summary-buffer-msgdb
- (nconc
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
- (list (cons (car pair) nil))))
- (setq sum (+ sum (cdr pair)))
- (setq folder-list (cdr folder-list)))
- (wl-summary-set-message-modified)
- (wl-folder-set-folder-updated wl-summary-buffer-folder-name
- (list 0
- (+ wl-summary-buffer-unread-count
- wl-summary-buffer-new-count)
- sum))
- (message "Dropping...done"))))
+;; Someday
+;; (defun wl-summary-drop-unsync ()
+;; "Drop all unsync messages."
+;; (interactive)
+;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
+;; (error "You cannot drop unsync messages in this folder"))
+;; (if (or (not (interactive-p))
+;; (y-or-n-p "Drop all unsync messages? "))
+;; (let* ((folder-list (elmo-folder-get-primitive-folder-list
+;; (wl-summary-buffer-folder-name)))
+;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
+;; (sum 0)
+;; (multi-num 0)
+;; pair)
+;; (message "Dropping...")
+;; (while folder-list
+;; (setq pair (elmo-folder-message-numbers (car folder-list)))
+;; (when is-multi ;; dirty hack...
+;; (incf multi-num)
+;; (setcar pair (+ (* multi-num elmo-multi-divide-number)
+;; (car pair))))
+;; (elmo-msgdb-set-number-alist
+;; (wl-summary-buffer-msgdb)
+;; (nconc
+;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
+;; (list (cons (car pair) nil))))
+;; (setq sum (+ sum (cdr pair)))
+;; (setq folder-list (cdr folder-list)))
+;; (wl-summary-set-message-modified)
+;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
+;; (list 0
+;; (+ wl-summary-buffer-unread-count
+;; wl-summary-buffer-new-count)
+;; sum))
+;; (message "Dropping...done"))))
(defun wl-summary-default-get-next-msg (msg)
(let (next)
(wl-summary-next)))
(wl-summary-message-number))))))
-(defsubst wl-cache-prefetch-p (fld &optional num)
- (cond ((and num wl-cache-prefetch-folder-type-list)
- (memq
- (elmo-folder-number-get-type fld num)
- wl-cache-prefetch-folder-type-list))
- (wl-cache-prefetch-folder-type-list
- (let ((list wl-cache-prefetch-folder-type-list)
- type)
- (catch 'done
- (while (setq type (pop list))
- (if (elmo-folder-contains-type fld type)
- (throw 'done t))))))
- ((consp wl-cache-prefetch-folder-list)
- (wl-string-match-member fld wl-cache-prefetch-folder-list))
- (t
- wl-cache-prefetch-folder-list)))
-
-(defconst wl-cache-prefetch-idle-time
- (if (featurep 'lisp-float-type) (/ (float 1) (float 10)) 1))
-
-(defun wl-cache-prefetch-next (fld msg &optional summary)
- (if (wl-cache-prefetch-p fld)
- (if elmo-use-buffer-cache
-;;; (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.")
- (save-excursion
- (set-buffer (or summary (get-buffer wl-summary-buffer-name)))
- (let ((next (funcall wl-cache-prefetch-get-next-func msg)))
- (when (and next
- (wl-cache-prefetch-p fld next))
- (if (not (fboundp 'run-with-idle-timer))
- (when (sit-for wl-cache-prefetch-idle-time)
- (wl-cache-prefetch-message fld next summary))
- (run-with-idle-timer
- wl-cache-prefetch-idle-time
- nil
- 'wl-cache-prefetch-message fld next summary)
- (sit-for 0))))))))
-
-(defvar wl-cache-prefetch-debug nil)
-(defun wl-cache-prefetch-message (folder msg summary &optional next)
- (when (buffer-live-p summary)
- (save-excursion
- (set-buffer summary)
- (when (string= folder wl-summary-buffer-folder-name)
- (unless next
- (setq next msg))
- (let* ((msgdb wl-summary-buffer-msgdb)
- (message-id (cdr (assq next
- (elmo-msgdb-get-number-alist msgdb)))))
- (if (not (elmo-buffer-cache-hit (list folder next message-id)))
- (let* ((size (elmo-msgdb-overview-entity-get-size
- (assoc message-id
- (elmo-msgdb-get-overview msgdb)))))
- (when (or (elmo-local-file-p folder next)
- (not (and (integerp size)
- wl-cache-prefetch-threshold
- (>= size wl-cache-prefetch-threshold)
- (not (elmo-cache-exists-p message-id
- folder next)))))
- (if wl-cache-prefetch-debug
- (message "Reading %d..." msg))
- (elmo-buffer-cache-message folder next msgdb)
- (if wl-cache-prefetch-debug
- (message "Reading %d... done" msg))))))))))
-
(defun wl-summary-save-current-message ()
"Save current message for `wl-summary-yank-saved-message'."
(interactive)
;;;;;; each entity is (number opened-or-not children parent) ;;;;;;;
(defun wl-meaning-of-mark (mark)
- (if (not (elmo-folder-plugged-p wl-summary-buffer-folder-name))
+ (if (not (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
(cond
((string= mark wl-summary-unread-cached-mark)
'unread)
'important))))
(defun wl-thread-next-mark-p (mark next)
- (cond ((not (elmo-folder-plugged-p wl-summary-buffer-folder-name))
+ (cond ((not (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
(or (string= mark wl-summary-unread-cached-mark)
(string= mark wl-summary-important-mark)))
((eq next 'new)
(string= mark wl-summary-important-mark)))))
(defun wl-thread-next-failure-mark-p (mark next)
- (cond ((not (elmo-folder-plugged-p wl-summary-buffer-folder-name))
+ (cond ((not (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
(string= mark wl-summary-unread-cached-mark))
((or (eq next 'new)
(eq next 'unread))
(let (entities top-list)
(setq entities (wl-summary-load-file-object
(expand-file-name wl-thread-entity-file
- (elmo-msgdb-expand-path fld))))
+ (elmo-folder-msgdb-path fld))))
(setq top-list
(wl-summary-load-file-object
(expand-file-name wl-thread-entity-list-file
- (elmo-msgdb-expand-path fld))))
+ (elmo-folder-msgdb-path fld))))
(current-buffer)
(message "Resuming thread structure...")
;; set obarray value.
ret-val))
(defun wl-thread-entity-get-mark (number)
- (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (let ((mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
mark)
(setq mark (cadr (assq number mark-alist)))
(if (string= mark wl-summary-read-uncached-mark)
(defun wl-thread-get-next-unread (msg &optional hereto)
(let ((cur-entity (wl-thread-get-entity msg))
(next-marks (cond ((not (elmo-folder-plugged-p
- wl-summary-buffer-folder-name))
+ wl-summary-buffer-elmo-folder))
(cons (list (cons 'unread nil))
(list (cons 'important nil))))
((eq wl-summary-move-order 'new)
(cur 0)
entity)
(while (not (eobp))
- (unless (wl-thread-entity-get-opened
- (setq entity (wl-thread-get-entity
- (wl-summary-message-number))))
- (wl-thread-entity-force-open entity))
- (wl-thread-goto-bottom-of-sub-thread)
+ (if (wl-thread-entity-get-opened
+ (setq entity (wl-thread-get-entity
+ (wl-summary-message-number))))
+ (forward-line 1)
+ (wl-thread-force-open)
+ (wl-thread-goto-bottom-of-sub-thread))
(when (> len elmo-display-progress-threshold)
(setq cur (1+ cur))
(elmo-display-progress
(defun wl-thread-open-all-unread ()
(interactive)
- (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (let ((mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
mark)
(while mark-alist
(if (setq mark (nth 1 (car mark-alist)))
(defsubst wl-thread-update-line-on-buffer-sub (entity msg &optional parent-msg)
(let* ((entity (or entity (wl-thread-get-entity msg)))
(parent-msg (or parent-msg (wl-thread-entity-get-parent entity)))
- (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (overview (elmo-msgdb-get-overview (wl-summary-buffer-msgdb)))
+ (mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
(buffer-read-only nil)
(inhibit-read-only t)
overview-entity temp-mark summary-line invisible-top dest-pair)
(t (setq temp-mark (wl-summary-get-score-mark msg))))
(when (setq overview-entity
(elmo-msgdb-overview-get-entity
- msg wl-summary-buffer-msgdb))
+ msg (wl-summary-buffer-msgdb)))
(setq summary-line
(wl-summary-overview-create-summary-line
msg
overview-entity
(elmo-msgdb-overview-get-entity
- parent-msg wl-summary-buffer-msgdb)
+ parent-msg (wl-summary-buffer-msgdb))
nil
mark-alist
(if wl-thread-insert-force-opened
(if (not (setq invisible-top
(wl-thread-entity-parent-invisible-p entity)))
(wl-summary-update-thread
- (elmo-msgdb-overview-get-entity msg wl-summary-buffer-msgdb)
+ (elmo-msgdb-overview-get-entity msg (wl-summary-buffer-msgdb))
overview
mark-alist
entity
(and parent-msg
(elmo-msgdb-overview-get-entity
- parent-msg wl-summary-buffer-msgdb)))
+ parent-msg (wl-summary-buffer-msgdb))))
;; currently invisible.. update closed line.
(wl-thread-update-children-number invisible-top)))))
(while msgs
(setq children (wl-thread-entity-get-children
(setq entity (wl-thread-get-entity (car msgs)))))
- (when (elmo-msgdb-overview-get-entity (car msgs) wl-summary-buffer-msgdb)
+ (when (elmo-msgdb-overview-get-entity (car msgs) (wl-summary-buffer-msgdb))
(wl-append ret-val (list (car msgs)))
(setq children nil))
(setq msgs (cdr msgs))
mark-alist
child-entity
(elmo-msgdb-overview-get-entity
- parent-msg wl-summary-buffer-msgdb))
+ parent-msg (wl-summary-buffer-msgdb)))
(when parent
;; use thread structure.
(wl-thread-entity-get-nearly-older-brother
(defun wl-thread-msg-mark-as-important (msg)
"Set mark as important for invisible MSG. Modeline is not changed."
- (let* ((msgdb wl-summary-buffer-msgdb)
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(mark-alist (elmo-msgdb-get-mark-alist msgdb))
cur-mark)
(setq cur-mark (cadr (assq msg mark-alist)))
(/ (* cur 100) len)))))))
(defsubst wl-thread-insert-entity-sub (indent entity parent-entity all)
- (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (let ((mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
msg-num
overview-entity
temp-mark
(setq temp-mark (wl-summary-get-score-mark msg-num)))
(setq overview-entity
(elmo-msgdb-overview-get-entity
- (nth 0 entity) wl-summary-buffer-msgdb))
+ (nth 0 entity) (wl-summary-buffer-msgdb)))
;;; (wl-delete-all-overlays)
(when overview-entity
(setq summary-line
msg-num
overview-entity
(elmo-msgdb-overview-get-entity
- (nth 0 parent-entity) wl-summary-buffer-msgdb)
+ (nth 0 parent-entity) (wl-summary-buffer-msgdb))
(1+ indent)
mark-alist
(if wl-thread-insert-force-opened
(defun wl-thread-get-children-msgs-uncached (msg &optional uncached-marks)
(let ((children-msgs (wl-thread-get-children-msgs msg))
- (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
- (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
+ (mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
+ (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))
mark
uncached-list)
(while children-msgs
mark-alist)))
(member mark uncached-marks))
(and (not uncached-marks)
- (null (elmo-cache-exists-p
- (cdr (assq (car children-msgs)
- number-alist)))))))
+ (null (elmo-file-cache-exists-p
+ (elmo-message-field
+ wl-summary-buffer-elmo-folder
+ (car children-msgs)
+ 'message-id))))))
(wl-append uncached-list (list (car children-msgs))))
(setq children-msgs (cdr children-msgs)))
uncached-list))
(` (save-excursion
(if (buffer-live-p wl-current-summary-buffer)
(set-buffer wl-current-summary-buffer))
- wl-message-buf-name)))
+ wl-message-buffer)))
(defmacro wl-kill-buffers (regexp)
(` (mapcar (function
(flist (or wl-biff-check-folder-list (list wl-default-folder)))
folder)
(if (eq (length flist) 1)
- (wl-biff-check-folder-async (car flist) (interactive-p))
+ (wl-biff-check-folder-async (wl-folder-get-elmo-folder
+ (car flist)) (interactive-p))
(unwind-protect
(while flist
- (setq folder (car flist)
+ (setq folder (wl-folder-get-elmo-folder (car flist))
flist (cdr flist))
(when (elmo-folder-plugged-p folder)
(setq new-mails
(wl-biff-notify new-mails (interactive-p)))))))
(defun wl-biff-check-folder (folder)
- (if (eq (elmo-folder-get-type folder) 'pop3)
+ (if (eq (elmo-folder-type folder) 'pop3)
;; pop3 biff should share the session.
(prog2
- (elmo-commit folder) ; Close session.
- (wl-folder-check-one-entity folder)
- (elmo-commit folder))
+ (elmo-folder-close folder) ; Close session.
+ (wl-folder-check-one-entity (elmo-folder-name-internal folder))
+ (elmo-folder-close folder))
(let ((elmo-network-session-name-prefix "BIFF-"))
- (wl-folder-check-one-entity folder))))
+ (wl-folder-check-one-entity (elmo-folder-name-internal folder)))))
(defun wl-biff-check-folder-async-callback (diff data)
(if (nth 1 data)
(with-current-buffer (nth 1 data)
- (wl-folder-entity-hashtb-set wl-folder-entity-hashtb (nth 0 data)
+ (wl-folder-entity-hashtb-set wl-folder-entity-hashtb
+ (nth 0 data)
(list (car diff) 0 (cdr diff))
(current-buffer))))
(setq wl-folder-info-alist-modified t)
(defun wl-biff-check-folder-async (folder notify-minibuf)
(when (elmo-folder-plugged-p folder)
- (let ((type (elmo-folder-get-type folder)))
- (if (and (eq type 'imap4)
- (wl-folder-use-server-diff-p folder))
- ;; Check asynchronously only when IMAP4 and use server diff.
- (progn
- (setq elmo-folder-diff-async-callback
- 'wl-biff-check-folder-async-callback)
- (setq elmo-folder-diff-async-callback-data
- (list folder (get-buffer wl-folder-buffer-name)
- notify-minibuf))
- (let ((elmo-network-session-name-prefix "BIFF-"))
- (elmo-folder-diff-async folder)))
- (wl-biff-notify (car (wl-biff-check-folder folder))
- notify-minibuf)
- (setq wl-biff-check-folders-running nil)))))
+ (if (and (eq (elmo-folder-type-internal folder) 'imap4)
+ (elmo-folder-use-flag-p folder))
+ ;; Check asynchronously only when IMAP4 and use server diff.
+ (progn
+ (setq elmo-folder-diff-async-callback
+ 'wl-biff-check-folder-async-callback)
+ (setq elmo-folder-diff-async-callback-data
+ (list (elmo-folder-name-internal folder)
+ (get-buffer wl-folder-buffer-name)
+ notify-minibuf))
+ (let ((elmo-network-session-name-prefix "BIFF-"))
+ (elmo-folder-diff-async folder)))
+ (wl-biff-notify (car (wl-biff-check-folder folder))
+ notify-minibuf)
+ (setq wl-biff-check-folders-running nil))))
(require 'product)
(product-provide (provide 'wl-util) (require 'wl-version))
(repeat (regexp :tag "Folder Regexp")))
:group 'wl-pref)
-(defcustom wl-no-save-folder-list '("^/.*$")
+(defcustom wl-no-save-folder-list '("^/.*$" "^\\[.*$")
"All folders that match this list won't save its msgdb.
Each elements are regexp of folder name."
:type '(repeat (regexp :tag "Folder Regexp"))
"*Icon file for archive folder.")
(defvar wl-pipe-folder-icon "pipe.xpm"
"*Icon file for pipe folder.")
+(defvar wl-nmz-folder-icon "nmz.xpm"
+ "*Icon file for localdir folder.")
(defvar wl-maildir-folder-icon "maildir.xpm"
"*Icon file for maildir folder.")
(defvar wl-empty-trash-folder-icon "trash-e.xpm"
"Wanderlust" nil
(eval-when-compile
(product-version (product-find 'elmo-version))) ; equals to ELMO version.
- "Smooth"))
+ "Smooth Criminal"))
;; set version-string
(product-version-as-string 'wl-version)
((string= fld-name wl-queue-folder);; queue folder
(get 'wl-folder-queue-glyph 'glyph))
(;; and one of many other folders
- (setq type (elmo-folder-get-type fld-name))
+ (setq type (elmo-folder-type fld-name))
(get (intern (format "wl-folder-%s-glyph" type)) 'glyph))))))
(let ((end (point-at-eol)))
(when wl-use-highlight-mouse-line
(wl-folder-archive-glyph . wl-archive-folder-icon)
(wl-folder-pipe-glyph . wl-pipe-folder-icon)
(wl-folder-maildir-glyph . wl-maildir-folder-icon)
+ (wl-folder-nmz-glyph . wl-nmz-folder-icon)
(wl-folder-trash-empty-glyph . wl-empty-trash-folder-icon)
(wl-folder-draft-glyph . wl-draft-folder-icon)
(wl-folder-queue-glyph . wl-queue-folder-icon)
;;; Code:
;;
-(require 'elmo2)
+(require 'elmo)
(require 'wl-version) ; reduce recursive-load-depth
;; from x-face.el
(require 'wl-highlight)
(eval-when-compile
+ (require 'cl)
(require 'smtp)
(require 'wl-score)
(unless wl-on-nemacs
(let ((summaries (wl-collect-summary)))
(while summaries
(set-buffer (pop summaries))
- (wl-summary-msgdb-save)
- ;; msgdb is saved, but cache is not saved yet.
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)
(wl-summary-set-message-modified))))
(setq wl-biff-check-folders-running nil)
(if wl-plugged
wl-auto-flush-queue)
(wl-draft-queue-flush))
(when (and (eq major-mode 'wl-summary-mode)
- (elmo-folder-plugged-p wl-summary-buffer-folder-name))
- (let* ((msgdb-dir (elmo-msgdb-expand-path
- wl-summary-buffer-folder-name))
+ (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
+ (let* ((msgdb-dir (elmo-folder-msgdb-path
+ wl-summary-buffer-elmo-folder))
(seen-list (elmo-msgdb-seen-load msgdb-dir)))
(setq seen-list
(wl-summary-flush-pending-append-operations seen-list))
;;; wl-plugged-mode
(defvar wl-plugged-port-label-alist
- (list (cons elmo-default-nntp-port "nntp")
- (cons elmo-default-imap4-port "imap4")
- (cons elmo-default-pop3-port "pop3")))
+ (list (cons 119 "nntp")
+ (cons 143 "imap4")
+ (cons 110 "pop3")))
;;(cons elmo-pop-before-smtp-port "pop3")
(defconst wl-plugged-switch-variables
(defun wl-plugged-sending-queue-info ()
;; sending queue status
(let (alist msgs sent-via server port)
- (setq msgs (elmo-list-folder wl-queue-folder))
+ (setq msgs (elmo-folder-list-messages
+ (wl-folder-get-elmo-folder wl-queue-folder)))
(while msgs
(setq sent-via (wl-draft-queue-info-operation (car msgs) 'get-sent-via))
(while sent-via
(if (string= last (caar dop-queue))
(wl-append operation (list ope))
;;(setq count (1+ count))
- (when (and last (setq server-info (elmo-folder-portinfo last)))
+ (when (and last (setq server-info (elmo-net-port-info last)))
(setq alist
(wl-append-assoc-list
(cons (car server-info) (nth 1 server-info)) ;; server port
(wl-plugged-sending-queue-status qinfo))))
(insert line "\n"))
(while alist
- (setq server (caaar alist)
- port (cdaar alist)
+ (setq server (nth 0 (caar alist))
+ port (nth 1 (caar alist))
label (nth 1 (car alist))
plugged (nth 2 (car alist))
time (nth 3 (car alist)))
(wl-plugged-redrawing-switch
wl-plugged-port-indent plugged time)
(setq alist (cdr alist))))
+ (sit-for 0)
(set-buffer-modified-p nil))
(defun wl-plugged-change ()
(name (elmo-match-buffer 3))
(plugged (not (string= switch wl-plugged-plug-on)))
(alist wl-plugged-alist)
- server port)
+ server port stream-type name-1)
(cond
((eq indent wl-plugged-port-indent) ;; toggle port plug
(cond
((string-match "\\([^([]*\\)(\\([^)[]+\\))" name)
- (setq port (string-to-int (elmo-match-string 2 name))))
+ (setq port (string-to-int (elmo-match-string 2 name)))
+ (if (string-match "!" (setq name-1 (elmo-match-string 1 name)))
+ (setq stream-type
+ (intern (substring name-1 (match-end 0))))))
(t
(setq port name)))
(setq server (wl-plugged-get-server))
- (elmo-set-plugged plugged server port nil alist))
+ (elmo-set-plugged plugged server port stream-type nil alist))
((eq indent wl-plugged-server-indent) ;; toggle server plug
- (elmo-set-plugged plugged name nil nil alist))
+ (elmo-set-plugged plugged name nil nil nil alist))
((eq indent 0) ;; toggle all plug
- (elmo-set-plugged plugged nil nil nil alist)))
+ (elmo-set-plugged plugged nil nil nil nil alist)))
;; redraw
(wl-plugged-redrawing wl-plugged-alist)
;; show plugged status in modeline
(save-excursion
(let ((summaries (wl-collect-summary)))
(while summaries
- (set-buffer (car summaries))
- (unless keep-summary
- (wl-summary-cleanup-temp-marks))
- (wl-summary-save-status keep-summary)
- (unless keep-summary
- (kill-buffer (car summaries)))
+ (with-current-buffer (car summaries)
+ (unless keep-summary
+ (wl-summary-cleanup-temp-marks))
+ (wl-summary-save-view keep-summary)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)
+ (unless keep-summary
+ (kill-buffer (car summaries))))
(setq summaries (cdr summaries))))))
(wl-refile-alist-save)
(wl-folder-info-save)
(run-hooks 'wl-exit-hook)
(wl-save-status)
(wl-folder-cleanup-variables)
- (elmo-cleanup-variables)
+ (wl-message-buffer-cache-clean-up)
(wl-kill-buffers
(format "^\\(%s\\)$"
(mapconcat 'identity
- (list (format "%s\\(:.*\\)?"
- (default-value 'wl-message-buf-name))
- wl-original-buf-name
- wl-folder-buffer-name
+ (list wl-folder-buffer-name
wl-plugged-buf-name)
"\\|")))
- (elmo-buffer-cache-clean-up)
- (if (fboundp 'mmelmo-cleanup-entity-buffers)
- (mmelmo-cleanup-entity-buffers))
(setq wl-init nil)
(unless wl-on-nemacs
(remove-hook 'kill-emacs-hook 'wl-save-status))
(progn
(message "Checking environment...")
(wl-check-environment arg)
- (message "Checking environment...done")))
- (if demo-buf
- (kill-buffer demo-buf))
+ (message "Checking environment...done"))
+ demo-buf)
(if succeed
(setq wl-init t))
;; This hook may contain the functions `wl-plugged-init-icons' and
(error "Please set `wl-message-id-domain'"))
;; folders
(when (not no-check-folder)
- (if (not (eq (elmo-folder-get-type wl-draft-folder) 'localdir))
- (error "%s is not allowed for draft folder" wl-draft-folder))
- (unless (elmo-folder-exists-p wl-draft-folder)
- (if (y-or-n-p
- (format "Draft Folder %s does not exist, create it? "
- wl-draft-folder))
- (elmo-create-folder wl-draft-folder)
- (error "Draft Folder is not created")))
- (if (and wl-draft-enable-queuing
- (not (elmo-folder-exists-p wl-queue-folder)))
+ (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+ (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
+ (trash-folder (wl-folder-get-elmo-folder wl-trash-folder))
+ (lost+found-folder (wl-folder-get-elmo-folder
+ elmo-lost+found-folder)))
+ (if (not (elmo-folder-message-file-p draft-folder))
+ (error "%s is not allowed for draft folder" wl-draft-folder))
+ (unless (elmo-folder-exists-p draft-folder)
+ (if (y-or-n-p
+ (format "Draft Folder %s does not exist, create it? "
+ wl-draft-folder))
+ (elmo-folder-create draft-folder)
+ (error "Draft Folder is not created")))
+ (if (and wl-draft-enable-queuing
+ (not (elmo-folder-exists-p queue-folder)))
+ (if (y-or-n-p
+ (format "Queue Folder %s does not exist, create it? "
+ wl-queue-folder))
+ (elmo-folder-create queue-folder)
+ (error "Queue Folder is not created")))
+ (when (not (eq no-check-folder 'wl-draft))
+ (unless (elmo-folder-exists-p trash-folder)
+ (if (y-or-n-p
+ (format "Trash Folder %s does not exist, create it? "
+ wl-trash-folder))
+ (elmo-folder-create trash-folder)
+ (error "Trash Folder is not created")))
+ (unless (elmo-folder-exists-p lost+found-folder)
+ (elmo-folder-create lost+found-folder)))
+ ;; tmp dir
+ (unless (file-exists-p wl-tmp-dir)
(if (y-or-n-p
- (format "Queue Folder %s does not exist, create it? "
- wl-queue-folder))
- (elmo-create-folder wl-queue-folder)
- (error "Queue Folder is not created"))))
- (when (not (eq no-check-folder 'wl-draft))
- (unless (elmo-folder-exists-p wl-trash-folder)
- (if (y-or-n-p
- (format "Trash Folder %s does not exist, create it? "
- wl-trash-folder))
- (elmo-create-folder wl-trash-folder)
- (error "Trash Folder is not created")))
- (unless (elmo-folder-exists-p elmo-lost+found-folder)
- (elmo-create-folder elmo-lost+found-folder)))
- ;; tmp dir
- (unless (file-exists-p wl-tmp-dir)
- (if (y-or-n-p
- (format "Temp directory (to save multipart) %s does not exist, create it now? "
- wl-tmp-dir))
- (make-directory wl-tmp-dir)
- (error "Temp directory is not created"))))
+ (format "Temp directory (to save multipart) %s does not exist, create it now? "
+ wl-tmp-dir))
+ (make-directory wl-tmp-dir)
+ (error "Temp directory is not created"))))))
;;;###autoload
(defun wl (&optional arg)
If ARG (prefix argument) is specified, folder checkings are skipped."
(interactive "P")
(or wl-init (wl-load-profile))
- (unwind-protect
- (wl-init arg)
- (wl-plugged-init (wl-folder arg))
- (sit-for 0))
- (unwind-protect
- (unless arg
- (run-hooks 'wl-auto-check-folder-pre-hook)
- (wl-folder-auto-check)
- (run-hooks 'wl-auto-check-folder-hook))
- (unless arg (wl-biff-start))
- (run-hooks 'wl-hook)))
+ (let (demo-buf)
+ (unwind-protect
+ (setq demo-buf (wl-init arg))
+ (wl-plugged-init (wl-folder arg)))
+ (unwind-protect
+ (unless arg
+ (run-hooks 'wl-auto-check-folder-pre-hook)
+ (wl-folder-auto-check)
+ (run-hooks 'wl-auto-check-folder-hook))
+ (if (buffer-live-p demo-buf)
+ (kill-buffer demo-buf))
+ (unless arg (wl-biff-start))
+ (run-hooks 'wl-hook))))
;; Define some autoload functions WL might use.
(eval-and-compile
projects / elisp / wanderlust.git / commitdiff