diff --git a/toys/mm/mm-hdrs.el b/toys/mm/mm-hdrs.el index e8b262c6..7be539a3 100644 --- a/toys/mm/mm-hdrs.el +++ b/toys/mm/mm-hdrs.el @@ -30,7 +30,7 @@ ;; mm -;;; Code: +;; Code: (eval-when-compile (require 'cl)) @@ -451,7 +451,6 @@ point." (interactive) ) -;; TODO warn if marks exist (defun mm/rerun-search () "Rerun the search for the last search expression; if none exists, do a new search." @@ -513,7 +512,8 @@ return the new docid. Otherwise, return nil." "Mark message at point for moving to the trash folder (`mm/trash-folder')." (interactive) - (unless mm/trash-folder (error "`mm/trash-folder' is not set")) + (unless mm/trash-folder + (error "`mm/trash-folder' is not set")) (mm/hdrs-mark 'trash) (mm/next-header)) diff --git a/toys/mm/mm-proc.el b/toys/mm/mm-proc.el index d63b422d..95f35a6e 100644 --- a/toys/mm/mm-proc.el +++ b/toys/mm/mm-proc.el @@ -72,16 +72,26 @@ for the format of .") "*internal* A function called for each (:info type ....) sexp received from the server process.") - (defvar mm/buf nil "*internal* Buffer for results data.") +(defvar mm/path-docid-map + (make-hash-table :size 32 :rehash-size 2 :weakness nil) + "*internal* hash we use to keep a path=>docid mapping for message +we added ourselves (ie., draft messages), so we can e.g. move them +to the sent folder using their docid") + (defun mm/proc-info-handler (info) "Handler function for (:info ...) sexps received from the server process." (let ((type (plist-get info :info))) (cond ;; (:info :version "3.1") + ((eq type 'add) + ;; update our path=>docid map; we use this when composing messages to + ;; add draft messages to the db, so when we're sending them, we can move + ;; to the sent folder using the `mm/proc-move'. + (puthash (plist-get info :path) (plist-get-info :docid) mm/path-docid-map)) ((eq type 'version) (setq mm/mu-version (plist-get info :version))) ((eq type 'index) (if (eq (plist-get info :status) 'running) @@ -198,7 +208,8 @@ updated as well, with all processed sexp data removed." (while sexp (mm/proc-log "%S" sexp) (cond - ((eq (plist-get sexp :msgtype) 'header) + ;; a header plist can be recognized by the existence of a :date field + ((plist-get sexp :date) (funcall mm/proc-header-func sexp)) ((plist-get sexp :view) (funcall mm/proc-view-func (plist-get sexp :view))) @@ -243,10 +254,11 @@ terminates." (defun mm/proc-log (frm &rest args) "Write something in the *mm-log* buffer - mainly useful for debugging." - (with-current-buffer (get-buffer-create mm/proc-log-buffer-name) - (goto-char (point-max)) - (insert (apply 'format (concat (format-time-string "%Y-%m-%d %T " - (current-time)) frm "\n") args)))) + (when mm/debug + (with-current-buffer (get-buffer-create mm/proc-log-buffer-name) + (goto-char (point-max)) + (insert (apply 'format (concat (format-time-string "%Y-%m-%d %T " + (current-time)) frm "\n") args))))) (defun mm/proc-send-command (frm &rest args) "Send as command to the mu server process; start the process if needed." @@ -302,8 +314,7 @@ or (:error ) sexp, which are handled my `mm/proc-update-func' and (fullpath (concat mm/maildir targetmdir))) (unless (and (file-directory-p fullpath) (file-writable-p fullpath)) (error "Not a writable directory: %s" fullpath)) - (mm/proc-send-command "move %d %s %s" docid targetmdir flagstr))) - + (mm/proc-send-command "move %d \"%s\" \"%s\"" docid targetmdir flagstr))) (defun mm/proc-flag-msg (docid flags) "Set FLAGS for the message identified by DOCID." @@ -311,8 +322,13 @@ or (:error ) sexp, which are handled my `mm/proc-update-func' and (mm/proc-send-command "flag %d %s" docid flagstr))) (defun mm/proc-index (maildir) - "Update the message database." - (mm/proc-send-command "index %s" maildir)) + "Update the message database for MAILDIR." + (mm/proc-send-command "index \"%s\"" maildir)) + +(defun mm/proc-add (path) + "Add the message at PATH to the database; if this works, we will +receive (:info :path :docid )." + (mm/proc-send-command "add \"%s\"" path)) (defun mm/proc-view-msg (docid) "Get one particular message based on its DOCID. The result will diff --git a/toys/mm/mm-send.el b/toys/mm/mm-send.el index c4a75405..0853761e 100644 --- a/toys/mm/mm-send.el +++ b/toys/mm/mm-send.el @@ -327,10 +327,16 @@ using Gnus' `message-mode'." (unless mm/drafts-folder (error "mm/drafts-folder not set")) ;; write our draft message to the the drafts folder - (let ((draftfile (concat mm/maildir "/" mm/drafts-folder "/cur/" + (let ((draftfile (concat mm/maildir mm/drafts-folder "/cur/" (mm/msg-draft-file-name)))) (with-temp-file draftfile (insert str)) - (find-file draftfile) (rename-buffer mm/msg-draft-name t) + (find-file draftfile) + (rename-buffer mm/msg-draft-name t) + + ;; save our file immediately, add add it to the db; thus, we can retrieve + ;; the new docid from `mm/path-docid-map'. + (write-file draftfile) + (mm/proc-add draftfile) (message-mode) @@ -376,28 +382,20 @@ edit buffer with the draft message" ;; exact num depends on some more things (when (mm/msg-compose (mm/msg-create-reply msg replyall) parent-docid 'reply) (message-goto-body)))))) - (defun mm/msg-save-to-sent () "Move the message in this buffer to the sent folder. This is meant to be called from message mode's `message-sent-hook'." + (unless mm/sent-folder (error "mm/sent-folder not set")) (when (mm/msg-is-mm-message) ;; only if we are mm - (unless mm/sent-folder (error "mm/sent-folder not set")) - ;; we don't know the draft message is already in the database... - ;; - ;; ;; TODO: remove duplicate flags - ;; ((newflags ;; remove Draft; maybe set 'Seen' as well? - ;; (delq 'draft (mm/msg-flags-from-path (buffer-file-name)))) - ;; ;; so, we register path => uid, then we move uid, then check the name - ;; ;; uid is referring to - ;; (uid (mm/msg-register (buffer-file-name))) - ;; (if (mm/msg-move uid - ;; (concat mm/maildir mm/sent-folder) - ;; (mm/msg-flags-to-string newflags)) - ;; (set-visited-file-name (mm/msg-get-path uid) t t) - ;; (error "Failed to save message to the Sent-folder")))))) -)) + (let ((docid (gethash (buffer-file-name) mm/path-docid-map))) + (unless docid (error "unknown message")) + ;; ok, all seems well, well move the message to the sent-folder + (mm/proc-move-msg docid mm/sent-folder) + ;; mark the buffer as read-only, as its pointing at a non-existing file + ;; now... + (setq buffer-read-only t)))) (defun mm/send-set-parent-flag () "Set the 'replied' flag on messages we replied to, and the @@ -415,7 +413,7 @@ This is meant to be called from message mode's ;; hook our functions up with sending of the message -;;(add-hook 'message-sent-hook 'mm/msg-save-to-sent) +(add-hook 'message-sent-hook 'mm/msg-save-to-sent) (add-hook 'message-sent-hook 'mm/send-set-parent-flag) diff --git a/toys/mm/mm.el b/toys/mm/mm.el index 6e6c0535..357a68f4 100644 --- a/toys/mm/mm.el +++ b/toys/mm/mm.el @@ -67,7 +67,8 @@ PATH, you can specifiy the full path." :group 'mm :safe 'stringp) - +(defvar mm/debug nil + "When set to non-nil, log debug information to the *mm-log* buffer.") ;; Folders @@ -211,7 +212,7 @@ be sure it no longer matches)." (let ((map (make-sparse-keymap))) (define-key map "I" 'mm/jump-to-inbox) - (define-key map "S" 'mm/search-today) + (define-key map "T" 'mm/search-today) (define-key map "W" 'mm/search-last-7-days) (define-key map "U" 'mm/search-unread) @@ -266,7 +267,7 @@ be sure it no longer matches)." " * " (propertize "c" 'face 'highlight) "ompose a new message\n" "\n" " * " (propertize "r" 'face 'highlight) "etrieve new mail\n" - " * " (propertize "u" 'face 'highlight) "update the message database\n" + " * " (propertize "u" 'face 'highlight) "pdate the message database\n" "\n" " * " (propertize "q" 'face 'highlight) "uit mm\n") @@ -295,7 +296,7 @@ be sure it no longer matches)." (defun mm/search-last-7-days () "List messages received in the last 7 days." (interactive) - (mm/hdrs-search "flag:7d..now")) + (mm/hdrs-search "date:7d..now")) (defun mm/retrieve-mail () "Get new mail."