* mm updates (WIP)

This commit is contained in:
Dirk-Jan C. Binnema 2011-09-20 00:20:59 +03:00
parent 2d52e671cc
commit e685f6b7e0
4 changed files with 93 additions and 16 deletions

View File

@ -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 <path> :docid <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
<path> :docid <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

View File

@ -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 ()

View File

@ -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)

View File

@ -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*"