*** dist/vm-edit.el.dist Thu Mar 27 20:34:53 2003 --- vm-edit.el Mon Jun 30 19:47:36 2003 *************** *** 196,255 **** (error "The folder buffer for this message has been killed.")) ! ;; make sure the message ends with a newline ! (goto-char (point-max)) ! (and (/= (preceding-char) ?\n) (insert ?\n)) ! ;; munge message separators found in the edited message to ! ;; prevent message from being split into several messages. ! (vm-munge-message-separators (vm-message-type-of (car vm-message-pointer)) ! (point-min) (point-max)) ! ;; for From_-with-Content-Length recompute the Content-Length header ! (if (eq (vm-message-type-of (car vm-message-pointer)) ! 'From_-with-Content-Length) ! (let ((buffer-read-only nil) ! length) ! (goto-char (point-min)) ! ;; first delete all copies of Content-Length ! (while (and (re-search-forward vm-content-length-search-regexp nil t) ! (null (match-beginning 1)) ! (progn (goto-char (match-beginning 0)) ! (vm-match-header vm-content-length-header))) ! (delete-region (vm-matched-header-start) (vm-matched-header-end))) ! ;; now compute the message body length ! (goto-char (point-min)) ! (search-forward "\n\n" nil 0) ! (setq length (- (point-max) (point))) ! ;; insert the header ! (goto-char (point-min)) ! (insert vm-content-length-header " " (int-to-string length) "\n"))) ! (let ((edit-buf (current-buffer)) ! (mp vm-message-pointer)) ! (if (buffer-modified-p) ! (progn ! (widen) ! (save-excursion ! (set-buffer (vm-buffer-of (vm-real-message-of (car mp)))) ! (if (not (memq (vm-real-message-of (car mp)) vm-message-list)) ! (error "The original copy of this message has been expunged.")) ! (vm-save-restriction ! (widen) ! (goto-char (vm-headers-of (vm-real-message-of (car mp)))) ! (let ((vm-message-pointer mp) ! opoint ! (buffer-read-only nil)) ! (setq opoint (point)) ! (insert-buffer-substring edit-buf) ! (delete-region ! (point) (vm-text-end-of (vm-real-message-of (car mp)))) ! (vm-discard-cached-data)) ! (vm-set-edited-flag-of (car mp) t) ! (vm-set-edit-buffer-of (car mp) nil)) ! (set-buffer (vm-buffer-of (car mp))) ! (if (eq (vm-real-message-of (car mp)) ! (vm-real-message-of (car vm-message-pointer))) ! (vm-preview-current-message) ! (vm-update-summary-and-mode-line)))) ! (message "No change.")) ! (vm-display edit-buf nil '(vm-edit-message-end) ! '(vm-edit-message-end reading-message startup)) ! (set-buffer-modified-p nil) ! (kill-buffer edit-buf))) --- 196,282 ---- (error "The folder buffer for this message has been killed.")) ! (let ((pos-offset (- (point) (point-min)))) ! ;; make sure the message ends with a newline ! (goto-char (point-max)) ! (and (/= (preceding-char) ?\n) (insert ?\n)) ! ;; munge message separators found in the edited message to ! ;; prevent message from being split into several messages. ! (vm-munge-message-separators (vm-message-type-of (car vm-message-pointer)) ! (point-min) (point-max)) ! ;; for From_-with-Content-Length recompute the Content-Length header ! (if (eq (vm-message-type-of (car vm-message-pointer)) ! 'From_-with-Content-Length) ! (let ((buffer-read-only nil) ! length) ! (goto-char (point-min)) ! ;; first delete all copies of Content-Length ! (while (and (re-search-forward vm-content-length-search-regexp nil t) ! (null (match-beginning 1)) ! (progn (goto-char (match-beginning 0)) ! (vm-match-header vm-content-length-header))) ! (delete-region (vm-matched-header-start) (vm-matched-header-end))) ! ;; now compute the message body length ! (goto-char (point-min)) ! (search-forward "\n\n" nil 0) ! (setq length (- (point-max) (point))) ! ;; insert the header ! (goto-char (point-min)) ! (insert vm-content-length-header " " (int-to-string length) "\n"))) ! (let ((edit-buf (current-buffer)) ! (mp vm-message-pointer)) ! (if (buffer-modified-p) ! (progn ! (widen) ! (save-excursion ! (set-buffer (vm-buffer-of (vm-real-message-of (car mp)))) ! (if (not (memq (vm-real-message-of (car mp)) vm-message-list)) ! (error "The original copy of this message has been expunged.")) ! (vm-save-restriction ! (widen) ! (goto-char (vm-headers-of (vm-real-message-of (car mp)))) ! (let ((vm-message-pointer mp) ! opoint ! (buffer-read-only nil)) ! (setq opoint (point)) ! (insert-buffer-substring edit-buf) ! (delete-region ! (point) (vm-text-end-of (vm-real-message-of (car mp)))) ! (vm-discard-cached-data)) ! (vm-set-edited-flag-of (car mp) t) ! (vm-set-edit-buffer-of (car mp) nil)) ! (set-buffer (vm-buffer-of (car mp))) ! (if (eq (vm-real-message-of (car mp)) ! (vm-real-message-of (car vm-message-pointer))) ! (progn ! (vm-preview-current-message) ! ;; Try to position the cursor in the message ! ;; window close to where it was in the edit ! ;; window. This works well for non MIME ! ;; messages, but the cursor drifts badly for ! ;; MIME and for refilled messages. ! (vm-save-buffer-excursion ! (and vm-presentation-buffer ! (set-buffer vm-presentation-buffer)) ! (vm-save-restriction ! (vm-save-buffer-excursion ! (widen) ! (let ((osw (selected-window)) ! (new-win (vm-get-visible-buffer-window ! (current-buffer)))) ! (unwind-protect ! (if new-win ! (progn ! (select-window new-win) ! (goto-char (vm-headers-of ! (car vm-message-pointer))) ! (condition-case nil ! (forward-char pos-offset) ! (error nil)))) ! (if (not (eq osw (selected-window))) ! (select-window osw)))))))) ! (vm-update-summary-and-mode-line)))) ! (message "No change.")) ! (vm-display edit-buf nil '(vm-edit-message-end) ! '(vm-edit-message-end reading-message startup)) ! (set-buffer-modified-p nil) ! (kill-buffer edit-buf)))) *** dist/vm-folder.el.dist Tue May 27 15:16:44 2003 --- vm-folder.el Fri May 30 12:53:21 2003 *************** *** 3269,3271 **** ((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))) --- 3269,3271 ---- ((eq vm-folder-access-method 'imap) ! (vm-imap-find-spec-for-buffer (current-buffer)))))) (vm (or name buffer-file-name) nil vm-folder-access-method))) *** dist/vm-imap.el.dist Tue May 27 15:16:44 2003 --- vm-imap.el Fri May 30 12:52:51 2003 *************** *** 553,554 **** --- 553,555 ---- (setq process-to-shutdown process) + (set (make-local-variable 'vm-imap-session-done) nil) ;; record server capabilities *************** *** 645,660 **** (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))))) --- 646,667 ---- (set-buffer (process-buffer process)) ! ;; vm-imap-end-session might have already been called on ! ;; this process, so don't logout and schedule the killing ! ;; the process again if it's already been done. ! (if vm-imap-session-done ! nil ! (vm-imap-send-command process "LOGOUT") ! (setq vm-imap-session-done t) ! ;; 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)))))) *************** *** 1449,1451 **** (setq need-ok nil)) ! ((vm-imap-response-matches response '* 'FETCH 'atom 'list) (setq r (nthcdr 3 response) --- 1456,1458 ---- (setq need-ok nil)) ! ((vm-imap-response-matches response '* 'atom 'FETCH 'list) (setq r (nthcdr 3 response) *************** *** 1465,1466 **** --- 1472,1474 ---- (vm-set-unread-flag m nil norecord) + (vm-set-new-flag m nil norecord) (setq saw-seen t)) *************** *** 1696,1717 **** ! (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)) --- 1704,1707 ---- ! (defun vm-imap-find-spec-for-buffer (buffer) ! (let ((list vm-imap-server-list) (done nil)) *************** *** 1719,1724 **** (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))))) --- 1709,1714 ---- (if (eq buffer (vm-get-file-buffer (vm-imap-make-filename-for-spec ! (car list)))) (setq done t) (setq list (cdr list)))) ! (and list (car list)))) *************** *** 1739,1741 **** (setcar (nthcdr 2 list) "*") ! (setcar (nthcdr 3 list) "*") (setq spec (mapconcat (function identity) list ":")) --- 1729,1731 ---- (setcar (nthcdr 2 list) "*") ! (setcar (nthcdr 4 list) "*") (setq spec (mapconcat (function identity) list ":")) *************** *** 1757,1761 **** ! (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))) --- 1747,1752 ---- ! (defun vm-read-imap-folder-name (prompt spec-list selectable-only) "Read an IMAP server and mailbox, return an IMAP mailbox spec." (let (host c-list spec process mailbox list + (vm-imap-ok-to-ask t) (host-alist (vm-imap-spec-list-to-host-alist spec-list))) *************** *** 1768,1770 **** process (vm-imap-make-session spec) ! c-list (vm-imap-mailbox-list process)) (vm-imap-end-session process) --- 1759,1761 ---- process (vm-imap-make-session spec) ! c-list (and process (vm-imap-mailbox-list process selectable-only))) (vm-imap-end-session process) *************** *** 1802,1804 **** ! (defun vm-imap-mailbox-list (process) (let ((c-list nil) --- 1793,1795 ---- ! (defun vm-imap-mailbox-list (process selectable-only) (let ((c-list nil) *************** *** 1823,1825 **** p (car r)) ! (if (vm-imap-scan-list-for-flag p "\\Noselect") nil --- 1814,1817 ---- p (car r)) ! (if (and selectable-only ! (vm-imap-scan-list-for-flag p "\\Noselect")) nil *************** *** 1844,1846 **** ((vm-imap-response-matches response 'VM 'BAD) ! (vm-imap-protocol-error "server said BAD")))))) --- 1836,1839 ---- ((vm-imap-response-matches response 'VM 'BAD) ! (vm-imap-protocol-error "server said BAD")))) ! retval )) *************** *** 1861,1863 **** (setq i (match-end 0))))) ! (vm-imap-send-command process (format "VM CREATE %s" (vm-imap-quote-string mailbox))) --- 1854,1856 ---- (setq i (match-end 0))))) ! (vm-imap-send-command process (format "CREATE %s" (vm-imap-quote-string mailbox))) *************** *** 1866,1869 **** ! (defun vm-imap-create-mailbox (process mailbox) ! (vm-imap-send-command process (format "VM DELETE %s" (vm-imap-quote-string mailbox))) --- 1859,1862 ---- ! (defun vm-imap-delete-mailbox (process mailbox) ! (vm-imap-send-command process (format "DELETE %s" (vm-imap-quote-string mailbox))) *************** *** 1873,1875 **** (defun vm-imap-rename-mailbox (process source dest) ! (vm-imap-send-command process (format "VM RENAME %s %s" (vm-imap-quote-string source) --- 1866,1868 ---- (defun vm-imap-rename-mailbox (process source dest) ! (vm-imap-send-command process (format "RENAME %s %s" (vm-imap-quote-string source) *************** *** 1878,1879 **** --- 1871,1960 ---- (error "IMAP RENAME of %s to %s failed" source dest))) + + (defun vm-create-imap-folder (folder) + "Create a folder on an IMAP server. + First argument FOLDER is read from the minibuffer if called + interactively. Non-interactive callers must provide an IMAP + maildrop specification for the folder as described in the + documentation for `vm-spool-files'." + (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 "Create IMAP folder: " + vm-imap-server-list nil))))) + (let ((vm-imap-ok-to-ask t) + process mailbox) + (save-excursion + (setq process (vm-imap-make-session folder)) + (if (null process) + (error "Couldn't open IMAP session for %s" + (vm-safe-imapdrop-string folder))) + (set-buffer (process-buffer process)) + (setq mailbox (nth 3 (vm-imap-parse-spec-to-list folder))) + (vm-imap-create-mailbox process mailbox) + (message "Folder %s created" (vm-safe-imapdrop-string folder))))) + + (defun vm-delete-imap-folder (folder) + "Delete a folder on an IMAP server. + First argument FOLDER is read from the minibuffer if called + interactively. Non-interactive callers must provide an IMAP + maildrop specification for the folder as described in the + documentation for `vm-spool-files'." + (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 "Delete IMAP folder: " + vm-imap-server-list nil))))) + (let ((vm-imap-ok-to-ask t) + process mailbox) + (setq process (vm-imap-make-session folder)) + (if (null process) + (error "Couldn't open IMAP session for %s" + (vm-safe-imapdrop-string folder))) + (save-excursion + (set-buffer (process-buffer process)) + (setq mailbox (nth 3 (vm-imap-parse-spec-to-list folder))) + (vm-imap-delete-mailbox process mailbox) + (message "Folder %s deleted" (vm-safe-imapdrop-string folder))))) + + (defun vm-rename-imap-folder (source dest) + "Rename a folder on an IMAP server. + Argument SOURCE and DEST are read from the minibuffer if called + interactively. Non-interactive callers must provide full IMAP + maildrop specifications for SOURCE and DEST as described in the + documentation for `vm-spool-files'." + (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) + source dest) + (setq source (vm-read-imap-folder-name "Rename IMAP folder: " + vm-imap-server-list t)) + (setq dest (vm-read-imap-folder-name + (format "Rename %s to: " (vm-safe-imapdrop-string source)) + (list source) nil)) + (list source dest)))) + (let ((vm-imap-ok-to-ask t) + process mailbox-source mailbox-dest) + (setq process (vm-imap-make-session source)) + (if (null process) + (error "Couldn't open IMAP session for %s" + (vm-safe-imapdrop-string source))) + (save-excursion + (set-buffer (process-buffer process)) + (setq mailbox-source (nth 3 (vm-imap-parse-spec-to-list source))) + (setq mailbox-dest (nth 3 (vm-imap-parse-spec-to-list dest))) + (vm-imap-rename-mailbox process mailbox-source mailbox-dest) + (message "Folder %s renamed to %s" (vm-safe-imapdrop-string source) + (vm-safe-imapdrop-string dest))))) *** dist/vm-menu.el.dist Tue May 27 15:16:44 2003 --- vm-menu.el Tue May 27 20:18:32 2003 *************** *** 71,74 **** "---" ! ["Visit Folder" vm-visit-folder t] ! ["Visit POP Folder" vm-visit-pop-folder t] ["Revert Folder (back to disk version)" vm-revert-buffer --- 71,75 ---- "---" ! ["Visit Local Folder" vm-visit-folder t] ! ["Visit POP Folder" vm-visit-pop-folder vm-pop-folder-alist] ! ["Visit IMAP Folder" vm-visit-imap-folder vm-imap-server-list] ["Revert Folder (back to disk version)" vm-revert-buffer *** dist/vm-mime.el.dist Tue May 27 15:16:44 2003 --- vm-mime.el Mon Jun 16 11:11:21 2003 *************** *** 6000,6013 **** (or vm-mf-default-action ! (if (or (vm-mime-can-display-internal layout) ! (vm-mime-find-external-viewer (car (vm-mm-layout-type layout))) ! (vm-mime-can-convert (car (vm-mm-layout-type layout)))) ! (let ((p vm-mime-default-action-string-alist) ! (type (car (vm-mm-layout-type layout)))) ! (catch 'done ! (while p ! (if (vm-mime-types-match (car (car p)) type) ! (throw 'done (cdr (car p))) ! (setq p (cdr p)))) ! nil )) ! "save to a file") ;; should not be reached --- 6000,6017 ---- (or vm-mf-default-action ! (let (cons) ! (cond ((or (vm-mime-can-display-internal layout) ! (vm-mime-find-external-viewer ! (car (vm-mm-layout-type layout)))) ! (let ((p vm-mime-default-action-string-alist) ! (type (car (vm-mm-layout-type layout)))) ! (catch 'done ! (while p ! (if (vm-mime-types-match (car (car p)) type) ! (throw 'done (cdr (car p))) ! (setq p (cdr p)))) ! nil ))) ! ((setq cons (vm-mime-can-convert ! (car (vm-mm-layout-type layout)))) ! (format "convert to %s and display" (nth 1 cons))) ! (t "save to a file"))) ;; should not be reached *** dist/vm-save.el.dist Tue May 27 15:16:44 2003 --- vm-save.el Tue May 27 20:23:27 2003 *************** *** 643,645 **** (list (vm-read-imap-folder-name "Save to IMAP folder: " ! vm-imap-server-list) (prefix-numeric-value current-prefix-arg))))) --- 643,645 ---- (list (vm-read-imap-folder-name "Save to IMAP folder: " ! vm-imap-server-list t) (prefix-numeric-value current-prefix-arg))))) *** dist/vm-startup.el.dist Tue May 27 15:16:44 2003 --- vm-startup.el Sun Jul 6 23:55:08 2003 *************** *** 421,423 **** ! This is VM 7.16. --- 421,423 ---- ! This is VM 7.17. *************** *** 1044,1046 **** (if current-prefix-arg " read only" "")) ! vm-imap-server-list) current-prefix-arg)))) --- 1044,1046 ---- (if current-prefix-arg " read only" "")) ! vm-imap-server-list t) current-prefix-arg)))) *** dist/vm-vars.el.dist Tue May 27 15:16:44 2003 --- vm-vars.el Wed Jun 18 11:40:10 2003 *************** *** 507,521 **** - (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 --- 507,508 ---- *************** *** 1224,1226 **** "*Name of ImageMagick 'convert' program. ! VM uses this toconvert between image formats and to slice up images for display. Set this to nil and VM will not use the --- 1211,1213 ---- "*Name of ImageMagick 'convert' program. ! VM uses this program to convert between image formats and to slice up images for display. Set this to nil and VM will not use the *************** *** 1229,1233 **** ! (defcustom vm-imagemagick-identify-program (vm-locate-executable-file "identify") "*Name of ImageMagick 'identify' program. ! VM uses this to gather information about images. Set this to nil and VM will not use the 'convert' program." --- 1216,1221 ---- ! (defcustom vm-imagemagick-identify-program ! (vm-locate-executable-file "identify") "*Name of ImageMagick 'identify' program. ! VM uses this program to gather information about images. Set this to nil and VM will not use the 'convert' program." *************** *** 1500,1502 **** "*Non-nil value is a default source directory for MIME attachments. ! When vm-mime-attach=file prompts you for the name of a file to attach, any relative pathnames will be relative to this directory." --- 1488,1490 ---- "*Non-nil value is a default source directory for MIME attachments. ! When vm-mime-attach-file prompts you for the name of a file to attach, any relative pathnames will be relative to this directory." *************** *** 1528,1530 **** ! (defcustom vm-mime-base64-decoder-program nil "*Non-nil value should be a string that names a MIME base64 decoder. --- 1516,1519 ---- ! (defcustom vm-mime-base64-decoder-program ! (vm-locate-executable-file "base64-decode") "*Non-nil value should be a string that names a MIME base64 decoder. *************** *** 1541,1543 **** ! (defcustom vm-mime-base64-encoder-program nil "*Non-nil value should be a string that names a MIME base64 encoder. --- 1530,1533 ---- ! (defcustom vm-mime-base64-encoder-program ! (vm-locate-executable-file "base64-encode") "*Non-nil value should be a string that names a MIME base64 encoder. *************** *** 1554,1556 **** ! (defcustom vm-mime-qp-decoder-program nil "*Non-nil value should be a string that names a MIME quoted-printable --- 1544,1546 ---- ! (defcustom vm-mime-qp-decoder-program (vm-locate-executable-file "qp-decode") "*Non-nil value should be a string that names a MIME quoted-printable *************** *** 1567,1569 **** ! (defcustom vm-mime-qp-encoder-program nil "*Non-nil value should be a string that names a MIME quoted-printable --- 1557,1559 ---- ! (defcustom vm-mime-qp-encoder-program (vm-locate-executable-file "qp-encode") "*Non-nil value should be a string that names a MIME quoted-printable *************** *** 4541,4542 **** --- 4531,4533 ---- (defvar vm-imap-keep-trace-buffer nil) + (defvar vm-imap-session-done nil) (defvar vm-reply-list nil) *** dist/vm-version.el.dist Tue May 27 15:16:44 2003 --- vm-version.el Sun Jul 6 23:55:08 2003 *************** *** 3,5 **** ! (defconst vm-version "7.16" "Version number of VM.") --- 3,5 ---- ! (defconst vm-version "7.17" "Version number of VM.") *** dist/tapestry.el.dist Thu Mar 27 20:34:53 2003 --- tapestry.el Thu Jun 5 07:31:38 2003 *************** *** 22,24 **** ! (defvar tapestry-version "1.08") --- 22,24 ---- ! (defvar tapestry-version "1.09") *************** *** 541,543 **** (defun tapestry-window-edges (&optional window) ! (if (fboundp 'window-pixel-edges) (let ((edges (window-pixel-edges window)) --- 541,545 ---- (defun tapestry-window-edges (&optional window) ! (if (and (fboundp 'window-pixel-edges) ! (fboundp 'face-width) ! (fboundp 'face-height)) (let ((edges (window-pixel-edges window))