* toys/mm: updates

This commit is contained in:
Dirk-Jan C. Binnema 2011-09-18 23:57:46 +03:00
parent 553b88620e
commit 88d81512c4
4 changed files with 51 additions and 36 deletions

View File

@ -30,7 +30,7 @@
;; mm ;; mm
;;; Code: ;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
@ -451,7 +451,6 @@ point."
(interactive) (interactive)
) )
;; TODO warn if marks exist
(defun mm/rerun-search () (defun mm/rerun-search ()
"Rerun the search for the last search expression; if none exists, "Rerun the search for the last search expression; if none exists,
do a new search." do a new search."
@ -513,7 +512,8 @@ return the new docid. Otherwise, return nil."
"Mark message at point for moving to the trash "Mark message at point for moving to the trash
folder (`mm/trash-folder')." folder (`mm/trash-folder')."
(interactive) (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/hdrs-mark 'trash)
(mm/next-header)) (mm/next-header))

View File

@ -72,16 +72,26 @@ for the format of <msg-plist>.")
"*internal* A function called for each (:info type ....) sexp "*internal* A function called for each (:info type ....) sexp
received from the server process.") received from the server process.")
(defvar mm/buf nil (defvar mm/buf nil
"*internal* Buffer for results data.") "*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) (defun mm/proc-info-handler (info)
"Handler function for (:info ...) sexps received from the server "Handler function for (:info ...) sexps received from the server
process." process."
(let ((type (plist-get info :info))) (let ((type (plist-get info :info)))
(cond (cond
;; (:info :version "3.1") ;; (: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 'version) (setq mm/mu-version (plist-get info :version)))
((eq type 'index) ((eq type 'index)
(if (eq (plist-get info :status) 'running) (if (eq (plist-get info :status) 'running)
@ -198,7 +208,8 @@ updated as well, with all processed sexp data removed."
(while sexp (while sexp
(mm/proc-log "%S" sexp) (mm/proc-log "%S" sexp)
(cond (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)) (funcall mm/proc-header-func sexp))
((plist-get sexp :view) ((plist-get sexp :view)
(funcall mm/proc-view-func (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) (defun mm/proc-log (frm &rest args)
"Write something in the *mm-log* buffer - mainly useful for debugging." "Write something in the *mm-log* buffer - mainly useful for debugging."
(with-current-buffer (get-buffer-create mm/proc-log-buffer-name) (when mm/debug
(goto-char (point-max)) (with-current-buffer (get-buffer-create mm/proc-log-buffer-name)
(insert (apply 'format (concat (format-time-string "%Y-%m-%d %T " (goto-char (point-max))
(current-time)) frm "\n") args)))) (insert (apply 'format (concat (format-time-string "%Y-%m-%d %T "
(current-time)) frm "\n") args)))))
(defun mm/proc-send-command (frm &rest args) (defun mm/proc-send-command (frm &rest args)
"Send as command to the mu server process; start the process if needed." "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))) (fullpath (concat mm/maildir targetmdir)))
(unless (and (file-directory-p fullpath) (file-writable-p fullpath)) (unless (and (file-directory-p fullpath) (file-writable-p fullpath))
(error "Not a writable directory: %s" 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) (defun mm/proc-flag-msg (docid flags)
"Set FLAGS for the message identified by DOCID." "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))) (mm/proc-send-command "flag %d %s" docid flagstr)))
(defun mm/proc-index (maildir) (defun mm/proc-index (maildir)
"Update the message database." "Update the message database for MAILDIR."
(mm/proc-send-command "index %s" 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-view-msg (docid) (defun mm/proc-view-msg (docid)
"Get one particular message based on its DOCID. The result will "Get one particular message based on its DOCID. The result will

View File

@ -327,10 +327,16 @@ using Gnus' `message-mode'."
(unless mm/drafts-folder (error "mm/drafts-folder not set")) (unless mm/drafts-folder (error "mm/drafts-folder not set"))
;; write our draft message to the the drafts folder ;; 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)))) (mm/msg-draft-file-name))))
(with-temp-file draftfile (insert str)) (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) (message-mode)
@ -376,28 +382,20 @@ edit buffer with the draft message"
;; exact num depends on some more things ;; exact num depends on some more things
(when (mm/msg-compose (mm/msg-create-reply msg replyall) parent-docid 'reply) (when (mm/msg-compose (mm/msg-create-reply msg replyall) parent-docid 'reply)
(message-goto-body)))))) (message-goto-body))))))
(defun mm/msg-save-to-sent () (defun mm/msg-save-to-sent ()
"Move the message in this buffer to the sent folder. This is "Move the message in this buffer to the sent folder. This is
meant to be called from message mode's `message-sent-hook'." 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/msg-is-mm-message) ;; only if we are mm
(unless mm/sent-folder (error "mm/sent-folder not set")) (let ((docid (gethash (buffer-file-name) mm/path-docid-map)))
;; we don't know the draft message is already in the database... (unless docid (error "unknown message"))
;; ;; ok, all seems well, well move the message to the sent-folder
;; ;; TODO: remove duplicate flags (mm/proc-move-msg docid mm/sent-folder)
;; ((newflags ;; remove Draft; maybe set 'Seen' as well? ;; mark the buffer as read-only, as its pointing at a non-existing file
;; (delq 'draft (mm/msg-flags-from-path (buffer-file-name)))) ;; now...
;; ;; so, we register path => uid, then we move uid, then check the name (setq buffer-read-only t))))
;; ;; 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"))))))
))
(defun mm/send-set-parent-flag () (defun mm/send-set-parent-flag ()
"Set the 'replied' flag on messages we replied to, and the "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 ;; 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) (add-hook 'message-sent-hook 'mm/send-set-parent-flag)

View File

@ -67,7 +67,8 @@ PATH, you can specifiy the full path."
:group 'mm :group 'mm
:safe 'stringp) :safe 'stringp)
(defvar mm/debug nil
"When set to non-nil, log debug information to the *mm-log* buffer.")
;; Folders ;; Folders
@ -211,7 +212,7 @@ be sure it no longer matches)."
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map "I" 'mm/jump-to-inbox) (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 "W" 'mm/search-last-7-days)
(define-key map "U" 'mm/search-unread) (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" " * " (propertize "c" 'face 'highlight) "ompose a new message\n"
"\n" "\n"
" * " (propertize "r" 'face 'highlight) "etrieve new mail\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" "\n"
" * " (propertize "q" 'face 'highlight) "uit mm\n") " * " (propertize "q" 'face 'highlight) "uit mm\n")
@ -295,7 +296,7 @@ be sure it no longer matches)."
(defun mm/search-last-7-days () (defun mm/search-last-7-days ()
"List messages received in the last 7 days." "List messages received in the last 7 days."
(interactive) (interactive)
(mm/hdrs-search "flag:7d..now")) (mm/hdrs-search "date:7d..now"))
(defun mm/retrieve-mail () (defun mm/retrieve-mail ()
"Get new mail." "Get new mail."