mirror of https://github.com/djcb/mu.git
* toys/mm: updates
This commit is contained in:
parent
553b88620e
commit
88d81512c4
|
@ -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))
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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."
|
||||||
|
|
Loading…
Reference in New Issue