2011-09-12 19:52:32 +02:00
|
|
|
;;; mm-proc.el -- part of mm, the mu mail user agent
|
|
|
|
;;
|
|
|
|
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
|
|
|
|
|
|
|
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
|
|
|
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
|
|
|
;; Keywords: email
|
|
|
|
;; Version: 0.0
|
|
|
|
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;;
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
(eval-when-compile (require 'cl))
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; internal vars
|
|
|
|
|
|
|
|
(defvar mm/mu-proc nil
|
|
|
|
"*internal* The mu-server process")
|
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-error-func 'mm/default-handler
|
2011-09-12 19:52:32 +02:00
|
|
|
"*internal* A function called for each error returned from the
|
|
|
|
server process; the function is passed an error plist as
|
2011-09-18 13:39:36 +02:00
|
|
|
argument. See `mm/proc-filter' for the format.")
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-update-func 'mm/default-handler
|
2011-09-18 13:39:36 +02:00
|
|
|
"*internal* A function called for each :update sexp returned from
|
|
|
|
the server process; the function is passed a msg sexp as
|
|
|
|
argument. See `mm/proc-filter' for the format.")
|
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-remove-func 'mm/default-handler
|
2011-09-18 13:39:36 +02:00
|
|
|
"*internal* A function called for each :remove sexp returned from
|
|
|
|
the server process, when some message has been deleted. The
|
|
|
|
function is passed the docid of the removed message.")
|
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-view-func 'mm/default-handler
|
2011-09-18 13:39:36 +02:00
|
|
|
"*internal* A function called for each single message sexp
|
|
|
|
returned from the server process. The function is passed a message
|
|
|
|
sexp as argument. See `mm/proc-filter' for the
|
|
|
|
format.")
|
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-header-func 'mm/default-handler
|
2011-09-18 13:39:36 +02:00
|
|
|
"*internal* A function called for each message returned from the
|
|
|
|
server process; the function is passed a msg plist as argument. See
|
|
|
|
`mm/proc-filter' for the format.")
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-found-func 'mm/default-handler
|
2011-10-25 07:43:24 +02:00
|
|
|
"*internal* A function called for when we received a :found sexp
|
|
|
|
after the headers have returns, to report on the number of
|
|
|
|
matches. See `mm/proc-filter' for the format.")
|
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-compose-func 'mm/default-handler
|
2011-09-18 13:39:36 +02:00
|
|
|
"*internal* A function called for each message returned from the
|
|
|
|
server process that is used as basis for composing a new
|
|
|
|
message (ie., either a reply or a forward); the function is passed
|
|
|
|
msg and a symbol (either reply or forward). See `mm/proc-filter'
|
|
|
|
for the format of <msg-plist>.")
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-info-func 'mm/default-handler
|
2011-09-18 13:39:36 +02:00
|
|
|
"*internal* A function called for each (:info type ....) sexp
|
|
|
|
received from the server process.")
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defvar mm/proc-pong-func 'mm/default-handler
|
|
|
|
"*internal* A function called for each (:pong type ....) sexp
|
|
|
|
received from the server process.")
|
2011-09-30 07:37:47 +02:00
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defvar mm/buf nil
|
2011-09-12 19:52:32 +02:00
|
|
|
"*internal* Buffer for results data.")
|
|
|
|
|
2011-09-18 22:57:46 +02:00
|
|
|
(defvar mm/path-docid-map
|
2011-09-19 23:20:59 +02:00
|
|
|
(make-hash-table :size 32 :rehash-size 2 :test 'equal :weakness nil)
|
2011-09-18 22:57:46 +02:00
|
|
|
"*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")
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defun mm/proc-info-handler (info)
|
|
|
|
"Handler function for (:info ...) sexps received from the server
|
|
|
|
process."
|
|
|
|
(let ((type (plist-get info :info)))
|
|
|
|
(cond
|
|
|
|
;; (:info :version "3.1")
|
2011-09-18 22:57:46 +02:00
|
|
|
((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'.
|
2011-09-19 23:20:59 +02:00
|
|
|
(puthash (plist-get info :path) (plist-get info :docid) mm/path-docid-map))
|
2011-09-30 07:37:47 +02:00
|
|
|
((eq type 'version)
|
|
|
|
(setq
|
|
|
|
mm/version (plist-get info :version)
|
|
|
|
mm/doccount (plist-get-info :doccount)))
|
2011-09-18 13:39:36 +02:00
|
|
|
((eq type 'index)
|
|
|
|
(if (eq (plist-get info :status) 'running)
|
|
|
|
(message (format "Indexing... processed %d, updated %d"
|
|
|
|
(plist-get info :processed) (plist-get info :updated)))
|
|
|
|
(message
|
|
|
|
(format "Indexing completed; processed %d, updated %d, cleaned-up %d"
|
|
|
|
(plist-get info :processed) (plist-get info :updated)
|
2011-09-19 23:20:59 +02:00
|
|
|
(plist-get info :cleaned-up)))))
|
|
|
|
((plist-get info :message) (message "%s" (plist-get info :message))))))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defun mm/default-handler (&rest args)
|
|
|
|
"Dummy handler function."
|
|
|
|
(error "Not handled: %S" args))
|
|
|
|
|
2011-09-30 07:37:47 +02:00
|
|
|
(defconst mm/server-name "*mm-server"
|
|
|
|
"*internal* Name of the server process, buffer.")
|
|
|
|
|
2011-09-12 19:52:32 +02:00
|
|
|
(defun mm/start-proc ()
|
|
|
|
"Start the mu server process."
|
|
|
|
;; TODO: add version check
|
|
|
|
(unless (file-executable-p mm/mu-binary)
|
2011-09-30 07:37:47 +02:00
|
|
|
(error (format "%S not found" mm/mu-binary)))
|
2011-09-12 19:52:32 +02:00
|
|
|
(let* ((process-connection-type nil) ;; use a pipe
|
|
|
|
(args '("server"))
|
|
|
|
(args (append args (when mm/mu-home
|
|
|
|
(list (concat "--muhome=" mm/mu-home))))))
|
2011-09-18 13:39:36 +02:00
|
|
|
(setq mm/buf "")
|
2011-09-30 07:37:47 +02:00
|
|
|
(setq mm/mu-proc (apply 'start-process mm/server-name mm/server-name
|
2011-09-12 19:52:32 +02:00
|
|
|
mm/mu-binary args))
|
2011-09-18 13:39:36 +02:00
|
|
|
;; register a function for (:info ...) sexps
|
|
|
|
(setq mm/proc-info-func 'mm/proc-info-handler)
|
2011-09-12 19:52:32 +02:00
|
|
|
(when mm/mu-proc
|
2011-10-26 21:00:08 +02:00
|
|
|
(set-process-coding-system mm/mu-proc 'binary 'utf-8-unix)
|
2011-09-12 19:52:32 +02:00
|
|
|
(set-process-filter mm/mu-proc 'mm/proc-filter)
|
|
|
|
(set-process-sentinel mm/mu-proc 'mm/proc-sentinel))))
|
|
|
|
|
|
|
|
(defun mm/kill-proc ()
|
|
|
|
"Kill the mu server process."
|
2011-11-05 09:26:24 +01:00
|
|
|
(let* ((buf (get-buffer mm/server-name))
|
2011-12-07 07:50:03 +01:00
|
|
|
(proc (and buf (get-buffer-process buf))))
|
2011-11-05 09:26:24 +01:00
|
|
|
(when proc
|
2011-09-30 07:37:47 +02:00
|
|
|
(let ((delete-exited-processes t))
|
2011-10-10 07:38:14 +02:00
|
|
|
;; the mu server signal handler will make it quit after 'quit'
|
|
|
|
(mm/proc-send-command "quit"))
|
2011-11-05 09:26:24 +01:00
|
|
|
;; try sending SIGINT (C-c) to process, so it can exit gracefully
|
2011-12-07 07:50:03 +01:00
|
|
|
(ignore-errors
|
2011-11-05 09:26:24 +01:00
|
|
|
(signal-process proc 'SIGINT))))
|
|
|
|
(setq
|
|
|
|
mm/mu-proc nil
|
|
|
|
mm/buf nil))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
(defun mm/proc-is-running ()
|
|
|
|
(and mm/mu-proc (eq (process-status mm/mu-proc) 'run)))
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defun mm/proc-eat-sexp-from-buf ()
|
|
|
|
"'Eat' the next s-expression from `mm/buf'. `mm/buf gets its
|
|
|
|
contents from the mu-servers in the following form:
|
|
|
|
\376<len-of-sexp>\376<sexp>
|
|
|
|
Function returns this sexp, or nil if there was none. `mm/buf' is
|
|
|
|
updated as well, with all processed sexp data removed."
|
2011-09-30 07:37:47 +02:00
|
|
|
(when mm/buf
|
2011-11-05 09:26:24 +01:00
|
|
|
;; TODO: maybe try a non-regexp solution?
|
2011-09-30 07:37:47 +02:00
|
|
|
(let* ((b (string-match "\376\\([0-9]+\\)\376" mm/buf))
|
|
|
|
(sexp-len
|
|
|
|
(when b (string-to-number (match-string 1 mm/buf)))))
|
|
|
|
;; does mm/buf contain the full sexp?
|
|
|
|
(when (and b (>= (length mm/buf) (+ sexp-len (match-end 0))))
|
|
|
|
;; clear-up start
|
|
|
|
(setq mm/buf (substring mm/buf (match-end 0)))
|
2011-10-26 21:00:08 +02:00
|
|
|
;; note: we read the input in binary mode -- here, we take the part that
|
|
|
|
;; is the sexp, and convert that to utf-8, before we interpret it.
|
|
|
|
(let ((objcons
|
2011-11-05 09:26:24 +01:00
|
|
|
(ignore-errors ;; note: this may fail if we killed the process
|
|
|
|
;; in the middle
|
|
|
|
(read-from-string
|
|
|
|
(decode-coding-string (substring mm/buf 0 sexp-len) 'utf-8)))))
|
|
|
|
(when objcons
|
|
|
|
(setq mm/buf (substring mm/buf sexp-len))
|
|
|
|
(car objcons)))))))
|
2011-09-18 13:39:36 +02:00
|
|
|
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
(defun mm/proc-filter (proc str)
|
|
|
|
"A process-filter for the 'mu server' output; it accumulates the
|
2011-09-18 13:39:36 +02:00
|
|
|
strings into valid sexps by checking of the ';;eox' end-of-sexp
|
|
|
|
marker, and then evaluating them.
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
The server output is as follows:
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
1. an error
|
|
|
|
(:error 2 :error-message \"unknown command\")
|
|
|
|
;; eox
|
|
|
|
=> this will be passed to `mm/proc-error-func'.
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-10-25 07:43:24 +02:00
|
|
|
2a. a message sexp looks something like:
|
2011-09-12 19:52:32 +02:00
|
|
|
\(
|
|
|
|
:docid 1585
|
|
|
|
:from ((\"Donald Duck\" . \"donald@example.com\"))
|
|
|
|
:to ((\"Mickey Mouse\" . \"mickey@example.com\"))
|
|
|
|
:subject \"Wicked stuff\"
|
|
|
|
:date (20023 26572 0)
|
|
|
|
:size 15165
|
|
|
|
:references (\"200208121222.g7CCMdb80690@msg.id\")
|
|
|
|
:in-reply-to \"200208121222.g7CCMdb80690@msg.id\"
|
|
|
|
:message-id \"foobar32423847ef23@pluto.net\"
|
|
|
|
:maildir: \"/archive\"
|
|
|
|
:path \"/home/mickey/Maildir/inbox/cur/1312254065_3.32282.pluto,4cd5bd4e9:2,\"
|
|
|
|
:priority high
|
|
|
|
:flags (new unread)
|
|
|
|
:attachments ((2 \"hello.jpg\" \"image/jpeg\") (3 \"laah.mp3\" \"audio/mp3\"))
|
|
|
|
:body-txt \" <message body>\"
|
|
|
|
\)
|
|
|
|
;; eox
|
2011-09-18 13:39:36 +02:00
|
|
|
=> this will be passed to `mm/proc-header-func'.
|
|
|
|
|
2011-10-25 07:43:24 +02:00
|
|
|
2b. After the list of message sexps has been returned (see 2a.),
|
|
|
|
we'll receive a sexp that looks like
|
|
|
|
(:found <n>) with n the number of messages found. The <n> will be
|
|
|
|
passed to `mm/proc-found-func'.
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
3. a view looks like:
|
|
|
|
(:view <msg-sexp>)
|
|
|
|
=> the <msg-sexp> (see 2.) will be passed to `mm/proc-view-func'.
|
|
|
|
|
|
|
|
4. a database update looks like:
|
|
|
|
(:update <msg-sexp> :move <nil-or-t>)
|
|
|
|
|
|
|
|
=> the <msg-sexp> (see 2.) will be passed to
|
|
|
|
`mm/proc-update-func', :move tells us whether this is a move to
|
|
|
|
another maildir, or merely a flag change.
|
|
|
|
|
|
|
|
5. a remove looks like:
|
|
|
|
(:remove <docid>)
|
|
|
|
=> the docid will be passed to `mm/proc-remove-func'
|
|
|
|
|
|
|
|
6. a compose looks like:
|
|
|
|
(:compose <msg-sexp> :action <reply|forward>) => the <msg-sexp>
|
|
|
|
and either 'reply or 'forward will be passed
|
|
|
|
`mm/proc-compose-func'."
|
2011-10-10 07:38:14 +02:00
|
|
|
(mm/proc-log "* Received %d byte(s)" (length str))
|
2011-09-18 13:39:36 +02:00
|
|
|
(setq mm/buf (concat mm/buf str)) ;; update our buffer
|
|
|
|
(let ((sexp (mm/proc-eat-sexp-from-buf)))
|
|
|
|
(while sexp
|
2011-09-20 22:59:20 +02:00
|
|
|
(mm/proc-log "<- %S" sexp)
|
2011-09-18 13:39:36 +02:00
|
|
|
(cond
|
2011-09-18 22:57:46 +02:00
|
|
|
;; a header plist can be recognized by the existence of a :date field
|
|
|
|
((plist-get sexp :date)
|
2011-09-18 13:39:36 +02:00
|
|
|
(funcall mm/proc-header-func sexp))
|
2011-10-25 07:43:24 +02:00
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
;; the found sexp, we receive after getting all the headers
|
2011-10-25 07:43:24 +02:00
|
|
|
((plist-get sexp :found)
|
|
|
|
(funcall mm/proc-found-func (plist-get sexp :found)))
|
|
|
|
|
|
|
|
;; viewin a specific message
|
2011-09-18 13:39:36 +02:00
|
|
|
((plist-get sexp :view)
|
|
|
|
(funcall mm/proc-view-func (plist-get sexp :view)))
|
2011-09-22 20:01:35 +02:00
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
;; receive a pong message
|
|
|
|
((plist-get sexp :pong)
|
|
|
|
(funcall mm/proc-pong-func
|
|
|
|
(plist-get sexp :version) (plist-get sexp :doccount)))
|
|
|
|
|
2011-09-22 20:01:35 +02:00
|
|
|
;; something got moved/flags changed
|
2011-09-18 13:39:36 +02:00
|
|
|
((plist-get sexp :update)
|
|
|
|
(funcall mm/proc-update-func
|
|
|
|
(plist-get sexp :update) (plist-get sexp :move)))
|
2011-09-22 20:01:35 +02:00
|
|
|
|
|
|
|
;; a message got removed
|
2011-09-18 13:39:36 +02:00
|
|
|
((plist-get sexp :remove)
|
|
|
|
(funcall mm/proc-remove-func (plist-get sexp :remove)))
|
2011-09-22 20:01:35 +02:00
|
|
|
|
|
|
|
;; start composing a new message
|
2011-09-18 13:39:36 +02:00
|
|
|
((plist-get sexp :compose)
|
|
|
|
(funcall mm/proc-compose-func
|
2011-10-02 20:35:03 +02:00
|
|
|
(plist-get sexp :compose-type)
|
|
|
|
(plist-get sexp :compose)))
|
2011-09-22 20:01:35 +02:00
|
|
|
|
|
|
|
;; get some info
|
2011-09-18 13:39:36 +02:00
|
|
|
((plist-get sexp :info)
|
|
|
|
(funcall mm/proc-info-func sexp))
|
2011-09-22 20:01:35 +02:00
|
|
|
|
|
|
|
;; receive an error
|
2011-09-18 13:39:36 +02:00
|
|
|
((plist-get sexp :error)
|
|
|
|
(funcall mm/proc-error-func sexp))
|
|
|
|
(t (message "Unexpected data from server [%S]" sexp)))
|
|
|
|
(setq sexp (mm/proc-eat-sexp-from-buf)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun mm/proc-sentinel (proc msg)
|
|
|
|
"Function that will be called when the mu-server process
|
|
|
|
terminates."
|
|
|
|
(let ((status (process-status proc)) (code (process-exit-status proc)))
|
|
|
|
(setq mm/mu-proc nil)
|
|
|
|
(setq mm/buf "") ;; clear any half-received sexps
|
|
|
|
(cond
|
|
|
|
((eq status 'signal)
|
|
|
|
(cond
|
2011-09-30 07:37:47 +02:00
|
|
|
((eq code 9) (message nil))
|
|
|
|
;;(message "the mu server process has been stopped"))
|
2011-09-18 13:39:36 +02:00
|
|
|
(t (message (format "mu server process received signal %d" code)))))
|
|
|
|
((eq status 'exit)
|
|
|
|
(cond
|
2011-11-05 09:26:24 +01:00
|
|
|
((eq code 0)
|
2011-12-07 07:50:03 +01:00
|
|
|
(message nil)) ;; don't do anything
|
2011-09-20 22:59:20 +02:00
|
|
|
((eq code 11)
|
|
|
|
(message "Database is locked by another process"))
|
|
|
|
((eq code 19)
|
|
|
|
(message "Database is empty; try indexing some messages"))
|
2011-09-18 13:39:36 +02:00
|
|
|
(t (message (format "mu server process ended with exit code %d" code)))))
|
|
|
|
(t
|
|
|
|
(message "something bad happened to the mu server process")))))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defconst mm/proc-log-buffer-name "*mm-log*"
|
|
|
|
"*internal* Name of the logging buffer.")
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defun mm/proc-log (frm &rest args)
|
|
|
|
"Write something in the *mm-log* buffer - mainly useful for debugging."
|
2011-09-18 22:57:46 +02:00
|
|
|
(when mm/debug
|
|
|
|
(with-current-buffer (get-buffer-create mm/proc-log-buffer-name)
|
|
|
|
(goto-char (point-max))
|
|
|
|
(insert (apply 'format (concat (format-time-string "%Y-%m-%d %T "
|
|
|
|
(current-time)) frm "\n") args)))))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defun mm/proc-send-command (frm &rest args)
|
|
|
|
"Send as command to the mu server process; start the process if needed."
|
|
|
|
(unless (mm/proc-is-running)
|
|
|
|
(mm/start-proc))
|
|
|
|
(let ((cmd (apply 'format frm args)))
|
2011-09-20 22:59:20 +02:00
|
|
|
(mm/proc-log (concat "-> " cmd))
|
2011-10-18 11:39:49 +02:00
|
|
|
(process-send-string mm/mu-proc (concat cmd "\n"))))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
(defun mm/proc-remove-msg (docid)
|
|
|
|
"Remove message identified by DOCID. The results are reporter
|
|
|
|
through either (:update ... ) or (:error ) sexp, which are handled
|
|
|
|
my `mm/proc-update-func' and `mm/proc-error-func', respectively."
|
2011-09-18 13:39:36 +02:00
|
|
|
(mm/proc-send-command "remove %d" docid))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
|
2011-12-07 07:50:03 +01:00
|
|
|
(defun mm/proc-find (expr &optional maxnum)
|
|
|
|
"Start a database query for EXPR, getting up to MAXNUM
|
|
|
|
results (or -1 for unlimited). For each result found, a function is
|
|
|
|
called, depending on the kind of result. The variables
|
2011-09-12 19:52:32 +02:00
|
|
|
`mm/proc-header-func' and `mm/proc-error-func' contain the function
|
|
|
|
that will be called for, resp., a message (header row) or an
|
|
|
|
error."
|
2011-12-07 07:50:03 +01:00
|
|
|
(mm/proc-send-command "find \"%s\" %d"
|
|
|
|
expr (if maxnum maxnum -1)))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defun mm/proc-move-msg (docid targetmdir &optional flags)
|
|
|
|
"Move message identified by DOCID to TARGETMDIR, optionally
|
|
|
|
setting FLAGS in the process.
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
TARGETDIR must be a maildir, that is, the part _without_ cur/ or
|
2011-09-18 13:39:36 +02:00
|
|
|
new/ or the root-maildir-prefix. E.g. \"/archive\". This directory
|
|
|
|
must already exist.
|
2011-09-12 19:52:32 +02:00
|
|
|
|
|
|
|
The FLAGS parameter can have the following forms:
|
|
|
|
1. a list of flags such as '(passed replied seen)
|
|
|
|
2. a string containing the one-char versions of the flags, e.g. \"PRS\"
|
|
|
|
3. a delta-string specifying the changes with +/- and the one-char flags,
|
|
|
|
e.g. \"+S-N\" to set Seen and remove New.
|
|
|
|
|
|
|
|
The flags are any of `deleted', `flagged', `new', `passed', `replied' `seen' or
|
|
|
|
`trashed', or the corresponding \"DFNPRST\" as defined in [1]. See
|
|
|
|
`mm/string-to-flags' and `mm/flags-to-string'.
|
|
|
|
The server reports the results for the operation through
|
|
|
|
`mm/proc-update-func'.
|
|
|
|
The results are reported through either (:update ... )
|
|
|
|
or (:error ) sexp, which are handled my `mm/proc-update-func' and
|
|
|
|
`mm/proc-error-func', respectively."
|
|
|
|
(let
|
2011-09-18 13:39:36 +02:00
|
|
|
((flagstr (if (stringp flags) flags (mm/flags-to-string flags)))
|
|
|
|
(fullpath (concat mm/maildir targetmdir)))
|
|
|
|
(unless (and (file-directory-p fullpath) (file-writable-p fullpath))
|
|
|
|
(error "Not a writable directory: %s" fullpath))
|
2011-09-19 23:20:59 +02:00
|
|
|
;; note, we send the maildir, *not* the full path
|
2011-12-07 07:50:03 +01:00
|
|
|
(mm/proc-send-command "move %d \"%s\" %s" docid
|
|
|
|
targetmdir flagstr)))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
(defun mm/proc-flag (docid-or-msgid flags)
|
|
|
|
"Set FLAGS for the message identified by either DOCID-OR-MSGID."
|
2011-09-12 19:52:32 +02:00
|
|
|
(let ((flagstr (if (stringp flags) flags (mm/flags-to-string flags))))
|
2011-10-02 20:35:03 +02:00
|
|
|
(mm/proc-send-command "flag %S %s" docid-or-msgid flagstr)))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-09-18 13:39:36 +02:00
|
|
|
(defun mm/proc-index (maildir)
|
2011-09-18 22:57:46 +02:00
|
|
|
"Update the message database for MAILDIR."
|
|
|
|
(mm/proc-send-command "index \"%s\"" maildir))
|
|
|
|
|
2011-09-19 23:20:59 +02:00
|
|
|
(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))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-12-13 06:44:45 +01:00
|
|
|
(defun mm/proc-ping ()
|
|
|
|
"Sends a ping to the mu server, expecting a (:pong ...) in
|
|
|
|
response."
|
|
|
|
(mm/proc-send-command "ping"))
|
|
|
|
|
2011-09-12 19:52:32 +02:00
|
|
|
(defun mm/proc-view-msg (docid)
|
|
|
|
"Get one particular message based on its DOCID. The result will
|
|
|
|
be delivered to the function registered as `mm/proc-message-func'."
|
2011-09-18 13:39:36 +02:00
|
|
|
(mm/proc-send-command "view %d" docid))
|
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
(defun mm/proc-compose (compose-type docid)
|
2011-09-30 07:37:47 +02:00
|
|
|
"Start composing a message with DOCID and COMPOSE-TYPE (a symbol,
|
2011-10-02 20:35:03 +02:00
|
|
|
either `forward', `reply' or `edit'.
|
2011-09-18 13:39:36 +02:00
|
|
|
The result will be delivered to the function registered as
|
|
|
|
`mm/proc-compose-func'."
|
2011-10-02 20:35:03 +02:00
|
|
|
(unless (member compose-type '(forward reply edit))
|
2011-09-30 07:37:47 +02:00
|
|
|
(error "Unsupported compose-type"))
|
|
|
|
(mm/proc-send-command "compose %s %d" (symbol-name compose-type) docid))
|
2011-09-12 19:52:32 +02:00
|
|
|
|
2011-10-02 20:35:03 +02:00
|
|
|
(defconst mm/update-buffer-name "*update*"
|
|
|
|
"*internal* Name of the buffer to download mail")
|
|
|
|
|
2011-09-22 20:01:35 +02:00
|
|
|
(defun mm/proc-retrieve-mail-update-db ()
|
|
|
|
"Try to retrieve mail (using the user-provided shell command),
|
|
|
|
and update the database afterwards."
|
2011-10-02 20:35:03 +02:00
|
|
|
(unless mm/get-mail-command
|
|
|
|
(error "`mm/get-mail-command' is not defined"))
|
|
|
|
(let ((buf (get-buffer-create mm/update-buffer-name)))
|
|
|
|
(split-window-vertically -8)
|
|
|
|
(switch-to-buffer-other-window buf)
|
|
|
|
(with-current-buffer buf
|
|
|
|
(erase-buffer))
|
|
|
|
(message "Retrieving mail...")
|
|
|
|
(call-process mm/get-mail-command nil buf t)
|
|
|
|
(message "Updating the database...")
|
|
|
|
(mm/proc-index mm/maildir)
|
|
|
|
(with-current-buffer buf
|
|
|
|
(kill-buffer-and-window))))
|
2011-09-22 20:01:35 +02:00
|
|
|
|
|
|
|
|
2011-09-12 19:52:32 +02:00
|
|
|
(provide 'mm-proc)
|