From bf66680595af400a7b5298f513e960a0f293a1c7 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Thu, 11 Aug 2011 20:21:41 +0300 Subject: [PATCH] * mua: add mua-mu.el --- toys/mua/mua-mu.el | 234 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 234 insertions(+) create mode 100644 toys/mua/mua-mu.el diff --git a/toys/mua/mua-mu.el b/toys/mua/mua-mu.el new file mode 100644 index 00000000..c971ff61 --- /dev/null +++ b/toys/mua/mua-mu.el @@ -0,0 +1,234 @@ +;;; mua-mu.el -- part of mua, the mu mail user agent +;; +;; Copyright (C) 2011 Dirk-Jan C. Binnema + +;; Author: Dirk-Jan C. Binnema +;; Maintainer: Dirk-Jan C. Binnema +;; 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 . + +;;; Commentary: + +;; mua-mu contains common functions that interact with the mu program + +;;; Code: +(eval-when-compile (require 'cl)) + + +(defun mua/mu-run (&rest args) + "Run 'mu' synchronously with ARGS as command-line argument;, +where is the exit code of the program, or 1 if the +process was killed. contains whatever the command wrote on +standard output/error, or nil if there was none or in case of +error. Basically, `mua/mu-run' is like `shell-command-to-string', +but with better possibilities for error handling. The --muhome= +parameter is added automatically if `mua/mu-home' is non-nil." + (let* ((rv) + (args (append args (when mua/mu-home + (list (concat "--muhome=" mua/mu-home))))) + (cmdstr (concat mua/mu-binary " " (mapconcat 'identity args " "))) + (str (with-output-to-string + (with-current-buffer standard-output ;; but we also get stderr... + (setq rv (apply 'call-process mua/mu-binary nil t nil + args)))))) + (when (and (numberp rv) (/= 0 rv)) + (mua/log "mua error: %s" (mua/mu-error rv))) + (mua/log "%s => %S" cmdstr rv) + `(,(if (numberp rv) rv 1) . ,str))) + +(defun mua/mu-binary-version () + "Get the version string of the mu binary, or nil if we failed +to get it" + (let ((rv (mua/mu-run "--version"))) + (if (and (= (car rv) 0) (string-match "version \\(.*\\)$" (cdr rv))) + (match-string 1 (cdr rv)) + (mua/warn "Failed to get version string")))) + +(defun mua/mu-mv (src target &optional flags) + "Move a message at PATH to TARGET using 'mu mv'. SRC must be +the full, absolute path to a message file, while TARGET must +be a maildir - that is, the part _without_ cur/ or new/. 'mu mv' +will calculate the target directory and the exact file name. + +Optionally, you can specify the FLAGS for the new file; this must +be a list consisting of one or more of DFNPRST, mean +resp. Deleted, Flagged, New, Passed Replied, Seen and Trash, as +defined in [1]. See `mua/maildir-string-to-flags' and +`mua/maildir-flags-to-string'. + +Function returns the target filename if the move succeeds, or +/dev/null if TARGETDIR was /dev/null; in other cases, it returns +`nil'. + +\[1\] http://cr.yp.to/proto/maildir.html." + (let ((flagstr + (and flags (mua/maildir-flags-to-string flags)))) + (if (not (file-readable-p src)) + (mua/warn "Cannot move unreadable file %s" src) + (let* ((rv (if flagstr + (mua/mu-run "mv" "--printtarget" + (concat "--flags=" flagstr) src target) + (mua/mu-run "mv" "--printtarget" src target))) + (code (car rv)) (output (cdr rv))) + (if (/= 0 code) + (mua/warn "Moving message file failed: %s" (if output output "error")) + (substring output 0 -1)))))) ;; the full target path, minus the \n + +(defun mua/mu-view-sexp (path) + "Return a string with an s-expression representing the message +at PATH; the format is described in `mua/msg-from-string', and +that function converts the string into a Lisp object (plist)" + (if (not (file-readable-p path)) + (mua/warn "Cannot view unreadable file %s" path) + (let* ((rv (mua/mu-run "view" "--format=sexp" path)) + (code (car rv)) (str (cdr rv))) + (if (= code 0) + str + (mua/warn "mu view failed (%d): %s" + code (if str str "error")))))) + + +(defvar mua/db-update-proc nil "*internal* process for db updates") +(defvar mua/db-update-name "*mua-db-update*" + "*internal* name of the db-update process") +(defvar mua/db-add-paths nil "list of paths to add to database") +(defvar mua/db-remove-paths nil "list of paths to remove from database") + +(defun mua/db-update-proc-sentinel (proc msg) + "Check the process upon completion" + (let ((procbuf (process-buffer proc)) + (status (process-status proc)) + (exit-status (process-exit-status proc))) + (when (and (buffer-live-p procbuf) (memq status '(exit signal))) + (case status + ('signal (mua/warn "Process killed")) + ('exit + (case exit-status + (mua/warn "Result: %s" (mua/mu-log exit-status)))))) + (mua/mu-db-update-execute))) + +(defun mua/mu-db-update-execute () + "Update the database; remove paths in `mua/db-remove-paths', +and add paths in `mua/db-add-paths'. Updating is ansynchronous." + + ;; when it's already running, do nothing + (unless (and mua/db-update-proc (eq (process-status mua/db-update-proc) 'run)) + (when mua/db-remove-paths + (let ((remove-paths (copy-list mua/db-remove-paths))) + (mua/log (concat mua/mu-binary " remove " + (mapconcat 'identity remove-paths " "))) + (setq mua/db-remove-paths nil) ;; clear the old list + (setq mua/db-update-proc + (apply 'start-process mua/db-update-name mua/db-update-name mua/mu-binary + "remove" remove-paths)) + (set-process-sentinel mua/db-update-proc 'mua/db-update-proc-sentinel)))) + + ;; when it's already running, do nothing + (unless (and mua/db-update-proc + (eq (process-status mua/db-update-proc) 'run)) + (when mua/db-add-paths + (let ((add-paths (copy-list mua/db-add-paths))) + (mua/log (concat mua/mu-binary " add " (mapconcat 'identity add-paths " "))) + (setq mua/db-add-paths nil) ;; clear the old list + (setq mua/db-update-proc + (apply 'start-process mua/db-update-name mua/db-update-name mua/mu-binary + "add" add-paths)) + (set-process-sentinel mua/db-update-proc 'mua/db-update-proc-sentinel))))) + + +(defun mua/mu-add-async (path-or-paths) + "Asynchronously add msg at PATH-OR-PATHS to +database. PATH-OR-PATHS is either a single path or a list of +them." + (setq mua/db-add-paths + (append mua/db-add-paths + (if (listp path-or-paths) path-or-paths `(,path-or-paths)))) + (mua/mu-db-update-execute)) + +(defun mua/mu-remove-async (path-or-paths) + "Asynchronously remove msg at PATH-OR-PATHS from +database. PATH-OR-PATHS is either a single path or a list of +them." + (setq mua/db-remove-paths + (append mua/db-remove-paths + (if (listp path-or-paths) path-or-paths `(,path-or-paths)))) + (mua/mu-db-update-execute)) + + + +;; generated with: +;; cat mu-util.h | sed 's/\([A-Z_]\+\).*=\(.*\),/(defconst \L\1 \2)/' < "$<" \ +;; | sed 's/_/-/g' > mu-errors.el +(defconst mu-error 1) +(defconst mu-error-in-parameters 2) +(defconst mu-error-internal 3) +(defconst mu-error-no-matches 4) +(defconst mu-error-xapian 11) +(defconst mu-error-xapian-query 13) +(defconst mu-error-xapian-dir-not-accessible 14) +(defconst mu-error-xapian-not-up-to-date 15) +(defconst mu-error-xapian-missing-data 16) +(defconst mu-error-xapian-corruption 17) +(defconst mu-error-xapian-cannot-get-writelock 18) +(defconst mu-error-gmime 30) +(defconst mu-error-contacts 50) +(defconst mu-error-contacts-cannot-retrieve 51) +(defconst mu-error-file 70) +(defconst mu-error-file-invalid-name 71) +(defconst mu-error-file-cannot-link 72) +(defconst mu-error-file-cannot-open 73) +(defconst mu-error-file-cannot-read 74) +(defconst mu-error-file-cannot-create 75) +(defconst mu-error-file-cannot-mkdir 76) +(defconst mu-error-file-stat-failed 77) +(defconst mu-error-file-readdir-failed 78) +(defconst mu-error-file-invalid-source 79) + + +(defun mua/mu-error (err) + "Convert an exit code from mu into a string." + (case err + (mu-error "General error") + (mu-error-in-parameters "Error in parameters") + (mu-error-internal "Internal error") + (mu-error-no-matches "No matches") + (mu-error-xapian "Xapian error") + (mu-error-xapian-query "Error in query") + (mu-error-xapian-dir-not-accessible "Database dir is not accessible") + (mu-error-xapian-not-up-to-date "Database is not up-to-date") + (mu-error-xapian-missing-data "Missing data") + (mu-error-xapian-corruption "Database seems to be corrupted") + (mu-error-xapian-cannot-get-writelock "Database is locked") + (mu-error-gmime "GMime-related error") + (mu-error-contacts "Contacts-related error") + (mu-error-contacts-cannot-retrieve "Failed to retrieve contacts-cache") + (mu-error-file "File error") + (mu-error-file-invalid-name "Invalid file name") + (mu-error-file-cannot-link "Failed to link file") + (mu-error-file-cannot-open "Cannot open file") + (mu-error-file-cannot-read "Cannot read file") + (mu-error-file-cannot-create "Cannot create file") + (mu-error-file-cannot-mkdir "mu-mkdir failed") + (mu-error-file-stat-failed "stat(2) failed") + (mu-error-file-readdir-failed "readdir failed") + (mu-error-file-invalid-source "Invalid source file") + (t "Unknown error"))) + + +(provide 'mua-mu) +