From e685f6b7e0d669e88e8728d794beedfad59d7405 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Tue, 20 Sep 2011 00:20:59 +0300 Subject: [PATCH] * mm updates (WIP) --- toys/mm/mm-proc.el | 25 ++++++++++++++------ toys/mm/mm-send.el | 17 ++++++++++---- toys/mm/mm-view.el | 58 +++++++++++++++++++++++++++++++++++++++++++--- toys/mm/mm.el | 9 +++++-- 4 files changed, 93 insertions(+), 16 deletions(-) diff --git a/toys/mm/mm-proc.el b/toys/mm/mm-proc.el index 95f35a6e..f8d98cb9 100644 --- a/toys/mm/mm-proc.el +++ b/toys/mm/mm-proc.el @@ -76,7 +76,7 @@ received from the server process.") "*internal* Buffer for results data.") (defvar mm/path-docid-map - (make-hash-table :size 32 :rehash-size 2 :weakness nil) + (make-hash-table :size 32 :rehash-size 2 :test 'equal :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") @@ -91,7 +91,7 @@ process." ;; 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)) + (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) @@ -100,7 +100,8 @@ process." (message (format "Indexing completed; processed %d, updated %d, cleaned-up %d" (plist-get info :processed) (plist-get info :updated) - (plist-get info :cleaned-up)))))))) + (plist-get info :cleaned-up))))) + ((plist-get info :message) (message "%s" (plist-get info :message)))))) (defun mm/start-proc () @@ -314,6 +315,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)) + ;; note, we send the maildir, *not* the full path (mm/proc-send-command "move %d \"%s\" \"%s\"" docid targetmdir flagstr))) (defun mm/proc-flag-msg (docid flags) @@ -325,10 +327,19 @@ or (:error ) sexp, which are handled my `mm/proc-update-func' and "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-add (path maildir) + "Add the message at PATH to the database, with MAILDIR +set to e.g. '/drafts'; if this works, we will receive (:info :path + :docid )." + (mm/proc-send-command "add \"%s\" \"%s\"" path maildir)) + +(defun mm/proc-save (docid partidx path) + "Save attachment PARTIDX from message with DOCID to PATH." + (mm/proc-send-command "save %d %d \"%s\"" docid partidx path)) + +(defun mm/proc-open (docid partidx) + "Open attachment PARTIDX from message with DOCID." + (mm/proc-send-command "open %d %d" docid partidx)) (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 0853761e..44a2feab 100644 --- a/toys/mm/mm-send.el +++ b/toys/mm/mm-send.el @@ -304,6 +304,8 @@ message. (defvar mm/send-reply-docid nil "Docid of the message this is a reply to.") (defvar mm/send-forward-docid nil "Docid of the message being forwarded.") +(defvar mm/mm-msg nil "Whether the current message is an mm msg.") + (defun mm/msg-compose (str &optional parent-docid reply-or-forward) "Create a new draft message in the drafts folder with STR as its contents, and open this message file for editing. @@ -336,12 +338,15 @@ using Gnus' `message-mode'." ;; 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) + (mm/proc-add draftfile mm/drafts-folder) (message-mode) (make-local-variable 'mm/send-reply-docid) (make-local-variable 'mm/send-forward-docid) + (make-local-variable 'mm/mm-msg) + + (setq mm/mm-msg t) (if (eq reply-or-forward 'reply) (setq mm/send-reply-docid parent-docid) @@ -388,13 +393,17 @@ edit buffer with the draft message" "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 + (when mm/mm-msg ;; only if we are mm (let ((docid (gethash (buffer-file-name) mm/path-docid-map))) - (unless docid (error "unknown message")) + (unless docid (error "unknown message (%S)" (buffer-file-name))) ;; ok, all seems well, well move the message to the sent-folder - (mm/proc-move-msg docid mm/sent-folder) + (mm/proc-move-msg docid mm/sent-folder "-T-D+S") + ;; we can remove the value from the hash now, if we can establish there + ;; are not other compose buffers using this very same docid... + ;; mark the buffer as read-only, as its pointing at a non-existing file ;; now... + (message "Message has been sent") (setq buffer-read-only t)))) (defun mm/send-set-parent-flag () diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index 89045dff..9db4dd8a 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -77,7 +77,7 @@ marking if it still had that." (sizestr (when size (format "%d bytes")))) (if sizestr (mm/view-header "Size" sizestr)))) - (:attachments "") ;; TODO + (:attachments (mm/view-attachments msg)) (t (error "Unsupported field: %S" field)))) mm/view-headers "") "\n" @@ -129,6 +129,27 @@ or if not available, :body-html converted to text)." contacts) ""))) +(defvar mm/attach-map nil + "*internal* Hash which maps a number to a (part-id name mime-type).") + + +(defun mm/view-attachments (msg) + "Display attachment information; the field looks like something like: + :attachments ((4 \"statement Bray Eile.doc\" \"application/msword\"))." + (let ((atts (plist-get msg :attachments))) + (when atts + (setq mm/attach-map + (make-hash-table :size 32 :rehash-size 2 :weakness nil)) + (let* ((id 0) + (vals + (mapconcat + (lambda (att) + (incf id) + (puthash id att mm/attach-map) + (format "[%d]%s" id (nth 1 att))) + atts ", "))) + (mm/view-header (format "Attachments(%d):" id) vals))))) + (defvar mm/view-mode-map (let ((map (make-sparse-keymap))) @@ -145,15 +166,18 @@ or if not available, :body-html converted to text)." (define-key map "n" 'mm/view-next) (define-key map "p" 'mm/view-prev) + ;; attachments + (define-key map "e" 'mm/view-extract-attachment) + (define-key map "o" 'mm/view-open-attachment) + ;; marking/unmarking (define-key map "d" 'mm/view-mark-for-trash) (define-key map "D" 'mm/view-mark-for-delete) (define-key map "m" 'mm/view-mark-for-move) - ;; next two only warn user + ;; next 3 only warn user (define-key map "u" 'mm/view-unmark) (define-key map "U" 'mm/view-unmark) - (define-key map "x" 'mm/view-marked-execute) map) "Keymap for \"*mm-view*\" buffers.") @@ -216,6 +240,34 @@ Seen; if the message is not New/Unread, do nothing." (when (mm/prev-header) (mm/hdrs-view)))) + +(defun mm/view-extract-attachment (attnum) + "Extract the attachment with ATTNUM" + (unless mm/attachment-dir (error "`mm/attachment-dir' is not set")) + (when (zerop (hash-table-count mm/attach-map)) + (error "No attachments for this message")) + (interactive "nAttachment to extract:") + (let* ((att (gethash attnum mm/attach-map)) + (path (when att (concat mm/attachment-dir "/" (nth 1 att)))) + (retry t)) + (unless att (error "Not a valid attachment number")) + (while retry + (setq path (expand-file-name (read-string "Save as " path))) + (setq retry + (and (file-exists-p path) + (not (y-or-n-p (concat "Overwrite " path "?")))))) + (mm/proc-save (plist-get mm/current-msg :docid) (car att) path))) + +(defun mm/view-open-attachment (attnum) + "Extract the attachment with ATTNUM" + (when (zerop (hash-table-count mm/attach-map)) + (error "No attachments for this message")) + (interactive "nAttachment to open:") + (let* ((att (gethash attnum mm/attach-map))) + (unless att (error "Not a valid attachment number")) + (mm/proc-open (plist-get mm/current-msg :docid) (car att)))) + + (defun mm/view-mark-for-trash () "Mark the viewed message to be moved to the trash folder." (interactive) diff --git a/toys/mm/mm.el b/toys/mm/mm.el index 357a68f4..082aee20 100644 --- a/toys/mm/mm.el +++ b/toys/mm/mm.el @@ -67,9 +67,16 @@ PATH, you can specifiy the full path." :group 'mm :safe 'stringp) +(defcustom mm/attachment-dir (expand-file-name "~/") + "Default directory for saving attachments." + :type 'string + :group 'mm + :safe 'stringp) + (defvar mm/debug nil "When set to non-nil, log debug information to the *mm-log* buffer.") + ;; Folders (defgroup mm/folders nil @@ -196,8 +203,6 @@ be sure it no longer matches)." - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; internal variables / constant (defconst mm/mm-buffer-name "*mm*"