* mm + mm-cmd-server: implement 'ping' -> startup version check

This commit is contained in:
djcb
2011-12-13 07:44:45 +02:00
parent 5f1eebcad5
commit 37c884aa2e
4 changed files with 56 additions and 43 deletions

View File

@ -178,7 +178,7 @@ enum _Cmd {
CMD_QUIT, CMD_QUIT,
CMD_REMOVE, CMD_REMOVE,
CMD_SAVE, CMD_SAVE,
CMD_INFO, CMD_PING,
CMD_VIEW, CMD_VIEW,
CMD_IGNORE CMD_IGNORE
@ -205,7 +205,7 @@ cmd_from_string (const char *str)
{ CMD_QUIT, "quit"}, { CMD_QUIT, "quit"},
{ CMD_REMOVE, "remove" }, { CMD_REMOVE, "remove" },
{ CMD_SAVE, "save"}, { CMD_SAVE, "save"},
{ CMD_INFO, "info"}, { CMD_PING, "ping"},
{ CMD_VIEW, "view"} { CMD_VIEW, "view"}
}; };
@ -292,18 +292,20 @@ check_param_num (GSList *lst, unsigned min, unsigned max)
} }
/* -> ping
* <- (:pong mu :version <version> :doccount <doccount>)
*/
static MuError static MuError
cmd_info (MuStore *store, GSList *lst, GError **err) cmd_ping (MuStore *store, GSList *lst, GError **err)
{ {
if (!check_param_num (lst, 0, 0)) if (!check_param_num (lst, 0, 0))
return server_error (NULL, MU_ERROR_IN_PARAMETERS, return server_error (NULL, MU_ERROR_IN_PARAMETERS,
"usage: version"); "usage: version");
send_expr ("(:info version " send_expr ("(:pong \"" PACKAGE_NAME "\" "
":version \"" VERSION "\" " ":version \"" VERSION "\" "
":doccount %u " ":doccount %u"
")", ")\n",
mu_store_count (store, err)); mu_store_count (store, err));
return MU_OK; return MU_OK;
@ -897,7 +899,7 @@ handle_command (Cmd cmd, MuStore *store, MuQuery *query, GSList *args,
case CMD_QUIT: rv = cmd_quit (args, err); break; case CMD_QUIT: rv = cmd_quit (args, err); break;
case CMD_REMOVE: rv = cmd_remove (store, args, err); break; case CMD_REMOVE: rv = cmd_remove (store, args, err); break;
case CMD_SAVE: rv = cmd_save (store, args, err); break; case CMD_SAVE: rv = cmd_save (store, args, err); break;
case CMD_INFO: rv = cmd_info (store, args, err); break; case CMD_PING: rv = cmd_ping (store, args, err); break;
case CMD_VIEW: rv = cmd_view (store, args, err); break; case CMD_VIEW: rv = cmd_view (store, args, err); break;
case CMD_IGNORE: return TRUE; case CMD_IGNORE: return TRUE;

View File

@ -8,7 +8,6 @@
** Features i ** Features i
*** version check at startup
*** documentation *** documentation
*** emacs install *** emacs install
@ -60,7 +59,7 @@
** raw-mode / quit ** raw-mode / quit
** customizable bookmarks ** customizable bookmarks
** fix queued sending ** fix queued sending
** version check at startup
# Local Variables: # Local Variables:
# mode: org; org-startup-folded: nil # mode: org; org-startup-folded: nil

View File

@ -33,49 +33,51 @@
(defvar mm/mu-proc nil (defvar mm/mu-proc nil
"*internal* The mu-server process") "*internal* The mu-server process")
(defvar mm/proc-error-func nil (defvar mm/proc-error-func 'mm/default-handler
"*internal* A function called for each error returned from the "*internal* A function called for each error returned from the
server process; the function is passed an error plist as server process; the function is passed an error plist as
argument. See `mm/proc-filter' for the format.") argument. See `mm/proc-filter' for the format.")
(defvar mm/proc-update-func nil (defvar mm/proc-update-func 'mm/default-handler
"*internal* A function called for each :update sexp returned from "*internal* A function called for each :update sexp returned from
the server process; the function is passed a msg sexp as the server process; the function is passed a msg sexp as
argument. See `mm/proc-filter' for the format.") argument. See `mm/proc-filter' for the format.")
(defvar mm/proc-remove-func nil (defvar mm/proc-remove-func 'mm/default-handler
"*internal* A function called for each :remove sexp returned from "*internal* A function called for each :remove sexp returned from
the server process, when some message has been deleted. The the server process, when some message has been deleted. The
function is passed the docid of the removed message.") function is passed the docid of the removed message.")
(defvar mm/proc-view-func nil (defvar mm/proc-view-func 'mm/default-handler
"*internal* A function called for each single message sexp "*internal* A function called for each single message sexp
returned from the server process. The function is passed a message returned from the server process. The function is passed a message
sexp as argument. See `mm/proc-filter' for the sexp as argument. See `mm/proc-filter' for the
format.") format.")
(defvar mm/proc-header-func nil (defvar mm/proc-header-func 'mm/default-handler
"*internal* A function called for each message returned from the "*internal* A function called for each message returned from the
server process; the function is passed a msg plist as argument. See server process; the function is passed a msg plist as argument. See
`mm/proc-filter' for the format.") `mm/proc-filter' for the format.")
(defvar mm/proc-found-func nil (defvar mm/proc-found-func 'mm/default-handler
"*internal* A function called for when we received a :found sexp "*internal* A function called for when we received a :found sexp
after the headers have returns, to report on the number of after the headers have returns, to report on the number of
matches. See `mm/proc-filter' for the format.") matches. See `mm/proc-filter' for the format.")
(defvar mm/proc-compose-func 'mm/default-handler
(defvar mm/proc-compose-func nil
"*internal* A function called for each message returned from the "*internal* A function called for each message returned from the
server process that is used as basis for composing a new server process that is used as basis for composing a new
message (ie., either a reply or a forward); the function is passed message (ie., either a reply or a forward); the function is passed
msg and a symbol (either reply or forward). See `mm/proc-filter' msg and a symbol (either reply or forward). See `mm/proc-filter'
for the format of <msg-plist>.") for the format of <msg-plist>.")
(defvar mm/proc-info-func nil (defvar mm/proc-info-func 'mm/default-handler
"*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/proc-pong-func 'mm/default-handler
"*internal* A function called for each (:pong type ....) sexp
received from the server process.")
(defvar mm/buf nil (defvar mm/buf nil
"*internal* Buffer for results data.") "*internal* Buffer for results data.")
@ -112,10 +114,13 @@ process."
((plist-get info :message) (message "%s" (plist-get info :message)))))) ((plist-get info :message) (message "%s" (plist-get info :message))))))
(defun mm/default-handler (&rest args)
"Dummy handler function."
(error "Not handled: %S" args))
(defconst mm/server-name "*mm-server" (defconst mm/server-name "*mm-server"
"*internal* Name of the server process, buffer.") "*internal* Name of the server process, buffer.")
(defun mm/start-proc () (defun mm/start-proc ()
"Start the mu server process." "Start the mu server process."
;; TODO: add version check ;; TODO: add version check
@ -247,7 +252,7 @@ updated as well, with all processed sexp data removed."
((plist-get sexp :date) ((plist-get sexp :date)
(funcall mm/proc-header-func sexp)) (funcall mm/proc-header-func sexp))
;; the found sexp, we receive after gett all the headers ;; the found sexp, we receive after getting all the headers
((plist-get sexp :found) ((plist-get sexp :found)
(funcall mm/proc-found-func (plist-get sexp :found))) (funcall mm/proc-found-func (plist-get sexp :found)))
@ -255,6 +260,11 @@ updated as well, with all processed sexp data removed."
((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)))
;; receive a pong message
((plist-get sexp :pong)
(funcall mm/proc-pong-func
(plist-get sexp :version) (plist-get sexp :doccount)))
;; something got moved/flags changed ;; something got moved/flags changed
((plist-get sexp :update) ((plist-get sexp :update)
(funcall mm/proc-update-func (funcall mm/proc-update-func
@ -397,6 +407,11 @@ set to e.g. '/drafts'; if this works, we will receive (:info :path
"Open attachment PARTIDX from message with DOCID." "Open attachment PARTIDX from message with DOCID."
(mm/proc-send-command "open %d %d" docid partidx)) (mm/proc-send-command "open %d %d" docid partidx))
(defun mm/proc-ping ()
"Sends a ping to the mu server, expecting a (:pong ...) in
response."
(mm/proc-send-command "ping"))
(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
be delivered to the function registered as `mm/proc-message-func'." be delivered to the function registered as `mm/proc-message-func'."

View File

@ -34,14 +34,16 @@
(require 'mm-send) (require 'mm-send)
(require 'mm-proc) (require 'mm-proc)
(require 'mm-version) ;; auto-generated
;; mm-version.el is autogenerated, and defines mm/mu-version ;; mm-version.el is autogenerated, and defines mm/mu-version
(require 'mm-version) (require 'mm-version)
;; Customization ;; Customization
(defgroup mm nil (defgroup mm nil
"Mm." :group 'local) "mm - the mu mail client"
:group 'local)
(defcustom mm/mu-home nil (defcustom mm/mu-home nil
"Location of the mu homedir, or nil for the default." "Location of the mu homedir, or nil for the default."
@ -309,8 +311,6 @@ headers)."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; internal variables / constants ;; internal variables / constants
(defconst mm/mm-buffer-name "*mm*"
"*internal* Name of the mm main buffer.")
(defconst mm/header-names (defconst mm/header-names
'( (:attachments . "Attach") '( (:attachments . "Attach")
@ -330,25 +330,22 @@ view). Most fields should be self-explanatory. A special one is
`:from-or-to', which is equal to `:from' unless `:from' matches , `:from-or-to', which is equal to `:from' unless `:from' matches ,
in which case it will be equal to `:to'.)") in which case it will be equal to `:to'.)")
;; General helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mm startup function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mm ()
;; TODO: make this recursive "Start mm. We do this by sending a 'ping' to the mu server
(defun mm/get-sub-maildirs (maildir) process, and start the main view if the 'pong' we receive from the
"Get all readable sub-maildirs under MAILDIR." server has the expected values."
(let ((maildirs (remove-if (interactive)
(lambda (dentry) (if (buffer-live-p mm/main-buffer-name)
(let ((path (concat maildir "/" dentry))) (switch-to-buffer mm/main-buffer-name)
(or (setq mm/proc-pong-func
(string= dentry ".") (lambda (version doccount)
(string= dentry "..") (unless (string= version mm/mu-version)
(not (file-directory-p path)) (error "mu server has version %s, but we need %s"
(not (file-readable-p path)) version mm/mu-version))
(file-exists-p (concat path "/.noindex"))))) (mm/main-view)))
(directory-files maildir)))) (mm/proc-ping)))
(map 'list (lambda (dir) (concat "/" dir)) maildirs)))
(defun mm/ask-maildir (prompt) (defun mm/ask-maildir (prompt)
"Ask the user for a shortcut (using PROMPT) as defined in "Ask the user for a shortcut (using PROMPT) as defined in