*** dist/vm-delete.el.dist Thu Mar 27 20:34:53 2003 --- vm-delete.el Sat May 10 21:47:14 2003 *************** *** 332,334 **** ;; Set this so that if Emacs crashes or ! ;; the user quites without saving, we ;; have a record of messages that were --- 332,334 ---- ;; Set this so that if Emacs crashes or ! ;; the user quits without saving, we ;; have a record of messages that were *************** *** 337,339 **** ;; we won't re-retrieve messages the ! ;; user has already deal with. vm-pop-retrieved-messages --- 337,339 ---- ;; we won't re-retrieve messages the ! ;; user has already dealt with. vm-pop-retrieved-messages *************** *** 343,345 **** 'uidl) ! vm-pop-retrieved-messages)))) (vm-increment vm-modification-counter) --- 343,367 ---- 'uidl) ! vm-pop-retrieved-messages))) ! ((eq vm-folder-access-method 'imap) ! (setq vm-imap-messages-to-expunge ! (cons (cons ! (vm-imap-uid-of (vm-real-message-of (car mp))) ! (vm-imap-uid-validity-of ! (vm-real-message-of (car mp)))) ! vm-imap-messages-to-expunge) ! ;; Set this so that if Emacs crashes or ! ;; the user quits without saving, we ! ;; have a record of messages that were ! ;; retrieved and expunged locally. ! ;; When the user does M-x recover-file ! ;; we won't re-retrieve messages the ! ;; user has already dealt with. ! vm-imap-retrieved-messages ! (cons (list (vm-imap-uid-of ! (vm-real-message-of (car mp))) ! (vm-imap-uid-validity-of ! (vm-real-message-of (car mp))) ! (vm-folder-imap-maildrop-spec) ! 'uid) ! vm-imap-retrieved-messages)))) (vm-increment vm-modification-counter) *** dist/vm-folder.el.dist Thu Mar 27 20:34:53 2003 --- vm-folder.el Sat May 24 20:18:44 2003 *************** *** 1252,1254 **** (setq data (vm-convert-v4-attributes data)) ! ;; tink the message modflag so that if the ;; user saves we get rid of the old v4 --- 1252,1254 ---- (setq data (vm-convert-v4-attributes data)) ! ;; tink the message stuff flag so that if the ;; user saves we get rid of the old v4 *************** *** 1256,1258 **** ;; dealing with these things for all eternity. ! (vm-set-modflag-of (car mp) t)) (t --- 1256,1258 ---- ;; dealing with these things for all eternity. ! (vm-set-stuff-flag-of (car mp) t)) (t *************** *** 1263,1265 **** vm-attributes-vector-length) ! ;; tink the message modflag so that if ;; the user saves we get rid of the old --- 1263,1265 ---- vm-attributes-vector-length) ! ;; tink the message stuff flag so that if ;; the user saves we get rid of the old *************** *** 1268,1270 **** ;; eternity. ! (vm-set-modflag-of (car mp) t) (setcar data (vm-extend-vector --- 1268,1270 ---- ;; eternity. ! (vm-set-stuff-flag-of (car mp) t) (setcar data (vm-extend-vector *************** *** 1274,1276 **** vm-cache-vector-length) ! ;; tink the message modflag so that if ;; the user saves we get rid of the old --- 1274,1276 ---- vm-cache-vector-length) ! ;; tink the message stuff flag so that if ;; the user saves we get rid of the old *************** *** 1279,1281 **** ;; eternity. ! (vm-set-modflag-of (car mp) t) (setcar (cdr data) --- 1279,1281 ---- ;; eternity. ! (vm-set-stuff-flag-of (car mp) t) (setcar (cdr data) *************** *** 1388,1393 **** ;; since this function is usually called in lieu of reading ! ;; attributes from the buffer, the attributes may be ! ;; untrustworthy. tink the message modflag to force the ;; new attributes out if the user saves. ! (vm-set-modflag-of (car mp) t) (setq mp (cdr mp))))) --- 1388,1393 ---- ;; since this function is usually called in lieu of reading ! ;; attributes from the buffer, the buffer attributes may be ! ;; untrustworthy. tink the message stuff flag to force the ;; new attributes out if the user saves. ! (vm-set-stuff-flag-of (car mp) t) (setq mp (cdr mp))))) *************** *** 1740,1742 **** ;; summary entry cache. ! (vm-set-modflag-of (car mp) t) (setq mp (cdr mp)))))) --- 1740,1742 ---- ;; summary entry cache. ! (vm-set-stuff-flag-of (car mp) t) (setq mp (cdr mp)))))) *************** *** 1809,1811 **** (set-marker (vm-headers-of m) opoint))))) ! (vm-set-modflag-of m (not for-other-folder))) (set-buffer-modified-p old-buffer-modified-p)))))) --- 1809,1811 ---- (set-marker (vm-headers-of m) opoint))))) ! (vm-set-stuff-flag-of m (not for-other-folder))) (set-buffer-modified-p old-buffer-modified-p)))))) *************** *** 1818,1820 **** (while mp ! (if (vm-modflag-of (car mp)) (setq newlist (cons (car mp) newlist))) --- 1818,1820 ---- (while mp ! (if (vm-stuff-flag-of (car mp)) (setq newlist (cons (car mp) newlist))) *************** *** 3153,3155 **** (cond ((eq vm-folder-access-method 'pop) ! (vm-pop-synchronize-folder t t t nil))) ;; stuff the attributes of messages that need it. --- 3153,3157 ---- (cond ((eq vm-folder-access-method 'pop) ! (vm-pop-synchronize-folder t t t nil)) ! ((eq vm-folder-access-method 'imap) ! (vm-imap-synchronize-folder t t t nil t))) ;; stuff the attributes of messages that need it. *************** *** 3265,3267 **** (let ((name (cond ((eq vm-folder-access-method 'pop) ! (vm-pop-find-name-for-buffer (current-buffer)))))) (vm (or name buffer-file-name) nil vm-folder-access-method))) --- 3267,3271 ---- (let ((name (cond ((eq vm-folder-access-method 'pop) ! (vm-pop-find-name-for-buffer (current-buffer))) ! ((eq vm-folder-access-method 'imap) ! (vm-imap-find-name-for-buffer (current-buffer)))))) (vm (or name buffer-file-name) nil vm-folder-access-method))) *************** *** 3574,3576 **** (cond ((eq vm-folder-access-method 'pop) ! (vm-pop-folder-check-for-mail interactive))) (let ((triples (vm-compute-spool-files (not this-buffer-only))) --- 3578,3582 ---- (cond ((eq vm-folder-access-method 'pop) ! (vm-pop-folder-check-for-mail interactive)) ! ((eq vm-folder-access-method 'imap) ! (vm-imap-folder-check-for-mail interactive))) (let ((triples (vm-compute-spool-files (not this-buffer-only))) *************** *** 3627,3628 **** --- 3633,3636 ---- (vm-pop-synchronize-folder interactive nil nil t)) + ((eq vm-folder-access-method 'imap) + (vm-imap-synchronize-folder interactive nil nil t)) (t (vm-get-spooled-mail-normal interactive)))) *************** *** 3838,3840 **** ! ;; returns non-nil if there were any new messages (defun vm-assimilate-new-messages (&optional --- 3846,3848 ---- ! ;; returns list of new messages if there were any new messages, nil otherwise (defun vm-assimilate-new-messages (&optional *************** *** 4035,4038 **** (cond ((eq access-method 'pop) ! (setq vm-folder-access-method 'pop ! vm-folder-access-data (make-vector 2 nil)))) (use-local-map vm-mode-map) --- 4043,4049 ---- (cond ((eq access-method 'pop) ! (setq vm-folder-access-method 'pop ! vm-folder-access-data (make-vector 2 nil))) ! ((eq access-method 'imap) ! (setq vm-folder-access-method 'imap ! vm-folder-access-data (make-vector 9 nil)))) (use-local-map vm-mode-map) *** dist/vm-imap.el.dist Sat May 3 19:11:04 2003 --- vm-imap.el Mon May 26 09:50:09 2003 *************** *** 26,29 **** ! (defun vm-imap-capability (cap) ! (memq cap vm-imap-capabilities)) --- 26,33 ---- ! (defun vm-imap-capability (cap &optional process) ! (if process ! (save-excursion ! (set-buffer (process-buffer process)) ! (memq cap vm-imap-capabilities)) ! (memq cap vm-imap-capabilities))) *************** *** 32,33 **** --- 36,75 ---- + (defsubst vm-folder-imap-maildrop-spec () + (aref vm-folder-access-data 0)) + (defsubst vm-folder-imap-process () + (aref vm-folder-access-data 1)) + (defsubst vm-folder-imap-uid-validity () + (aref vm-folder-access-data 2)) + (defsubst vm-folder-imap-uid-list () + (aref vm-folder-access-data 3)) + (defsubst vm-folder-imap-mailbox-count () + (aref vm-folder-access-data 4)) + (defsubst vm-folder-imap-read-write () + (aref vm-folder-access-data 5)) + (defsubst vm-folder-imap-can-delete () + (aref vm-folder-access-data 6)) + (defsubst vm-folder-imap-body-peek () + (aref vm-folder-access-data 7)) + (defsubst vm-folder-imap-permanent-flags () + (aref vm-folder-access-data 8)) + + (defsubst vm-set-folder-imap-maildrop-spec (val) + (aset vm-folder-access-data 0 val)) + (defsubst vm-set-folder-imap-process (val) + (aset vm-folder-access-data 1 val)) + (defsubst vm-set-folder-imap-uid-validity (val) + (aset vm-folder-access-data 2 val)) + (defsubst vm-set-folder-imap-uid-list (val) + (aset vm-folder-access-data 3 val)) + (defsubst vm-set-folder-imap-mailbox-count (val) + (aset vm-folder-access-data 4 val)) + (defsubst vm-set-folder-imap-read-write (val) + (aset vm-folder-access-data 5 val)) + (defsubst vm-set-folder-imap-can-delete (val) + (aset vm-folder-access-data 6 val)) + (defsubst vm-set-folder-imap-body-peek (val) + (aset vm-folder-access-data 7 val)) + (defsubst vm-set-folder-imap-permanent-flags (val) + (aset vm-folder-access-data 8 val)) + ;; Our goal is to drag the mail from the IMAP maildrop to the crash box. *************** *** 39,41 **** (let ((process nil) - (folder-type vm-folder-type) (m-per-session vm-imap-messages-per-session) --- 81,82 ---- *************** *** 74,76 **** (set-buffer process-buffer) - (setq vm-folder-type (or folder-type vm-default-folder-type)) ;; find out how many messages are in the box. --- 115,116 ---- *************** *** 147,150 **** n)) ! (vm-imap-retrieve-to-crashbox process destination ! statblob t)) (progn --- 187,190 ---- n)) ! (vm-imap-retrieve-to-target process destination ! statblob t)) (progn *************** *** 153,156 **** "FETCH %d (RFC822.PEEK)" n)) ! (vm-imap-retrieve-to-crashbox process destination ! statblob nil))) (vm-increment retrieved) --- 193,196 ---- "FETCH %d (RFC822.PEEK)" n)) ! (vm-imap-retrieve-to-target process destination ! statblob nil))) (vm-increment retrieved) *************** *** 391,392 **** --- 431,433 ---- (let ((process-to-shutdown nil) + (folder-type vm-folder-type) process ooo *************** *** 468,469 **** --- 509,511 ---- (set-buffer process-buffer) + (setq vm-folder-type (or folder-type vm-default-folder-type)) (buffer-disable-undo process-buffer) *************** *** 599,616 **** (defun vm-imap-end-session (process &optional keep-buffer) ! (save-excursion ! (set-buffer (process-buffer process)) ! (vm-imap-send-command process "LOGOUT") ! ;; we don't care about the response. ! ;; try reading it anyway and see who complains. ! (vm-imap-read-ok-response process) ! (if (and (not vm-imap-keep-trace-buffer) (not keep-buffer)) ! (kill-buffer (process-buffer process)) (save-excursion ! (set-buffer (process-buffer process)) ! (rename-buffer (concat "saved " (buffer-name)) t) ! (vm-keep-some-buffers (current-buffer) 'vm-kept-imap-buffers ! vm-imap-keep-failed-trace-buffers))) ! (if (fboundp 'add-async-timeout) ! (add-async-timeout 2 'delete-process process) ! (run-at-time 2 nil 'delete-process process)))) --- 641,660 ---- (defun vm-imap-end-session (process &optional keep-buffer) ! (if (and (memq (process-status process) '(open run)) ! (buffer-live-p (process-buffer process))) (save-excursion ! (set-buffer (process-buffer process)) ! (vm-imap-send-command process "LOGOUT") ! ;; we don't care about the response. ! ;; try reading it anyway and see who complains. ! (vm-imap-read-ok-response process) ! (if (and (not vm-imap-keep-trace-buffer) (not keep-buffer)) ! (kill-buffer (process-buffer process)) ! (save-excursion ! (set-buffer (process-buffer process)) ! (rename-buffer (concat "saved " (buffer-name)) t) ! (vm-keep-some-buffers (current-buffer) 'vm-kept-imap-buffers ! vm-imap-keep-failed-trace-buffers))) ! (if (fboundp 'add-async-timeout) ! (add-async-timeout 2 'delete-process process) ! (run-at-time 2 nil 'delete-process process))))) *************** *** 751,753 **** (setq can-delete (vm-imap-scan-list-for-flag flags "\\Deleted")) ! (list msg-count uid-validity read-write can-delete) )) --- 795,797 ---- (setq can-delete (vm-imap-scan-list-for-flag flags "\\Deleted")) ! (list msg-count uid-validity read-write can-delete permanent-flags) )) *************** *** 878,880 **** ! (defun vm-imap-retrieve-to-crashbox (process crash statblob bodypeek) (let ((start vm-imap-read-point) --- 922,924 ---- ! (defun vm-imap-retrieve-to-target (process target statblob bodypeek) (let ((start vm-imap-read-point) *************** *** 937,940 **** (if (and (eq vm-folder-type 'babyl) ! (let ((attrs (file-attributes crash))) ! (or (null attrs) (equal 0 (nth 7 attrs))))) (let ((opoint (point))) --- 981,989 ---- (if (and (eq vm-folder-type 'babyl) ! (cond ((stringp target) ! (let ((attrs (file-attributes target))) ! (or (null attrs) (equal 0 (nth 7 attrs))))) ! ((bufferp target) ! (save-excursion ! (set-buffer target) ! (zerop (buffer-size)))))) (let ((opoint (point))) *************** *** 962,971 **** (insert-before-markers "\n")) ! ;; Set file type to binary for DOS/Windows. I don't know if ! ;; this is correct to do or not; it depends on whether the ! ;; the CRLF or the LF newline convention is used on the inbox ! ;; associated with this crashbox. This setting assumes the LF ! ;; newline convention is used. ! (let ((buffer-file-type t) ! (selective-display nil)) ! (write-region start end crash t 0)) (delete-region start end) --- 1011,1026 ---- (insert-before-markers "\n")) ! (if (stringp target) ! ;; Set file type to binary for DOS/Windows. I don't know if ! ;; this is correct to do or not; it depends on whether the ! ;; the CRLF or the LF newline convention is used on the inbox ! ;; associated with this crashbox. This setting assumes the LF ! ;; newline convention is used. ! (let ((buffer-file-type t) ! (selective-display nil)) ! (write-region start end target t 0)) ! (let ((b (current-buffer))) ! (save-excursion ! (set-buffer target) ! (let ((buffer-read-only nil)) ! (insert-buffer-substring b start end))))) (delete-region start end) *************** *** 1105,1107 **** (setq tail (cdr tail)))) - (vm-imap-bail-if-server-says-farewell list) list )) --- 1160,1161 ---- *************** *** 1272,1274 **** (defun vm-imap-bail-if-server-says-farewell (response) ! (if (vm-imap-response-matches response 'VM 'BYE) (throw 'end-of-session t))) --- 1326,1328 ---- (defun vm-imap-bail-if-server-says-farewell (response) ! (if (vm-imap-response-matches response '* 'BYE) (throw 'end-of-session t))) *************** *** 1293,1294 **** --- 1347,1363 ---- + ;; like Lisp get but for IMAP property lists like those returned by FETCH. + (defun vm-imap-plist-get (list name) + (setq list (cdr list)) + (let ((case-fold-search t) e) + (catch 'done + (while list + (setq e (car list)) + (if (not (eq (car e) 'atom)) + nil + (goto-char (nth 1 e)) + (if (eq (search-forward name (nth 2 e) t) (nth 2 e)) + (throw 'done (car (cdr list))))) + (setq list (cdr (cdr list)))) + nil ))) + (defun vm-imap-clear-invalid-retrieval-entries (source-nopwd retrieved *************** *** 1318,1319 **** --- 1387,1879 ---- (insert "\"")) + + (defun vm-establish-new-folder-imap-session (&optional interactive) + (let ((process (vm-folder-imap-process)) + mailbox select mailbox-count uid-validity permanent-flags + read-write can-delete body-peek + (vm-imap-ok-to-ask interactive)) + (if (processp process) + (vm-imap-end-session process)) + (setq process (vm-imap-make-session (vm-folder-imap-maildrop-spec))) + (vm-set-folder-imap-process process) + (setq mailbox (vm-imap-parse-spec-to-list (vm-folder-imap-maildrop-spec)) + mailbox (nth 3 mailbox)) + (save-excursion + (set-buffer (process-buffer process)) + (setq select (vm-imap-select-mailbox process mailbox)) + (setq mailbox-count (nth 0 select) + uid-validity (nth 1 select) + read-write (nth 2 select) + can-delete (nth 3 select) + permanent-flags (nth 4 select) + body-peek (vm-imap-capability 'IMAP4REV1))) + (vm-set-folder-imap-uid-validity uid-validity) + (vm-set-folder-imap-mailbox-count mailbox-count) + (vm-set-folder-imap-read-write read-write) + (vm-set-folder-imap-can-delete can-delete) + (vm-set-folder-imap-body-peek body-peek) + (vm-set-folder-imap-permanent-flags permanent-flags) + process )) + + (defun vm-imap-get-uid-data () + (if (eq 0 (vm-folder-imap-mailbox-count)) + (make-vector 67 0) + (let ((there (make-vector 67 0)) + (process (vm-folder-imap-process)) + (mailbox-count (vm-folder-imap-mailbox-count)) + list) + (save-excursion + (set-buffer (process-buffer process)) + (setq list (vm-imap-get-uid-list process 1 mailbox-count)) + (while list + (set (intern (cdr (car list)) there) (car (car list))) + (setq list (cdr list))) + there )))) + + (defun vm-imap-get-message-flags (process m &optional norecord) + (let (need-ok p r flag response saw-seen) + (save-excursion + (set-buffer (process-buffer process)) + (vm-imap-send-command process + (format "UID FETCH %s (FLAGS)" + (vm-imap-uid-of m))) + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response process)) + (if (vm-imap-response-matches response 'VM 'NO) + (error "server said NO to UID FETCH (FLAGS)")) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to UID FETCH (FLAGS)")) + (if (vm-imap-response-matches response '* 'BYE) + (vm-imap-protocol-error "server said BYE to UID FETCH (FLAGS)")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'FETCH 'atom 'list) + (setq r (nthcdr 3 response) + r (car r) + r (vm-imap-plist-get r "FLAGS") + r (cdr r)) + (while r + (setq p (car r)) + (if (not (eq (car p) 'atom)) + nil + (setq flag (downcase (buffer-substring (nth 1 p) (nth 2 p)))) + (cond ((string= flag "\\answered") + (vm-set-replied-flag m t norecord)) + ((string= flag "\\deleted") + (vm-set-deleted-flag m t norecord)) + ((string= flag "\\seen") + (vm-set-unread-flag m nil norecord) + (setq saw-seen t)) + ((string= flag "\\recent") + (vm-set-new-flag m t norecord)))) + (setq r (cdr r))) + (if (not saw-seen) + (vm-set-unread-flag m t norecord)))))))) + + (defun vm-imap-store-message-flags (process m perm-flags) + (let (need-ok flags response) + (save-excursion + (set-buffer (process-buffer process)) + (if (and (vm-replied-flag m) + (vm-imap-scan-list-for-flag perm-flags "\\Answered")) + (setq flags (cons (intern "\\Answered") flags))) + (if (and (not (vm-unread-flag m)) + (vm-imap-scan-list-for-flag perm-flags "\\Seen")) + (setq flags (cons (intern "\\Seen") flags))) + (if (and (vm-deleted-flag m) + (vm-imap-scan-list-for-flag perm-flags "\\Deleted")) + (setq flags (cons (intern "\\Deleted") flags))) + (vm-imap-send-command process + (format "UID STORE %s FLAGS %s" + (vm-imap-uid-of m) + (if flags flags "()"))) + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response process)) + (if (vm-imap-response-matches response 'VM 'NO) + (error "server said NO to UID FETCH (FLAGS)")) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to UID FETCH (FLAGS)")) + (if (vm-imap-response-matches response '* 'BYE) + (vm-imap-protocol-error "server said BYE to UID FETCH (FLAGS)")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + (vm-set-attribute-modflag-of m nil)))) + + (defun vm-imap-save-message (process m mailbox) + (let (need-ok need-plus flags response string) + ;; save the message's flag along with it. + ;; don't save the deleted flag. + (if (vm-replied-flag m) + (setq flags (cons (intern "\\Answered") flags))) + (if (not (vm-unread-flag m)) + (setq flags (cons (intern "\\Seen") flags))) + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of m))) + (save-restriction + (widen) + (setq string (buffer-substring (vm-headers-of m) (vm-text-end-of m))))) + (save-excursion + (set-buffer (process-buffer process)) + (condition-case nil + (vm-imap-create-mailbox process mailbox) + (error nil)) + (vm-imap-send-command process + (format "APPEND %s %s {%d}" + (vm-imap-quote-string mailbox) + (if flags flags "()") + (length string))) + (setq need-plus t) + (while need-plus + (setq response (vm-imap-read-response process)) + (if (vm-imap-response-matches response 'VM 'NO) + (error "server said NO to APPEND command")) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to APPEND command")) + (if (vm-imap-response-matches response '* 'BYE) + (vm-imap-protocol-error "server said BYE to APPEND command")) + (cond ((vm-imap-response-matches response '+) + (setq need-plus nil)))) + (vm-imap-send-command process string nil t) + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response process)) + (if (vm-imap-response-matches response 'VM 'NO) + (error "server said NO to APPEND data")) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to APPEND data")) + (if (vm-imap-response-matches response '* 'BYE) + (vm-imap-protocol-error "server said BYE to APPEND data")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil))))))) + + (defun vm-imap-get-synchronization-data () + (let ((here (make-vector 67 0)) + (there (vm-imap-get-uid-data)) + (process (vm-folder-imap-process)) + (uid-validity (vm-folder-imap-uid-validity)) + retrieve-list expunge-list + mp) + (setq mp vm-message-list) + (while mp + (if (or (null (vm-imap-uid-of (car mp))) + (not (equal (vm-imap-uid-validity-of (car mp)) uid-validity))) + nil + (set (intern (vm-imap-uid-of (car mp)) here) (car mp)) + (if (not (boundp (intern (vm-imap-uid-of (car mp)) there))) + (setq expunge-list (cons (car mp) expunge-list)))) + (setq mp (cdr mp))) + (mapatoms (function + (lambda (sym) + (if (and (not (boundp (intern (symbol-name sym) here))) + (not (assoc (symbol-name sym) + vm-imap-retrieved-messages))) + (setq retrieve-list (cons + (cons (symbol-name sym) + (symbol-value sym)) + retrieve-list))))) + there) + (list retrieve-list expunge-list))) + + (defun vm-imap-synchronize-folder (&optional interactive + do-remote-expunges + do-local-expunges + do-retrieves + do-attributes) + (if (and do-retrieves vm-block-new-mail) + (error "Can't get new mail until you save this folder.")) + (if (or vm-global-block-new-mail + (null (vm-establish-new-folder-imap-session interactive))) + nil + (if do-retrieves + (vm-assimilate-new-messages)) + (let* ((sync-data (vm-imap-get-synchronization-data)) + (retrieve-list (car sync-data)) + (local-expunge-list (nth 1 sync-data)) + (process (vm-folder-imap-process)) + (n 1) + (statblob nil) + (imapdrop (vm-folder-imap-maildrop-spec)) + (uid-validity (vm-folder-imap-uid-validity)) + (safe-imapdrop (vm-safe-imapdrop-string imapdrop)) + (use-body-peek (vm-folder-imap-body-peek)) + r-list mp got-some message-size + (folder-buffer (current-buffer))) + (if (and do-retrieves retrieve-list) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-max)) + (condition-case error-data + (save-excursion + (set-buffer (process-buffer process)) + (setq statblob (vm-imap-start-status-timer)) + (vm-set-imap-stat-x-box statblob safe-imapdrop) + (vm-set-imap-stat-x-maxmsg statblob + (length retrieve-list)) + (setq r-list retrieve-list) + (while r-list + (vm-set-imap-stat-x-currmsg statblob n) + (setq message-size (vm-imap-get-message-size + process (cdr (car r-list)))) + (vm-set-imap-stat-x-need statblob message-size) + (if use-body-peek + (progn + (vm-imap-send-command process + (format + "FETCH %s (BODY.PEEK[])" + (cdr (car r-list)))) + (vm-imap-retrieve-to-target process folder-buffer + statblob t)) + (progn + (vm-imap-send-command process + (format + "FETCH %s (RFC822.PEEK)" + (cdr (car r-list)))) + (vm-imap-retrieve-to-target process folder-buffer + statblob nil))) + (setq r-list (cdr r-list) + n (1+ n)))) + (error + (message "Retrieval from %s signaled: %s" safe-imapdrop + error-data)) + (quit + (message "Quit received during retrieval from %s" + safe-imapdrop))) + (and statblob (vm-imap-stop-status-timer statblob)) + ;; to make the "Mail" indicator go away + (setq vm-spooled-mail-waiting nil) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-increment vm-modification-counter) + (vm-update-summary-and-mode-line) + (setq mp (vm-assimilate-new-messages t)) + (setq got-some mp) + (setq r-list retrieve-list) + (while mp + (vm-set-imap-uid-of (car mp) (car (car r-list))) + (vm-set-imap-uid-validity-of (car mp) uid-validity) + (condition-case nil + (vm-imap-get-message-flags process (car mp) t) + (error nil)) + (vm-set-stuff-flag-of (car mp) t) + (setq mp (cdr mp) + r-list (cdr r-list)))))) + (if do-attributes + (let ((mp vm-message-list) + (perm-flags (vm-folder-imap-permanent-flags))) + (while mp + (if (not (vm-attribute-modflag-of (car mp))) + nil + (condition-case nil + (vm-imap-store-message-flags process (car mp) perm-flags) + (error nil))) + (setq mp (cdr mp))))) + (if do-local-expunges + (vm-expunge-folder t t local-expunge-list)) + (if (and do-remote-expunges + vm-imap-messages-to-expunge) + (let ((process (vm-folder-imap-process))) + (if (and (processp process) + (memq (process-status process) '(open run))) + (vm-imap-end-session process)) + (setq vm-imap-retrieved-messages + (mapcar (function (lambda (x) (list (car x) (cdr x) + imapdrop 'uid))) + vm-imap-messages-to-expunge)) + (vm-expunge-imap-messages) + (setq vm-imap-messages-to-expunge + (mapcar (function (lambda (x) (cons (car x) (car (cdr x))))) + vm-imap-retrieved-messages)))) + got-some))) + + (defun vm-imap-folder-check-for-mail (&optional interactive) + (if (or vm-global-block-new-mail + (null (vm-establish-new-folder-imap-session interactive))) + nil + (let ((result (car (vm-imap-get-synchronization-data)))) + (vm-imap-end-session (vm-folder-imap-process)) + result ))) + + (defun vm-imap-find-spec-for-name (name) + (let ((list vm-imap-folder-alist) + (done nil)) + (while (and (not done) list) + (if (equal name (nth 1 (car list))) + (setq done t) + (setq list (cdr list)))) + (and list (car (car list))))) + + (defun vm-imap-find-name-for-spec (spec) + (let ((list vm-imap-folder-alist) + (done nil)) + (while (and (not done) list) + (if (equal spec (car (car list))) + (setq done t) + (setq list (cdr list)))) + (and list (nth 1 (car list))))) + + (defun vm-imap-find-name-for-buffer (buffer) + (let ((list vm-imap-folder-alist) + (done nil)) + (while (and (not done) list) + (if (eq buffer (vm-get-file-buffer (vm-imap-make-filename-for-spec + (car (car list))))) + (setq done t) + (setq list (cdr list)))) + (and list (nth 1 (car list))))) + + (defun vm-imap-make-filename-for-spec (spec) + (let (md5 list) + (setq spec (vm-imap-normalize-spec spec)) + (setq md5 (vm-md5-string spec)) + (expand-file-name (concat "imap-cache-" md5) + (or vm-imap-folder-cache-directory + vm-folder-directory + (getenv "HOME"))))) + + (defun vm-imap-normalize-spec (spec) + (let (list) + (setq list (vm-imap-parse-spec-to-list spec)) + (setcar (vm-last list) "*") + (setcar list "imap") + (setcar (nthcdr 2 list) "*") + (setcar (nthcdr 3 list) "*") + (setq spec (mapconcat (function identity) list ":")) + spec )) + + (defun vm-imap-parse-spec-to-list (spec) + (vm-parse spec "\\([^:]+\\):?" 1 6)) + + (defun vm-imap-spec-list-to-host-alist (spec-list) + (let (host-alist) + (while spec-list + (setq host-alist (cons + (cons + (nth 1 (vm-imap-parse-spec-to-list (car spec-list))) + (car spec-list)) + host-alist) + spec-list (cdr spec-list))) + host-alist )) + + (defun vm-read-imap-folder-name (prompt spec-list) + "Read an IMAP server and mailbox, return an IMAP mailbox spec." + (let (host c-list spec process mailbox list + (host-alist (vm-imap-spec-list-to-host-alist spec-list))) + (if (null host-alist) + (error "No known IMAP servers. Please set vm-imap-server-list.")) + (setq host (if (cdr host-alist) + (completing-read "IMAP server: " host-alist nil t) + (car (car host-alist))) + spec (cdr (assoc host host-alist)) + process (vm-imap-make-session spec) + c-list (vm-imap-mailbox-list process)) + (vm-imap-end-session process) + ;; evade the XEmacs dialog box. + (let ((use-dialog-box nil)) + (setq mailbox (vm-read-string prompt c-list))) + (setq list (vm-imap-parse-spec-to-list spec)) + (setcar (nthcdr 3 list) mailbox) + (mapconcat 'identity list ":"))) + + (defun vm-imap-directory-separator (process ref) + (let ((c-list nil) + sep p r response need-ok) + (vm-imap-check-connection process) + (save-excursion + (set-buffer (process-buffer process)) + (vm-imap-send-command process (format "LIST %s \"\"" + (vm-imap-quote-string ref))) + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response process)) + (if (vm-imap-response-matches response 'VM 'NO) + (error "server said NO to LIST")) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to LIST")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'LIST 'list 'string) + (setq r (nthcdr 3 response) + p (car r) + sep (buffer-substring (nth 1 p) (nth 2 p)))) + ((vm-imap-response-matches response '* 'LIST 'list) + (vm-imap-protocol-error "unexpedcted LIST response")))) + sep ))) + + (defun vm-imap-mailbox-list (process) + (let ((c-list nil) + p r response need-ok) + (vm-imap-check-connection process) + (save-excursion + (set-buffer (process-buffer process)) + (vm-imap-send-command process "LIST \"\" \"*\"") + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response process)) + (if (vm-imap-response-matches response 'VM 'NO) + (error "server said NO to LIST")) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to LIST")) + (if (vm-imap-response-matches response '* 'BYE) + (vm-imap-protocol-error "server said BYE to LIST")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'LIST 'list) + (setq r (nthcdr 2 response) + p (car r)) + (if (vm-imap-scan-list-for-flag p "\\Noselect") + nil + (setq r (nthcdr 4 response) + p (car r)) + (if (memq (car p) '(atom string)) + (setq c-list (cons (buffer-substring (nth 1 p) (nth 2 p)) + c-list))))))) + c-list ))) + + (defun vm-imap-read-boolean-response (process) + (let ((need-ok t) retval response) + (while need-ok + (vm-imap-check-connection process) + (setq response (vm-imap-read-response process)) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil retval t)) + ((vm-imap-response-matches response 'VM 'NO) + (setq need-ok nil retval nil)) + ((vm-imap-response-matches response '* 'BYE) + (vm-imap-protocol-error "server said BYE")) + ((vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD")))))) + + (defun vm-imap-create-mailbox (process mailbox + &optional dont-create-parent-directories) + (if (not dont-create-parent-directories) + (let (dir sep sep-regexp i) + (setq sep (vm-imap-directory-separator process "") + sep-regexp (regexp-quote sep) + i 0) + (while (string-match sep-regexp mailbox i) + (setq dir (substring mailbox i (match-end 0))) + (vm-imap-create-mailbox process dir t) + ;; ignore command result since creating a directory will + ;; routinely fail with "File exists". We'll generate a + ;; real error if the final mailbox creation fails. + (vm-imap-read-boolean-response process) + (setq i (match-end 0))))) + (vm-imap-send-command process (format "VM CREATE %s" + (vm-imap-quote-string mailbox))) + (if (null (vm-imap-read-boolean-response process)) + (error "IMAP CREATE of %s failed" mailbox))) + + (defun vm-imap-create-mailbox (process mailbox) + (vm-imap-send-command process (format "VM DELETE %s" + (vm-imap-quote-string mailbox))) + (if (null (vm-imap-read-boolean-response process)) + (error "IMAP DELETE of %s failed" mailbox))) + + (defun vm-imap-rename-mailbox (process source dest) + (vm-imap-send-command process (format "VM RENAME %s %s" + (vm-imap-quote-string source) + (vm-imap-quote-string dest))) + (if (null (vm-imap-read-boolean-response process)) + (error "IMAP RENAME of %s to %s failed" source dest))) *** dist/vm-message.el.dist Thu Mar 27 20:34:53 2003 --- vm-message.el Sun May 25 01:34:06 2003 *************** *** 102,104 **** (aref (aref message 1) 18)) ! (defsubst vm-message-access-method (message) (aref (aref message 1) 19)) --- 102,104 ---- (aref (aref message 1) 18)) ! (defsubst vm-message-access-method-of (message) (aref (aref message 1) 19)) *************** *** 177,178 **** --- 177,183 ---- (aref (aref message 3) 23)) + ;; imap UID value for message (shares same slot as pop-uidl-of) + (defsubst vm-imap-uid-of (message) + (aref (aref message 3) 23)) + (defsubst vm-imap-uid-validity-of (message) + (aref (aref message 3) 24)) ;; extra data shared by virtual messages if vm-virtual-mirror is non-nil *************** *** 184,188 **** (symbol-value (aref (aref message 4) 1))) - ;; modification flag for this message ;; nil if all attribute changes have been stuffed into the folder buffer ! (defsubst vm-modflag-of (message) (aref (aref message 4) 2)) ;; list of labels attached to this message --- 189,192 ---- (symbol-value (aref (aref message 4) 1))) ;; nil if all attribute changes have been stuffed into the folder buffer ! (defsubst vm-stuff-flag-of (message) (aref (aref message 4) 2)) ;; list of labels attached to this message *************** *** 191,192 **** --- 195,199 ---- (defsubst vm-label-string-of (message) (aref (aref message 4) 4)) + ;; attribute modification flag for this message + ;; non-nil if attributes need to be saved + (defsubst vm-attribute-modflag-of (message) (aref (aref message 4) 5)) *************** *** 256,258 **** (vm-stuff-virtual-attributes message) ! (vm-set-modflag-of message t)) (and (not (buffer-modified-p)) (vm-set-buffer-modified-p t)) --- 263,265 ---- (vm-stuff-virtual-attributes message) ! (vm-set-stuff-flag-of message t)) (and (not (buffer-modified-p)) (vm-set-buffer-modified-p t)) *************** *** 308,309 **** --- 315,320 ---- (aset (aref message 3) 23 val)) + (defsubst vm-set-imap-uid-of (message val) + (aset (aref message 3) 23 val)) + (defsubst vm-set-imap-uid-validity-of (message val) + (aset (aref message 3) 24 val)) (defsubst vm-set-mirror-data-of (message data) *************** *** 316,318 **** (aset (aref message 4) 1 sym)) ! (defsubst vm-set-modflag-of (message val) (aset (aref message 4) 2 val)) --- 327,329 ---- (aset (aref message 4) 1 sym)) ! (defsubst vm-set-stuff-flag-of (message val) (aset (aref message 4) 2 val)) *************** *** 322,323 **** --- 333,336 ---- (aset (aref message 4) 4 string)) + (defsubst vm-set-attribute-modflag-of (message flag) + (aset (aref message 4) 5 flag)) *** dist/vm-menu.el.dist Thu Mar 27 20:34:53 2003 --- vm-menu.el Sat May 10 20:13:36 2003 *************** *** 68,69 **** --- 68,71 ---- (vm-menu-can-expunge-pop-messages-p)] + ["Expunge IMAP Messages" vm-expunge-pop-messages + (vm-menu-can-expunge-imap-messages-p)] "---" *************** *** 680,681 **** --- 682,690 ---- (not (eq vm-folder-access-method 'pop))) + (error nil))) + + (defun vm-menu-can-expunge-imap-messages-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (not (eq vm-folder-access-method 'imap))) (error nil))) *** dist/vm-mime.el.dist Sat May 3 19:11:04 2003 --- vm-mime.el Sun May 25 01:34:06 2003 *************** *** 749,751 **** ;; character set properly. ! (if (not (vm-mime-charset-internally-displayable-p charset)) nil --- 749,753 ---- ;; character set properly. ! (if (and (not (vm-mime-charset-internally-displayable-p charset)) ! (not (setq need-conversion ! (vm-mime-can-convert-charset charset)))) nil *************** *** 1170,1172 **** (and (car param-list) ! (setcar param-list (concat "charset=" value))))) --- 1172,1174 ---- (and (car param-list) ! (setcar param-list (concat name "=" value))))) *************** *** 2893,2895 **** (setq do-strips nil)) ! (x-error (message "Failed making image strips: %s" error-data) --- 2895,2897 ---- (setq do-strips nil)) ! (error (message "Failed making image strips: %s" error-data) *************** *** 3146,3152 **** " -page" ! (format " %dx%d+0+%d" width (+ min-height adjustment ! (if (zerop remainder) 0 1)) ! starty) (format " -roll +%d+%d" hroll vroll) --- 3148,3153 ---- " -page" ! (format " %dx%d+0+0" width (+ min-height adjustment ! (if (zerop remainder) 0 1))) (format " -roll +%d+%d" hroll vroll) *************** *** 3165,3171 **** "-page" ! (format "%dx%d+0+%d" width (+ min-height adjustment ! (if (zerop remainder) 0 1)) ! starty) "-roll" --- 3166,3171 ---- "-page" ! (format "%dx%d+0+0" width (+ min-height adjustment ! (if (zerop remainder) 0 1))) "-roll" *************** *** 4904,4906 **** (vm-set-line-count-of m nil) ! (vm-set-modflag-of m t) ;; For the dreaded From_-with-Content-Length folders recompute --- 4904,4906 ---- (vm-set-line-count-of m nil) ! (vm-set-stuff-flag-of m t) ;; For the dreaded From_-with-Content-Length folders recompute *** dist/vm-pop.el.dist Sat May 3 19:11:04 2003 --- vm-pop.el Sat May 10 19:52:46 2003 *************** *** 981,983 **** (safe-popdrop (vm-safe-popdrop-string popdrop)) ! r-list mp got-some pr-list message-size (folder-buffer (current-buffer))) --- 981,983 ---- (safe-popdrop (vm-safe-popdrop-string popdrop)) ! r-list mp got-some message-size (folder-buffer (current-buffer))) *************** *** 1029,1031 **** (vm-set-pop-uidl-of (car mp) (car (car r-list))) ! (vm-set-modflag-of (car mp) t) (setq mp (cdr mp) --- 1029,1031 ---- (vm-set-pop-uidl-of (car mp) (car (car r-list))) ! (vm-set-stuff-flag-of (car mp) t) (setq mp (cdr mp) *************** *** 1089,1093 **** ! (defun vm-pop-make-filename-for-spec (spec &optional scrub-password) (let (md5 list) ! (if (null scrub-password) nil --- 1089,1093 ---- ! (defun vm-pop-make-filename-for-spec (spec &optional scrub-password scrub-spec) (let (md5 list) ! (if (and (null scrub-password) (null scrub-spec)) nil *************** *** 1095,1096 **** --- 1095,1106 ---- (setcar (vm-last list) "*") + (if scrub-spec + (progn + (cond ((= (length list) 6) + (setcar list "pop") + (setcar (nthcdr 2 list) "*") + (setcar (nthcdr 3 list) "*")) + (t + (setq list (cons "pop" list)) + (setcar (nthcdr 2 list) "*") + (setcar (nthcdr 3 list) "*"))))) (setq spec (mapconcat (function identity) list ":"))) *** dist/vm-reply.el.dist Thu Mar 27 20:34:53 2003 --- vm-reply.el Thu May 8 11:28:39 2003 *************** *** 356,360 **** ! (defun vm-mail-send-and-exit (arg) ! "Just like mail-send-and-exit except that VM flags the appropriate message(s) ! as having been replied to, if appropriate." (interactive "P") --- 356,360 ---- ! (defun vm-mail-send-and-exit (&rest ignored) ! "Send message and maybe delete the composition buffer. ! The value of `vm-keep-sent-mesages' determines whether the composition buffer is deleted. If the composition is a reply to a message ina currenttly visited folder, that message is marked as having been rpelied to." (interactive "P") *** dist/vm-save.el.dist Thu Mar 27 20:34:53 2003 --- vm-save.el Sun May 25 01:29:29 2003 *************** *** 624,625 **** --- 624,678 ---- + (defun vm-save-message-to-imap-folder (folder &optional count) + "Save the current message to an IMAP folder. + Prefix arg COUNT means save this message and the next COUNT-1 + messages. A negative COUNT means save this message and the + previous COUNT-1 messages. + + When invoked on marked messages (via vm-next-command-uses-marks), + all marked messages in the current folder are saved; other messages are + ignored. + + The saved messages are flagged as `filed'." + (interactive + (save-excursion + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((this-command this-command) + (last-command last-command)) + (list (vm-read-imap-folder-name "Save to IMAP folder: " + vm-imap-server-list) + (prefix-numeric-value current-prefix-arg))))) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (vm-display nil nil '(vm-save-message-to-imap-folder) + '(vm-save-message-to-imap-folder)) + (or count (setq count 1)) + (let ((mlist (vm-select-marked-or-prefixed-messages count)) + process m + (mailbox (nth 3 (vm-imap-parse-spec-to-list folder))) + (count 0)) + (unwind-protect + (save-excursion + (setq process (vm-imap-make-session folder)) + (set-buffer (process-buffer process)) + (while mlist + (setq m (car mlist)) + (vm-imap-save-message process m mailbox) + (if (null (vm-filed-flag m)) + (vm-set-filed-flag m t)) + (vm-increment count) + (vm-modify-folder-totals folder 'saved 1 m) + (setq mlist (cdr mlist)))) + (and process (vm-imap-end-session process))) + (vm-update-summary-and-mode-line) + (if (interactive-p) + (message "%d message%s saved to %s" + count (if (/= 1 count) "s" "") + (vm-safe-imapdrop-string folder))) + (if (and vm-delete-after-saving (not vm-folder-read-only)) + (vm-delete-message count)) + folder )) + (provide 'vm-save) *** dist/vm-sort.el.dist Thu Mar 27 20:34:53 2003 --- vm-sort.el Fri May 23 20:24:28 2003 *************** *** 219,221 **** "Thu, 1 Jan 1970 00:00:00 GMT")) ! (x-error "1970010100:00:00"))) (vm-sortable-datestring-of m)))) --- 219,221 ---- "Thu, 1 Jan 1970 00:00:00 GMT")) ! (error "1970010100:00:00"))) (vm-sortable-datestring-of m)))) *** dist/vm-startup.el.dist Sat May 3 19:11:04 2003 --- vm-startup.el Mon May 26 09:53:50 2003 *************** *** 33,36 **** ! Visiting the primary inbox causes any contents of the system mailbox to ! be moved and appended to the resulting buffer. --- 33,36 ---- ! Visiting the primary inbox normally causes any contents of the system mailbox to ! be moved and appended to the resulting buffer. You can disable this automatic fetching of mail by setting `vm-auto-get-new-mail' to nil. *************** *** 49,50 **** --- 49,65 ---- (catch 'done + ;; deduce the access method if none specified + (if (null access-method) + (let ((f (or folder vm-primary-inbox))) + (cond ((and vm-recognize-imap-maildrops + ;; f could be a buffer + (stringp f) + (string-match vm-recognize-imap-maildrops f)) + (setq access-method 'imap + folder f)) + ((and vm-recognize-pop-maildrops + ;; f could be a buffer + (stringp f) + (string-match vm-recognize-pop-maildrops f)) + (setq access-method 'pop + folder f))))) (let ((full-startup (not (bufferp folder))) *************** *** 63,68 **** ;; time the user changed his password, we'd start ! ;; visiting the wrong file. ;; ;; To fix this we do two things. First, migrate the ! ;; users caches to the filenames based in the POP ;; sepc without the password. Second, we visit the --- 78,84 ---- ;; time the user changed his password, we'd start ! ;; visiting the wrong (and probably nonexistent) ! ;; cache file. ;; ;; To fix this we do two things. First, migrate the ! ;; user's caches to the filenames based in the POP ;; sepc without the password. Second, we visit the *************** *** 70,83 **** ;; after trying to migrate it. (let ((f-pass (vm-pop-make-filename-for-spec remote-spec)) ! (f-nopass (vm-pop-make-filename-for-spec remote-spec t))) ! (if (or (string= f-pass f-nopass) (file-exists-p f-nopass)) ! nil ! ;; try to migrate ! (condition-case nil ! (rename-file f-pass f-nopass) ! (error nil))) ! ;; choose the one based on the password if it still exists. ! (if (file-exists-p f-pass) ! (setq folder f-pass) ! (setq folder f-nopass))))) (setq folder-buffer --- 86,127 ---- ;; after trying to migrate it. + ;; + ;; For VM 7.16 we apply the same logic to the access + ;; methods, pop, pop-ssh and pop-ssl and to + ;; authentication method and service port, which can + ;; also change and lead us to visit a nonexistent + ;; cache file. The assumption is that these + ;; properties of the connection can change and we'll + ;; still be accessing the same mailbox on the + ;; server. (let ((f-pass (vm-pop-make-filename-for-spec remote-spec)) ! (f-nopass (vm-pop-make-filename-for-spec remote-spec t)) ! (f-nospec (vm-pop-make-filename-for-spec remote-spec t t))) ! (cond ((or (string= f-pass f-nospec) ! (file-exists-p f-nospec)) ! nil ) ! ((file-exists-p f-pass) ! ;; try to migrate ! (condition-case nil ! (rename-file f-pass f-nospec) ! (error nil))) ! ((file-exists-p f-nopass) ! ;; try to migrate ! (condition-case nil ! (rename-file f-nopass f-nospec) ! (error nil)))) ! ;; choose the one that exists, password version, ! ;; nopass version and finally nopass+nospec ! ;; version. ! (cond ((file-exists-p f-pass) ! (setq folder f-pass)) ! ((file-exists-p f-nopass) ! (setq folder f-nopass)) ! (t ! (setq folder f-nospec))))) ! ((eq access-method 'imap) ! (setq remote-spec folder ! folder-name (or (nth 3 (vm-imap-parse-spec-to-list ! remote-spec)) ! folder) ! folder (vm-imap-make-filename-for-spec remote-spec)))) (setq folder-buffer *************** *** 113,115 **** (set-buffer folder-buffer) ! (cond ((eq access-method 'pop) (if (not (equal folder-name (buffer-name))) --- 157,159 ---- (set-buffer folder-buffer) ! (cond ((memq access-method '(pop imap)) (if (not (equal folder-name (buffer-name))) *************** *** 208,210 **** (cond ((eq access-method 'pop) ! (vm-set-folder-pop-maildrop-spec remote-spec))) ;; If the buffer is modified we don't know if the --- 252,256 ---- (cond ((eq access-method 'pop) ! (vm-set-folder-pop-maildrop-spec remote-spec)) ! ((eq access-method 'imap) ! (vm-set-folder-imap-maildrop-spec remote-spec))) ;; If the buffer is modified we don't know if the *************** *** 335,338 **** ! ;; Display copyright and copying info unless ! ;; user says no. (if (and (interactive-p) (not vm-startup-message-displayed)) --- 381,383 ---- ! ;; Display copyright and copying info. (if (and (interactive-p) (not vm-startup-message-displayed)) *************** *** 376,378 **** ! This is VM 7.15. --- 421,423 ---- ! This is VM 7.16. *************** *** 796,797 **** --- 841,847 ---- access-method 'pop)) + ((and (stringp vm-recognize-imap-maildrops) + (string-match vm-recognize-imap-maildrops folder) + (setq foo (vm-imap-find-name-for-spec folder))) + (setq folder foo + access-method 'imap)) (t *************** *** 865,867 **** "Visit a POP mailbox. ! VM will parse and present its messages to you in the usual way. --- 915,920 ---- "Visit a POP mailbox. ! VM will present its messages to you in the usual way. Messages ! found in the POP mailbox will be downloaded and stored in a local ! cache. If you expunge messages from the cache, the corresponding ! messages will be expunged from the POP mailbox. *************** *** 964,965 **** --- 1017,1100 ---- + ;;;###autoload + (defun vm-visit-imap-folder (folder &optional read-only) + "Visit a IMAP mailbox. + VM will present its messages to you in the usual way. Messages + found in the IMAP mailbox will be downloaded and stored in a local + cache. If you expunge messages from the cache, the corresponding + messages will be expunged from the IMAP mailbox. + + First arg FOLDER specifies the IMAP mailbox to visit. You can only + visit mailboxes on servers that are listed in `vm-imap-server-list'. + When this command is called interactively the server and mailbox + names are read from the minibuffer. + + Prefix arg or optional second arg READ-ONLY non-nil indicates + that the folder should be considered read only. No attribute + changes, messages additions or deletions will be allowed in the + visited folder." + (interactive + (save-excursion + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((this-command this-command) + (last-command last-command)) + (list (vm-read-imap-folder-name + (format "Visit%s IMAP folder: " + (if current-prefix-arg " read only" "")) + vm-imap-server-list) + current-prefix-arg)))) + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (vm-check-for-killed-summary) + (vm folder read-only 'imap)) + + ;;;###autoload + (defun vm-visit-imap-folder-other-frame (folder &optional read-only) + "Like vm-visit-imap-folder, but run in a newly created frame." + (interactive + (save-excursion + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((this-command this-command) + (last-command last-command)) + (list (vm-read-imap-folder-name + (format "Visit%s IMAP folder: " + (if current-prefix-arg " read only" "")) + vm-imap-server-list) + current-prefix-arg)))) + (vm-session-initialization) + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'folder)) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-imap-folder folder read-only)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + + ;;;###autoload + (defun vm-visit-imap-folder-other-window (folder &optional read-only) + "Like vm-visit-imap-folder, but run in a different window." + (interactive + (save-excursion + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((this-command this-command) + (last-command last-command)) + (list (vm-read-imap-folder-name + (format "Visit%s IMAP folder: " + (if current-prefix-arg " read only" "")) + vm-imap-server-list) + current-prefix-arg)))) + (vm-session-initialization) + (if (one-window-p t) + (split-window)) + (other-window 1) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-imap-folder folder read-only))) + (put 'vm-virtual-mode 'mode-class 'special) *************** *** 1671,1673 **** (function vm-compose-mail) ; compose function ! (function vm-send-mail-and-exit) ; send function nil ; abort function (kill-buffer) --- 1806,1808 ---- (function vm-compose-mail) ; compose function ! (function vm-mail-send-and-exit) ; send function nil ; abort function (kill-buffer) *** dist/vm-summary.el.dist Thu Mar 27 20:34:53 2003 --- vm-summary.el Sat May 10 11:52:12 2003 *************** *** 1149,1151 **** (vm-mark-for-summary-update (car mp)) ! (vm-set-modflag-of (car mp) t) (setq mp (cdr mp))) --- 1149,1151 ---- (vm-mark-for-summary-update (car mp)) ! (vm-set-stuff-flag-of (car mp) t) (setq mp (cdr mp))) *** dist/vm-undo.el.dist Thu Mar 27 20:34:53 2003 --- vm-undo.el Sat May 24 16:09:53 2003 *************** *** 477,481 **** (if (not norecord) ! (if (eq vm-flush-interval t) ! (vm-stuff-virtual-attributes m) ! (vm-set-modflag-of m t))))))) --- 477,483 ---- (if (not norecord) ! (progn ! (vm-set-attribute-modflag-of m t) ! (if (eq vm-flush-interval t) ! (vm-stuff-virtual-attributes m) ! (vm-set-stuff-flag-of m t)))))))) *************** *** 516,518 **** (vm-stuff-virtual-attributes m) ! (vm-set-modflag-of m t)))))) --- 518,520 ---- (vm-stuff-virtual-attributes m) ! (vm-set-stuff-flag-of m t)))))) *************** *** 541,543 **** (defun vm-set-redistributed-flag (m flag &optional norecord) ! (vm-set-xxxx-flag m flag norecord 'vm-set-forwarded-flag 8)) --- 543,545 ---- (defun vm-set-redistributed-flag (m flag &optional norecord) ! (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 8)) *** dist/vm-vars.el.dist Sat May 3 19:11:04 2003 --- vm-vars.el Mon May 26 09:52:55 2003 *************** *** 290,292 **** file name to create a crash box name." ! :type '(list string)) --- 290,292 ---- file name to create a crash box name." ! :type 'string) *************** *** 425,427 **** "*If VM is about to retrieve via IMAP a message larger than this size ! (in bytes) it will ask the you whether it should retrieve the message. --- 425,427 ---- "*If VM is about to retrieve via IMAP a message larger than this size ! (in bytes) it will ask you whether it should retrieve the message. *************** *** 491,492 **** --- 491,530 ---- + (defcustom vm-imap-server-list nil + "*List of IMAP maildrop specifications that tell VM the IMAP servers + you have access to and how to log into them. The IMAP maildrop + specification in the same format used by vm-spool-files (which + see). The mailbox part of the specifiation is ignored and should + be asterisk or some other placeholder. + + Example: + (setq vm-imap-server-list + '( + \"imap-ssl:mail.foocorp.com:993:inbox:login:becky:*\" + \"imap:crickle.lex.ky.us:143:inbox:login:becky:*\" + ) + )" + :type '(repeat string)) + + (defcustom vm-imap-folder-alist nil + "*Alist of IMAP maildrop specifications and names that refer to them. + The alist format is: + + ((IMAPDROP NAME) ...) + + IMAPDROP is a IMAP maildrop specification in the same format used + by vm-spool-files (which see). + + NAME is a string that should give a less cumbersome name that you + will use to refer to this maildrop when using `vm-visit-imap-folder'." + :type '(repeat (list string string))) + + (defcustom vm-imap-folder-cache-directory nil + "*Directory where VM stores cached copies of IMAP folders. + When VM visits a IMAP folder (really just a IMAP server where you + have a mailbox) it stores the retrieved message on your computer + so that they need not be retrieved each time you visit the folder. + The cached copies are stored in the directory specified by this + variable." + :type '(choice (const nil) directory)) + (defcustom vm-auto-get-new-mail t *************** *** 3574,3576 **** to another location. Normally this should be the movemail ! program distributed with Emacs. If you use another prgoram, it must accept as its last two arguments the spool file (or maildrop) from which --- 3612,3614 ---- to another location. Normally this should be the movemail ! program distributed with Emacs. If you use another program, it must accept as its last two arguments the spool file (or maildrop) from which *************** *** 4032,4033 **** --- 4070,4072 ---- (defvar vm-last-visit-pop-folder nil) + (defvar vm-last-visit-imap-folder nil) (defvar vm-last-pipe-command nil) *************** *** 4134,4135 **** --- 4173,4175 ---- ("vm-decode-mime-message") + ("vm-delete-duplicate-messages") ("vm-delete-message") *************** *** 4183,4184 **** --- 4223,4225 ---- ("vm-mime-attach-mime-file") + ("vm-mime-attach-object-from-message") ("vm-mode") *************** *** 4221,4222 **** --- 4262,4264 ---- ("vm-save-message-sans-headers") + ("vm-save-message-to-imap-folder") ("vm-scroll-backward") *************** *** 4257,4258 **** --- 4299,4303 ---- ("vm-visit-folder-other-window") + ("vm-visit-imap-folder") + ("vm-visit-imap-folder-other-frame") + ("vm-visit-imap-folder-other-window") ("vm-visit-pop-folder") *************** *** 4395,4400 **** (defconst vm-attributes-vector-length 9) ! (defconst vm-cache-vector-length 24) (defconst vm-softdata-vector-length 20) (defconst vm-location-data-vector-length 6) ! (defconst vm-mirror-data-vector-length 5) (defconst vm-folder-summary-vector-length 15) --- 4440,4445 ---- (defconst vm-attributes-vector-length 9) ! (defconst vm-cache-vector-length 25) (defconst vm-softdata-vector-length 20) (defconst vm-location-data-vector-length 6) ! (defconst vm-mirror-data-vector-length 6) (defconst vm-folder-summary-vector-length 15) *************** *** 4487,4488 **** --- 4532,4535 ---- (make-variable-buffer-local 'vm-imap-retrieved-messages) + (defvar vm-imap-messages-to-expunge nil) + (make-variable-buffer-local 'vm-imap-messages-to-expunge) (defvar vm-imap-capabilities nil) *** dist/vm-version.el.dist Sat May 3 19:11:04 2003 --- vm-version.el Mon May 26 09:53:50 2003 *************** *** 3,5 **** ! (defconst vm-version "7.15" "Version number of VM.") --- 3,5 ---- ! (defconst vm-version "7.16" "Version number of VM.")