From: teranisi Date: Wed, 7 Feb 2001 01:28:23 +0000 (+0000) Subject: Working branch `elmo-lunafy' is created. X-Git-Tag: wl-2_8-root^2~48 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ac6f5a43dcf9323d25a0bb8c3420007817a923d1;p=elisp%2Fwanderlust.git Working branch `elmo-lunafy' is created. The aim of this branch is: * lunafy elmo (Rearrange elmo module). * section-based message caching. * message buffer caching & prefetching. * elmo-nmz.el See MEMO-lunafy for more detail. Note that it is verrry alpha status. Currently some features do not work (or very unstable). --- diff --git a/doc/TODO.ja b/doc/TODO.ja index d329d56..1cead6e 100644 --- a/doc/TODO.ja +++ b/doc/TODO.ja @@ -1,5 +1,3 @@ -elmo-search $B$G(B msgdb $B$H%U%)%k%@K\BN$r%7!<%`%l%9$K8!:w(B -pick/virtual $B$N(B completion $BE}9g(B msgdb $B9=B$$N8+D>$7$H(B obarray $B2=(B $B=EMW%^!<%/$N4IM}(B $B%5%^%j%U%)!<%^%C%H<+M32=(B diff --git a/elmo/ChangeLog b/elmo/ChangeLog index f67e4ca..c302d33 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,147 @@ +2001-02-06 Yuuichi Teranishi + + * elmo-mark.el: New file. + + * elmo-internal.el: Rewrite (Almost empty). + +2001-02-05 Yuuichi Teranishi + + * mmimap.el (mmimap-make-mime-entity): Consider message/rfc822. + (mime-imap-entity-header-string): Ditto. + (mmimap-entity-section): Rewrite. + +2001-01-30 Yuuichi Teranishi + + * elmo-nmz.el: New file. + + * elmo-pipe.el: Rewrite with luna. + +2001-01-29 Yuuichi Teranishi + + * 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 + + * elmo-archive.el (elmo-archive-version): Abolish. + (toplevel) Removed `boso' comment. + +2001-01-23 Yuuichi Teranishi + + * 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 + + * elmo-filter.el: Rewrite with luna. + +2001-01-18 Yuuichi Teranishi + + * elmo-pop3.el: Rewrite with luna. + +2001-01-17 Yuuichi Teranishi + + * 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 + + * 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 + + * elmo.el: Changed meaning of `elmo-folder-commit'. + * elmo-mime.el (elmo-mime-display-as-is-internal): New function. + +2001-01-07 Yuuichi Teranishi + + * elmo.el (elmo-folder-append-buffer): New function. + (Renamed from `elmo-append-msg') + +2000-12-18 Yuuichi Teranishi + + * elmo-mime.el: New file. + +2000-12-14 Yuuichi Teranishi + + * elmo-cache.el: Rewrite. + +2000-12-08 Yuuichi Teranishi + + * 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 + + * 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 + + * elmo.el: New file. + + * elmo2.el: Renamed to elmo.el. + + 2001-02-01 OKAZAKI Tetsurou * elmo-cache.el (elmo-cache-expire-by-size): Count diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 478eabb..07760d9 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -29,7 +29,6 @@ ;;; Commentary: ;; ;; TODO: -;; [¥Ü¥½] append-msgs() ¤¬Íߤ·¤¤¡Ê¤±¤É multi-refile ÉԲġˡ£ ;; Info-Zip ÀìÍÑ¥¨¡¼¥¸¥§¥ó¥È¤òÍѤ¤¤¿ÆüËܸ측º÷¡ÊOS/2 ÀìÍÑ¡Ë¡£ ;;; Code: @@ -40,9 +39,6 @@ (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)) @@ -75,6 +71,53 @@ (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.") @@ -235,38 +278,35 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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 @@ -276,37 +316,45 @@ TYPE specifies the archiver's symbol." (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)))) @@ -316,12 +364,12 @@ TYPE specifies the archiver's symbol." (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) @@ -338,18 +386,17 @@ TYPE specifies the archiver's symbol." 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) @@ -359,16 +406,16 @@ TYPE specifies the archiver's symbol." ((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))) @@ -393,20 +440,23 @@ TYPE specifies the archiver's symbol." (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) @@ -415,85 +465,111 @@ TYPE specifies the archiver's symbol." (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)))) @@ -506,153 +582,169 @@ TYPE specifies the archiver's symbol." (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*"))) @@ -785,35 +877,34 @@ TYPE specifies the archiver's symbol." (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...") @@ -821,7 +912,8 @@ TYPE specifies the archiver's symbol." (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 @@ -835,7 +927,8 @@ TYPE specifies the archiver's symbol." (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) @@ -854,70 +947,68 @@ TYPE specifies the archiver's symbol." '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 @@ -951,7 +1042,8 @@ TYPE specifies the archiver's symbol." (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) @@ -973,11 +1065,11 @@ TYPE specifies the archiver's symbol." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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 @@ -988,21 +1080,23 @@ TYPE specifies the archiver's symbol." (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)) @@ -1012,17 +1106,6 @@ TYPE specifies the archiver's symbol." (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. - - ;;; method(alist) (if (null elmo-archive-method-alist) (let ((mlist elmo-archive-method-list) ; from mew-highlight.el @@ -1049,28 +1132,10 @@ TYPE specifies the archiver's symbol." (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) diff --git a/elmo/elmo-cache.el b/elmo/elmo-cache.el index 01ee8f8..7d20f60 100644 --- a/elmo/elmo-cache.el +++ b/elmo/elmo-cache.el @@ -33,63 +33,113 @@ (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) @@ -238,44 +288,6 @@ If KBYTES is kilo bytes (This value must be float)." (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))) @@ -326,7 +338,7 @@ If KBYTES is kilo bytes (This value must be float)." (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." @@ -358,75 +370,7 @@ If KBYTES is kilo bytes (This value must be float)." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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 ;; diff --git a/elmo/elmo-date.el b/elmo/elmo-date.el index 52e4c66..75fbb5c 100644 --- a/elmo/elmo-date.el +++ b/elmo/elmo-date.el @@ -31,10 +31,67 @@ (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]) diff --git a/elmo/elmo-dop.el b/elmo/elmo-dop.el index 0ff603c..64b7dbe 100644 --- a/elmo/elmo-dop.el +++ b/elmo/elmo-dop.el @@ -29,12 +29,10 @@ ;;; 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 @@ -42,7 +40,8 @@ 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 @@ -60,7 +59,7 @@ even an operation concerns the unplugged folder." (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) @@ -213,7 +212,7 @@ even an operation concerns the unplugged folder." (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 @@ -221,13 +220,13 @@ even an operation concerns the unplugged folder." (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) @@ -241,13 +240,13 @@ even an operation concerns the unplugged folder." (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 @@ -291,41 +290,32 @@ even an operation concerns the unplugged folder." (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))) @@ -349,6 +339,26 @@ even an operation concerns the unplugged 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 diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index 854a1f9..2bc3276 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -28,110 +28,213 @@ ;;; 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)) diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 04c98ff..9a17632 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -40,17 +40,88 @@ (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 ;; @@ -64,10 +135,6 @@ (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) @@ -130,36 +197,26 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") (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*") @@ -168,6 +225,17 @@ Debug information is inserted in the buffer \"*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) @@ -359,6 +427,42 @@ If response is not `OK' response, causes error with IMAP response text." (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) @@ -502,191 +606,52 @@ BUFFER must be a single-byte buffer." (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. @@ -736,10 +701,11 @@ Returns response value if selecting folder succeed. " ;; 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 @@ -747,149 +713,6 @@ Returns response value if selecting folder succeed. " "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. @@ -964,67 +787,6 @@ If CHOP-LENGTH is not specified, message set is not chopped." 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 @@ -1056,7 +818,8 @@ If optional argument UNMARK is non-nil, unmark." (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))) @@ -1079,53 +842,6 @@ If optional argument UNMARK is non-nil, unmark." (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 @@ -1254,7 +970,7 @@ If optional argument UNMARK is non-nil, unmark." 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) @@ -1319,14 +1035,18 @@ If optional argument UNMARK is non-nil, unmark." (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)) @@ -1334,55 +1054,7 @@ If optional argument UNMARK is non-nil, unmark." (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 @@ -1402,88 +1074,24 @@ If optional argument UNMARK is non-nil, unmark." (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 @@ -1491,10 +1099,11 @@ If optional argument UNMARK is non-nil, unmark." (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) @@ -1504,57 +1113,24 @@ If optional argument UNMARK is non-nil, unmark." (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. @@ -2166,6 +1742,733 @@ Return nil if no complete line has arrived." (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)) diff --git a/elmo/elmo-internal.el b/elmo/elmo-internal.el index 461287c..b9de021 100644 --- a/elmo/elmo-internal.el +++ b/elmo/elmo-internal.el @@ -28,242 +28,36 @@ ;;; 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)) diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index 02a8b1f..1cb113c 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -32,103 +32,122 @@ ;;; 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)) @@ -142,7 +161,7 @@ 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) @@ -157,197 +176,136 @@ (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) @@ -358,22 +316,22 @@ (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) @@ -384,45 +342,22 @@ (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.. @@ -445,23 +380,23 @@ (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 @@ -472,15 +407,6 @@ (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)) diff --git a/elmo/elmo-localnews.el b/elmo/elmo-localnews.el index 6b72e1f..0193664 100644 --- a/elmo/elmo-localnews.el +++ b/elmo/elmo-localnews.el @@ -31,104 +31,14 @@ ;;; 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)) diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el index 6c83f5d..069a88b 100644 --- a/elmo/elmo-maildir.el +++ b/elmo/elmo-maildir.el @@ -30,59 +30,150 @@ ;; (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 @@ -104,9 +195,9 @@ This variable should not be used in elsewhere.") 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 @@ -133,7 +224,8 @@ This variable should not be used in elsewhere.") (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." @@ -147,113 +239,50 @@ This variable should not be used in elsewhere.") (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) @@ -301,13 +330,17 @@ file name for maildir directories." 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. @@ -320,207 +353,146 @@ file name for maildir directories." ;; 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)) diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el new file mode 100644 index 0000000..09866e2 --- /dev/null +++ b/elmo/elmo-map.el @@ -0,0 +1,304 @@ +;;; elmo-map.el -- A ELMO folder class with message number mapping. + +;; Copyright (C) 2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/elmo/elmo-mark.el b/elmo/elmo-mark.el new file mode 100644 index 0000000..9fcc326 --- /dev/null +++ b/elmo/elmo-mark.el @@ -0,0 +1,219 @@ +;;; elmo-mark.el -- Global mark folder for ELMO. + +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el new file mode 100644 index 0000000..74cd30f --- /dev/null +++ b/elmo/elmo-mime.el @@ -0,0 +1,319 @@ +;;; elmo-mime.el -- MIME module for ELMO. + +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 80833b9..9fc5e8f 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -38,100 +38,6 @@ (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)) @@ -145,10 +51,10 @@ FOLDER should be a sring of folder name or folder spec." (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 @@ -201,60 +107,6 @@ FOLDER should be a sring of folder name or folder spec." 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) @@ -403,6 +255,16 @@ header separator." (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) @@ -478,50 +340,40 @@ header separator." (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) @@ -647,12 +499,11 @@ content of MSGDB is changed." (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) @@ -685,16 +536,20 @@ content of MSGDB is changed." 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 () @@ -709,6 +564,30 @@ content of MSGDB is changed." 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." @@ -717,7 +596,7 @@ 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")) @@ -746,6 +625,55 @@ Header region is supposed to be narrowed." 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 @@ -764,7 +692,7 @@ Header region is supposed to be narrowed." (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) @@ -797,9 +725,8 @@ Header region is supposed to be narrowed." (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 @@ -807,66 +734,8 @@ Header region is supposed to be narrowed." (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 @@ -917,6 +786,24 @@ Header region is supposed to be narrowed." 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)) diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index 6a7a3a6..ff5fe05 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -29,9 +29,71 @@ ;;; 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 @@ -51,142 +113,174 @@ (+ 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) @@ -198,92 +292,95 @@ (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)) @@ -293,13 +390,14 @@ (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)) @@ -307,36 +405,37 @@ (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 @@ -352,31 +451,30 @@ (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)) @@ -384,40 +482,65 @@ (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)) diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el index e97c9b2..aac2884 100644 --- a/elmo/elmo-net.el +++ b/elmo/elmo-net.el @@ -26,10 +26,24 @@ ;;; 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") @@ -45,7 +59,7 @@ ;; (eval-and-compile (luna-define-class elmo-network-session () (name - host + server port user auth @@ -101,24 +115,29 @@ (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) @@ -126,25 +145,21 @@ (` (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 @@ -159,19 +174,25 @@ if making session failed, returns nil." (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). @@ -180,7 +201,7 @@ Returns a process object. if making session failed, returns nil." (let ((session (luna-make-entity class :name name - :host host + :server server :port port :user user :auth auth @@ -190,7 +211,7 @@ Returns a process object. if making session failed, returns nil." (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) ""))) @@ -204,7 +225,7 @@ Returns a process object. if making session failed, returns nil." 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) @@ -216,7 +237,7 @@ Returns a process object. if making session failed, returns nil." (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) @@ -229,20 +250,250 @@ Returns a process object. if making session failed, returns nil." (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)) diff --git a/elmo/elmo-nmz.el b/elmo/elmo-nmz.el new file mode 100644 index 0000000..df740a7 --- /dev/null +++ b/elmo/elmo-nmz.el @@ -0,0 +1,253 @@ +;;; elmo-nmz.el -- Namazu interface for ELMO. + +;; Copyright (C) 2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 1fc88a0..1389529 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -33,12 +33,63 @@ ;;; 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)) @@ -85,7 +136,7 @@ Don't cache if nil.") (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))) @@ -97,7 +148,7 @@ Don't cache if nil.") (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 @@ -166,15 +217,11 @@ Don't cache if nil.") 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 @@ -314,8 +361,7 @@ Don't cache if nil.") (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) @@ -365,31 +411,41 @@ Don't cache if nil.") 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)) @@ -407,22 +463,27 @@ Don't cache if nil.") (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)) @@ -453,31 +514,34 @@ Don't cache if nil.") (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))) @@ -496,12 +560,10 @@ Don't cache if nil.") (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)) @@ -528,39 +590,43 @@ Don't cache if nil.") (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 @@ -571,14 +637,14 @@ Don't cache if nil.") (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 @@ -593,7 +659,6 @@ Don't cache if nil.") ("xref" . 8))) (defun elmo-nntp-create-msgdb-from-overview-string (str - folder new-mark already-mark seen-mark @@ -654,7 +719,8 @@ Don't cache if nil.") (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) @@ -668,73 +734,38 @@ Don't cache if nil.") (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 @@ -742,52 +773,88 @@ Don't cache if nil.") 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 @@ -799,18 +866,18 @@ Don't cache if nil.") (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) @@ -860,10 +927,16 @@ Don't cache if nil.") (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 @@ -877,19 +950,14 @@ Don't cache if nil.") (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) @@ -941,46 +1009,36 @@ Don't cache if nil.") (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 @@ -1003,13 +1061,13 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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) @@ -1063,43 +1121,46 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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 @@ -1200,15 +1261,15 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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] @@ -1311,7 +1372,8 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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) @@ -1335,39 +1397,13 @@ Returns a list of cons cells like (NUMBER . VALUE)" '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)) diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el index f17f9f9..5ffb4d0 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -29,30 +29,69 @@ ;;; 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.") @@ -61,89 +100,116 @@ (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)) diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 363345d..d52f853 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -40,12 +40,84 @@ (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) @@ -67,25 +139,25 @@ (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) @@ -96,8 +168,9 @@ (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) @@ -238,7 +311,7 @@ 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)) @@ -301,7 +374,7 @@ ;; 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 @@ -327,21 +400,24 @@ (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)) @@ -388,10 +464,10 @@ (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 @@ -402,18 +478,46 @@ (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 @@ -425,25 +529,23 @@ (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) @@ -518,7 +620,22 @@ (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 @@ -532,33 +649,15 @@ 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 @@ -649,8 +748,8 @@ (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) @@ -669,7 +768,7 @@ (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) @@ -682,17 +781,30 @@ (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 @@ -727,62 +839,28 @@ (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)) diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 55fdc6a..523f1b5 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -29,9 +29,9 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) (require 'elmo-vars) (require 'elmo-date) -(eval-when-compile (require 'cl)) (require 'std11) (require 'eword-decode) (require 'utf7) @@ -72,19 +72,6 @@ (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) @@ -101,31 +88,11 @@ (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." @@ -172,16 +139,6 @@ File content is encoded 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 @@ -189,306 +146,6 @@ File content is encoded with MIME-CHARSET." (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 -(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 "[^/ \")|&]*") @@ -630,13 +287,6 @@ Return value is a cons cell of (STRUCTURE . REST)" (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) @@ -654,6 +304,13 @@ Return value is a cons cell of (STRUCTURE . REST)" (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)) @@ -854,49 +511,6 @@ Return value is a cons cell of (STRUCTURE . REST)" (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) @@ -950,23 +564,27 @@ Otherwise treat \\ in NEWTEXT string as special: (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 @@ -979,11 +597,12 @@ Otherwise treat \\ in NEWTEXT string as special: (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) @@ -993,7 +612,7 @@ Otherwise treat \\ in NEWTEXT string as special: 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) @@ -1011,7 +630,7 @@ Otherwise treat \\ in NEWTEXT string as special: (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))) @@ -1021,9 +640,11 @@ Otherwise treat \\ in NEWTEXT string as special: (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) @@ -1091,6 +712,7 @@ Otherwise treat \\ in NEWTEXT string as special: (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 @@ -1104,7 +726,7 @@ Otherwise treat \\ in NEWTEXT string as special: (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." @@ -1116,42 +738,6 @@ Otherwise treat \\ in NEWTEXT string as special: ;; 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 @@ -1203,68 +789,6 @@ Otherwise treat \\ in NEWTEXT string as special: (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))) @@ -1448,28 +972,28 @@ Emacs 19.28 or earlier does not have `unintern'." ":" "__") "|" "_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 @@ -1478,7 +1002,7 @@ Emacs 19.28 or earlier does not have `unintern'." (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)) @@ -1760,6 +1284,55 @@ NUMBER-SET is altered." (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)) diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index 8df13bf..fe2ad92 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -30,47 +30,16 @@ ;; (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" @@ -103,8 +72,10 @@ Each elements are regexp of folder name (This is obsolete).") "*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 @@ -151,9 +122,8 @@ For disconnected operations.") (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.") @@ -163,19 +133,10 @@ For disconnected operations.") (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. @@ -211,10 +172,6 @@ If function, return value of function.") (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)) @@ -241,19 +198,6 @@ If function, return value of function.") (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) @@ -266,9 +210,6 @@ FEATURE is a symbol of the feature for OPEN-STREAM-FUNCTION. 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).") @@ -308,7 +249,7 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") (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") @@ -319,15 +260,9 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") ("/" . " 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.") @@ -337,10 +272,6 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") "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 diff --git a/elmo/elmo.el b/elmo/elmo.el new file mode 100644 index 0000000..cd53bfb --- /dev/null +++ b/elmo/elmo.el @@ -0,0 +1,1225 @@ +;;; elmo.el -- Elisp Library for Message Orchestration + +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/elmo/elmo2.el b/elmo/elmo2.el deleted file mode 100644 index cb21136..0000000 --- a/elmo/elmo2.el +++ /dev/null @@ -1,928 +0,0 @@ -;;; elmo2.el -- ELMO main file (I don't remember why this is 2). - -;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi - -;; Author: Yuuichi Teranishi -;; 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 diff --git a/elmo/mmimap.el b/elmo/mmimap.el new file mode 100644 index 0000000..e945fd1 --- /dev/null +++ b/elmo/mmimap.el @@ -0,0 +1,280 @@ +;;; mmimap.el --- MIME entity module for IMAP4rev1 (RFC2060). +;; **** This is EXPERIMENTAL ***** + +;; Copyright (C) 2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/etc/icons/nmz.xpm b/etc/icons/nmz.xpm new file mode 100644 index 0000000..1710fde --- /dev/null +++ b/etc/icons/nmz.xpm @@ -0,0 +1,35 @@ +/* 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# ", +" $# "}; diff --git a/etc/icons/wl-beta-logo.xpm b/etc/icons/wl-beta-logo.xpm index b873642..dc9acd0 100644 --- a/etc/icons/wl-beta-logo.xpm +++ b/etc/icons/wl-beta-logo.xpm @@ -1,209 +1,435 @@ /* 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 ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/utils/bbdb-wl.el b/utils/bbdb-wl.el index 7c1a86a..c7be695 100644 --- a/utils/bbdb-wl.el +++ b/utils/bbdb-wl.el @@ -80,7 +80,7 @@ (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)) @@ -138,7 +138,7 @@ the user confirms the creation." (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 @@ -195,7 +195,7 @@ of the BBDB record corresponding to the sender of this message." "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) @@ -218,7 +218,7 @@ displaying the record corresponding to the sender of the current message." (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 @@ -256,27 +256,29 @@ displaying the record corresponding to the sender of the current message." ;;; @ 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) diff --git a/wl/ChangeLog b/wl/ChangeLog index fbe8512..23050bf 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,100 @@ 2001-02-06 Yuuichi Teranishi + * wl-summary.el (wl-summary-save-view): Renamed from + `wl-summary-save-status'. + +2001-01-23 Yuuichi Teranishi + + * 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 + + * wl-message.el (wl-message-prev-page): Ignore errors while + scroll-down. + +2001-01-14 Yuuichi Teranishi + + * 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 + + * 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. + + +2001-02-06 Yuuichi Teranishi + * 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'. diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 057cbf3..ddc1e18 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -540,16 +540,20 @@ Reply to author if WITH-ARG is non-nil." (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 @@ -568,8 +572,11 @@ Reply to author if WITH-ARG is non-nil." 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)))) @@ -593,11 +600,8 @@ Reply to author if WITH-ARG is non-nil." (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:" @@ -1046,7 +1050,7 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'." (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) @@ -1220,7 +1224,8 @@ If optional argument is non-nil, current draft buffer is killed" (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)) @@ -1247,13 +1252,14 @@ If optional argument is non-nil, current draft buffer is killed" 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))))) @@ -1297,20 +1303,22 @@ If optional argument is non-nil, current draft buffer is killed" (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)) @@ -1452,14 +1460,10 @@ If optional argument is non-nil, current draft buffer is killed" (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)) @@ -1692,7 +1696,8 @@ If optional argument is non-nil, current draft buffer is killed" (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) @@ -1717,7 +1722,8 @@ If optional argument is non-nil, current draft buffer is killed" (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) @@ -1751,15 +1757,14 @@ If optional argument is non-nil, current draft buffer is killed" (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 @@ -1771,11 +1776,12 @@ If optional argument is non-nil, current draft buffer is killed" (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)) @@ -1806,8 +1812,9 @@ If optional argument is non-nil, current draft buffer is killed" 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 @@ -1820,7 +1827,8 @@ If optional argument is non-nil, current draft buffer is killed" (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))) @@ -1838,10 +1846,8 @@ If optional argument is non-nil, current draft buffer is killed" (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 @@ -1861,7 +1867,8 @@ If optional argument is non-nil, current draft buffer is killed" (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) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 1c99c8e..5bc86c1 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -58,6 +58,7 @@ ;;; Code: ;; +(require 'elmo) (eval-when-compile (require 'wl-folder) (require 'wl-summary) @@ -352,7 +353,7 @@ ((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))) @@ -406,7 +407,7 @@ (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)) @@ -429,6 +430,7 @@ (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) @@ -525,7 +527,8 @@ (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) @@ -540,7 +543,8 @@ (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) diff --git a/wl/wl-expire.el b/wl/wl-expire.el index 178dab0..752f550 100644 --- a/wl/wl-expire.el +++ b/wl/wl-expire.el @@ -30,6 +30,7 @@ (require 'wl-summary) (require 'wl-thread) (require 'wl-folder) +(require 'elmo) ;;; Code: @@ -105,14 +106,11 @@ (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!"))))) @@ -128,32 +126,29 @@ 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 @@ -161,19 +156,21 @@ &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))) @@ -181,28 +178,29 @@ If REFILE-LIST includes reserve mark message, so copy." ;; 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 @@ -211,17 +209,15 @@ If REFILE-LIST includes reserve mark message, so copy." 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!")))) @@ -229,40 +225,40 @@ If REFILE-LIST includes reserve mark message, so copy." (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) @@ -270,7 +266,8 @@ If REFILE-LIST includes reserve mark message, so copy." (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)))))) @@ -280,9 +277,12 @@ If REFILE-LIST includes reserve mark message, so copy." (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 @@ -473,32 +473,32 @@ Refile to archive folder followed message date." 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 @@ -515,7 +515,7 @@ Refile to archive folder followed message date." ((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))) @@ -578,9 +578,13 @@ Refile to archive folder followed message date." (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 )))) @@ -593,25 +597,28 @@ Refile to archive folder followed message date." (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)))))))))) @@ -675,19 +682,19 @@ Refile to archive folder followed message date." 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")))) @@ -721,7 +728,7 @@ Refile to archive folder followed message date." (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 diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index 0fb0b9e..990bcc6 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -751,54 +751,57 @@ return value is diffs '(-new -unread -all)." (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) @@ -819,8 +822,7 @@ return value is diffs '(-new -unread -all)." (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)) @@ -840,14 +842,15 @@ return value is diffs '(-new -unread -all)." (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 () @@ -901,9 +904,11 @@ return value is diffs '(-new -unread -all)." (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)) @@ -970,9 +975,10 @@ return value is diffs '(-new -unread -all)." (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 diff --git a/wl/wl-folder.el b/wl/wl-folder.el index ba7ad28..93f8890 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -33,7 +33,7 @@ (require 'elmo-vars) (require 'elmo-util) -(require 'elmo2) +(require 'elmo) (require 'wl-vars) (condition-case () (require 'easymenu) ; needed here. @@ -44,12 +44,7 @@ (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. @@ -57,6 +52,8 @@ (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) @@ -85,7 +82,7 @@ ["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] @@ -155,7 +152,7 @@ (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) @@ -293,7 +290,9 @@ 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 @@ -307,6 +306,27 @@ (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)) @@ -447,7 +467,8 @@ 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 @@ -479,7 +500,7 @@ (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) @@ -519,28 +540,29 @@ Optional argument ARG is repeart count." (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)) @@ -582,33 +604,33 @@ Optional argument ARG is repeart count." (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 @@ -646,7 +668,8 @@ Optional argument ARG is repeart count." (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)) @@ -768,10 +791,10 @@ Optional argument ARG is repeart count." ;(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 @@ -782,38 +805,18 @@ Optional argument ARG is repeart count." (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) @@ -821,7 +824,7 @@ Optional argument ARG is repeart count." (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))) @@ -833,12 +836,14 @@ Optional argument ARG is repeart count." (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) @@ -855,50 +860,61 @@ Optional argument ARG is repeart count." (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)) @@ -971,12 +987,13 @@ If current line is group folder, check all sub entries." (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) @@ -985,11 +1002,10 @@ If current line is group folder, check all sub entries." (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))))))))) @@ -1019,27 +1035,26 @@ If current line is group folder, check all subfolders." (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 () @@ -1075,7 +1090,8 @@ If current line is group folder, all subfolders are marked." (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) @@ -1306,7 +1322,8 @@ If current line is group folder, all subfolders are marked." (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)) @@ -1446,8 +1463,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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)) @@ -1479,11 +1496,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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) @@ -1532,11 +1544,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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))) @@ -1726,19 +1739,19 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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) @@ -1749,7 +1762,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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))) @@ -1758,8 +1770,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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)) @@ -1770,7 +1781,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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))) @@ -1820,22 +1831,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." ;; (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) @@ -1845,38 +1840,45 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." ((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)) @@ -1947,7 +1949,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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 @@ -1955,11 +1957,13 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." 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))) @@ -1983,6 +1987,7 @@ Entering Folder mode calls the value of `wl-folder-mode-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 @@ -1997,12 +2002,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." 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) @@ -2015,15 +2020,17 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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) @@ -2035,8 +2042,10 @@ If FOLDER is multi, return comma separated string (cross post)." "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) @@ -2060,11 +2069,12 @@ Don't care multi." (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 @@ -2133,6 +2143,7 @@ Use `wl-subscribed-mailing-list'." ;; 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) @@ -2161,23 +2172,18 @@ Use `wl-subscribed-mailing-list'." (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)) @@ -2194,7 +2200,8 @@ Use `wl-subscribed-mailing-list'." (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 @@ -2622,9 +2629,7 @@ Use `wl-subscribed-mailing-list'." (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) @@ -2634,7 +2639,9 @@ Use `wl-subscribed-mailing-list'." (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)) @@ -2662,52 +2669,50 @@ If current line is group folder, all subfolders are prefetched." (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 () "" @@ -2727,26 +2732,27 @@ If optional arg exists, don't check any folders." (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)))) diff --git a/wl/wl-message.el b/wl/wl-message.el index 297e4a3..ff05986 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -31,110 +31,283 @@ (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) @@ -142,184 +315,27 @@ (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)) @@ -329,233 +345,198 @@ (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)) diff --git a/wl/wl-mime.el b/wl/wl-mime.el index 833954a..a249d8d 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -54,10 +54,10 @@ 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 @@ -133,8 +133,12 @@ By setting following-method as yank-content." (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) @@ -162,10 +166,12 @@ By setting following-method as yank-content." (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)) @@ -175,13 +181,13 @@ By setting following-method as yank-content." (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)) @@ -190,8 +196,8 @@ By setting following-method as yank-content." (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.") @@ -218,22 +224,32 @@ By setting following-method as yank-content." (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 @@ -251,7 +267,8 @@ By setting following-method as yank-content." ;; 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) @@ -273,15 +290,15 @@ By setting following-method as yank-content." ;;; 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) @@ -290,17 +307,17 @@ By setting following-method as yank-content." '((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)) @@ -310,7 +327,7 @@ By setting following-method as yank-content." '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 @@ -319,9 +336,11 @@ By setting following-method as yank-content." (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) diff --git a/wl/wl-score.el b/wl/wl-score.el index a0d93b8..112ccba 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -353,7 +353,7 @@ Set `wl-score-cache' nil." (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) @@ -395,9 +395,9 @@ Set `wl-score-cache' nil." (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) @@ -926,11 +926,11 @@ Set `wl-score-cache' nil." (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 @@ -946,8 +946,8 @@ Set `wl-score-cache' nil." (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))) @@ -996,9 +996,9 @@ Set `wl-score-cache' nil." (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)))) @@ -1182,8 +1182,8 @@ Set `wl-score-cache' nil." (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)) @@ -1195,14 +1195,13 @@ Set `wl-score-cache' nil." (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) @@ -1213,7 +1212,7 @@ Set `wl-score-cache' nil." 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)) @@ -1244,22 +1243,22 @@ Set `wl-score-cache' nil." (/ (* 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) @@ -1294,13 +1293,12 @@ Set `wl-score-cache' nil." (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) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 9e31097..5104764 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -35,7 +35,7 @@ ;;; Code: ;; -(require 'elmo2) +(require 'elmo) (require 'elmo-multi) (require 'wl-message) (require 'wl-vars) @@ -45,6 +45,7 @@ (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 @@ -65,8 +66,18 @@ (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) @@ -110,6 +121,7 @@ (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) @@ -120,14 +132,14 @@ (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) @@ -136,7 +148,6 @@ (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) @@ -179,8 +190,8 @@ (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) @@ -194,7 +205,7 @@ (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)) @@ -375,7 +386,7 @@ (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) @@ -543,7 +554,7 @@ (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) @@ -568,7 +579,7 @@ If ARG is non-nil, Supersedes message" (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)) @@ -673,54 +684,31 @@ you." (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) @@ -768,11 +756,6 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." ;;;(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)) @@ -829,7 +812,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." "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)) @@ -854,7 +837,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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) @@ -903,7 +886,9 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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) @@ -953,10 +938,14 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." "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) @@ -965,41 +954,6 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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 @@ -1024,7 +978,8 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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. @@ -1032,9 +987,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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." @@ -1046,7 +999,6 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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) @@ -1056,18 +1008,20 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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. @@ -1091,41 +1045,12 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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) @@ -1134,8 +1059,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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) @@ -1146,40 +1070,13 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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)))) @@ -1190,16 +1087,14 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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. @@ -1284,41 +1179,41 @@ Optional argument ADDR-STR is used as a target address if specified." (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. @@ -1334,7 +1229,7 @@ If ARG is non-nil, checking is omitted." "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))) @@ -1349,7 +1244,7 @@ If ARG is non-nil, checking is omitted." (< 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) @@ -1378,33 +1273,33 @@ If ARG is non-nil, checking is omitted." (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 @@ -1426,7 +1321,7 @@ If ARG is non-nil, checking is omitted." (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)))))))) @@ -1457,10 +1352,10 @@ If ARG is non-nil, checking is omitted." (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)) @@ -1615,7 +1510,7 @@ If ARG is non-nil, checking is omitted." (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) @@ -1648,7 +1543,7 @@ If ARG is non-nil, checking is omitted." (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) @@ -1679,16 +1574,16 @@ If ARG is non-nil, checking is omitted." (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) @@ -1697,8 +1592,7 @@ If ARG is non-nil, checking is omitted." (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) @@ -1707,7 +1601,7 @@ If ARG is non-nil, checking is omitted." (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 " ") @@ -1731,7 +1625,7 @@ If ARG is non-nil, checking is omitted." (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) @@ -1744,8 +1638,8 @@ If ARG is non-nil, checking is omitted." (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) @@ -1770,9 +1664,10 @@ If ARG is non-nil, checking is omitted." (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) @@ -1784,9 +1679,9 @@ If ARG is non-nil, checking is omitted." (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) @@ -1802,7 +1697,7 @@ If ARG is non-nil, checking is omitted." (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 -> ! @@ -1833,7 +1728,7 @@ If ARG is non-nil, checking is omitted." (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))) @@ -1861,7 +1756,7 @@ If ARG is non-nil, checking is omitted." (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)) @@ -1932,10 +1827,10 @@ If ARG is non-nil, checking is omitted." (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) @@ -1950,11 +1845,11 @@ If ARG is non-nil, checking is omitted." (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)) @@ -2044,29 +1939,26 @@ If ARG is non-nil, checking is omitted." (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)) @@ -2131,125 +2023,74 @@ If ARG is non-nil, checking is omitted." (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 @@ -2261,14 +2102,14 @@ If ARG is non-nil, checking is omitted." (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 @@ -2287,55 +2128,52 @@ If ARG is non-nil, checking is omitted." 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) ;; @@ -2355,8 +2193,8 @@ If ARG is non-nil, checking is omitted." (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) @@ -2438,7 +2276,7 @@ If ARG is non-nil, checking is omitted." (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 @@ -2446,14 +2284,15 @@ If ARG is non-nil, checking is omitted." (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 @@ -2462,44 +2301,46 @@ If ARG is non-nil, checking is omitted." (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)) @@ -2562,14 +2403,17 @@ If ARG, without confirm." (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." @@ -2580,24 +2424,24 @@ If ARG, without confirm." (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 @@ -2632,7 +2476,7 @@ If ARG, without confirm." (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) @@ -2646,60 +2490,42 @@ If ARG, without confirm." (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 @@ -2710,7 +2536,7 @@ If ARG, without confirm." (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) @@ -2720,7 +2546,7 @@ If ARG, without confirm." (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) @@ -2735,19 +2561,14 @@ If ARG, without confirm." (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 @@ -2757,7 +2578,7 @@ If ARG, without confirm." (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)) @@ -2771,7 +2592,7 @@ If ARG, without confirm." (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) @@ -2804,9 +2625,6 @@ If ARG, without confirm." 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)) @@ -2815,7 +2633,8 @@ If ARG, without confirm." ;; 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. @@ -2944,14 +2763,14 @@ If ARG, without confirm." (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 @@ -3082,8 +2901,8 @@ If ARG, without confirm." (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) @@ -3119,14 +2938,14 @@ If ARG, without confirm." (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)) @@ -3140,7 +2959,7 @@ If ARG, without confirm." (+ 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) @@ -3265,7 +3084,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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 @@ -3294,24 +3113,20 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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 @@ -3320,7 +3135,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." ;; 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))))) @@ -3329,24 +3144,19 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." ;; 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 @@ -3394,8 +3204,13 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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) @@ -3448,7 +3263,7 @@ If folder is read-only, message should be copied. 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) @@ -3469,12 +3284,11 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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) @@ -3498,8 +3312,9 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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/" @@ -3508,14 +3323,8 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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)) @@ -3569,11 +3378,11 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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) @@ -3586,10 +3395,10 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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)) @@ -3609,7 +3418,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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)) @@ -3719,10 +3528,10 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." ;; 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) @@ -3806,7 +3615,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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)) @@ -3859,9 +3668,9 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (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 @@ -3880,10 +3689,12 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." "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) @@ -3896,7 +3707,7 @@ If ARG, exit virtual folder." (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 () @@ -4019,10 +3830,10 @@ If ARG, exit virtual folder." (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 @@ -4083,7 +3894,7 @@ If ARG, exit virtual folder." (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 () @@ -4113,7 +3924,7 @@ If ARG, exit virtual folder." (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 () @@ -4143,7 +3954,7 @@ If ARG, exit virtual folder." (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 () @@ -4178,8 +3989,8 @@ If ARG, exit virtual folder." (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) @@ -4215,14 +4026,16 @@ If ARG, exit virtual folder." (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 @@ -4234,7 +4047,7 @@ If ARG, exit virtual folder." (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) @@ -4263,15 +4076,15 @@ If ARG, exit virtual folder." 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) @@ -4295,16 +4108,23 @@ If ARG, exit virtual folder." (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 " ")) @@ -4314,7 +4134,7 @@ If ARG, exit virtual folder." 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)) @@ -4323,10 +4143,7 @@ If ARG, exit virtual folder." (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))) @@ -4451,7 +4268,7 @@ If ARG, exit virtual folder." (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))))) @@ -4464,7 +4281,7 @@ If ARG, exit virtual folder." (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 @@ -4566,7 +4383,7 @@ If ARG, exit virtual folder." (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) @@ -4604,7 +4421,7 @@ If ARG, exit virtual folder." (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 @@ -4612,7 +4429,7 @@ If ARG, exit virtual folder." "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) @@ -4629,10 +4446,9 @@ If ARG, exit virtual 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) @@ -4643,8 +4459,9 @@ If ARG, exit virtual folder." ((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)) @@ -4668,7 +4485,8 @@ If ARG, exit virtual folder." (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 @@ -4681,13 +4499,14 @@ If ARG, exit virtual folder." (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!! @@ -4705,7 +4524,7 @@ If ARG, exit virtual folder." ;; 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)))) )))) @@ -4713,29 +4532,32 @@ If ARG, exit virtual folder." (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 @@ -4748,7 +4570,7 @@ If ARG, exit virtual folder." (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)) @@ -4756,6 +4578,7 @@ If ARG, exit virtual folder." ))))) (defun wl-summary-next-line-content () + "Show next line of the message." (interactive) (let ((cur-buf (current-buffer))) (wl-summary-toggle-disp-msg 'on) @@ -4780,37 +4603,31 @@ If ARG, exit virtual folder." (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") @@ -4880,13 +4697,13 @@ If ARG, exit virtual folder." (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) @@ -4901,7 +4718,7 @@ If ARG, exit virtual folder." 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\" ?" elmo-default-nntp-server) @@ -4928,11 +4745,11 @@ If ARG, exit virtual folder." 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 @@ -4960,7 +4777,7 @@ If ARG, exit virtual folder." (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? " @@ -4973,7 +4790,7 @@ If ARG, exit virtual folder." (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)) @@ -5062,26 +4879,25 @@ If ARG, exit virtual 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." @@ -5104,7 +4920,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5128,15 +4944,17 @@ Use function list is `wl-summary-write-current-folder-functions'." (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) @@ -5144,16 +4962,9 @@ Use function list is `wl-summary-write-current-folder-functions'." (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))))) @@ -5164,48 +4975,26 @@ Use function list is `wl-summary-write-current-folder-functions'." (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)) @@ -5239,13 +5028,12 @@ Use function list is `wl-summary-write-current-folder-functions'." (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)) @@ -5373,19 +5161,17 @@ Use function list is `wl-summary-write-current-folder-functions'." (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) @@ -5405,41 +5191,38 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5447,7 +5230,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5462,19 +5245,17 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5488,12 +5269,12 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 () @@ -5508,7 +5289,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5557,7 +5338,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5660,10 +5441,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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) @@ -5680,18 +5458,17 @@ Use function list is `wl-summary-write-current-folder-functions'." (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) @@ -5703,7 +5480,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5722,9 +5499,9 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5732,22 +5509,21 @@ Use function list is `wl-summary-write-current-folder-functions'." (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 @@ -5755,7 +5531,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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) @@ -5767,29 +5543,31 @@ Use function list is `wl-summary-write-current-folder-functions'." 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))) @@ -5832,9 +5610,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (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))) @@ -5906,40 +5682,41 @@ Use function list is `wl-summary-write-current-folder-functions'." (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) @@ -5959,71 +5736,6 @@ Use function list is `wl-summary-write-current-folder-functions'." (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) diff --git a/wl/wl-thread.el b/wl/wl-thread.el index e153785..81db491 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -54,7 +54,7 @@ ;;;;;; 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) @@ -70,7 +70,7 @@ '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) @@ -86,7 +86,7 @@ (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)) @@ -100,11 +100,11 @@ (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. @@ -268,7 +268,7 @@ ENTITY is returned." 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) @@ -492,7 +492,7 @@ The closed parent will be opened." (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) @@ -580,11 +580,12 @@ The closed parent will be opened." (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 @@ -598,7 +599,7 @@ The closed parent will be opened." (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))) @@ -662,8 +663,8 @@ The closed parent will be opened." (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) @@ -681,13 +682,13 @@ The closed parent will be opened." (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 @@ -703,13 +704,13 @@ The closed parent will be 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))))) @@ -792,7 +793,7 @@ The closed parent will be opened." (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)) @@ -960,7 +961,7 @@ Message is inserted to the summary buffer." 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 @@ -1061,7 +1062,7 @@ Message is inserted to the summary buffer." (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))) @@ -1167,7 +1168,7 @@ Message is inserted to the summary buffer." (/ (* 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 @@ -1186,7 +1187,7 @@ Message is inserted to the summary buffer." (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 @@ -1194,7 +1195,7 @@ Message is inserted to the summary buffer." 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 @@ -1307,8 +1308,8 @@ Message is inserted to the summary buffer." (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 @@ -1318,9 +1319,11 @@ Message is inserted to the summary buffer." 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)) diff --git a/wl/wl-util.el b/wl/wl-util.el index 6ad81f5..95aa7b9 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -552,7 +552,7 @@ that `read' can handle, whenever this is possible." (` (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 @@ -825,10 +825,11 @@ This function is imported from Emacs 20.7." (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 @@ -838,19 +839,20 @@ This function is imported from Emacs 20.7." (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) @@ -860,21 +862,21 @@ This function is imported from Emacs 20.7." (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)) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 2a37db4..bb26ae6 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -1524,7 +1524,7 @@ Each elements are regexp of folder name." (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")) @@ -2157,6 +2157,8 @@ XBM even if XPM can be shown." "*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" diff --git a/wl/wl-version.el b/wl/wl-version.el index c1280bd..b870a6d 100644 --- a/wl/wl-version.el +++ b/wl/wl-version.el @@ -46,7 +46,7 @@ "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) diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 8e95570..394fefe 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -284,7 +284,7 @@ ((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 @@ -371,6 +371,7 @@ (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) diff --git a/wl/wl.el b/wl/wl.el index 696716b..11e9326 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -31,7 +31,7 @@ ;;; Code: ;; -(require 'elmo2) +(require 'elmo) (require 'wl-version) ; reduce recursive-load-depth ;; from x-face.el @@ -69,6 +69,7 @@ (require 'wl-highlight) (eval-when-compile + (require 'cl) (require 'smtp) (require 'wl-score) (unless wl-on-nemacs @@ -106,8 +107,7 @@ (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 @@ -119,9 +119,9 @@ 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)) @@ -134,9 +134,9 @@ ;;; 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 @@ -235,7 +235,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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 @@ -281,7 +282,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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 @@ -336,8 +337,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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))) @@ -419,6 +420,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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 () @@ -497,20 +499,23 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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 @@ -612,12 +617,13 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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) @@ -634,19 +640,13 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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)) @@ -688,9 +688,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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 @@ -722,37 +721,42 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (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) @@ -760,17 +764,19 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." 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