mirror of https://github.com/djcb/mu.git
* mm updates (WIP)
This commit is contained in:
parent
2d52e671cc
commit
e685f6b7e0
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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*"
|
||||
|
|
Loading…
Reference in New Issue