From 18f0ec74371541cbd397e527a4483c0012079a2e Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Thu, 11 Aug 2011 20:20:40 +0300 Subject: [PATCH] * mua updates --- toys/mua/Makefile | 11 ++++ toys/mua/mua-common.el | 99 ++--------------------------------- toys/mua/mua-hdrs.el | 50 ++++++++---------- toys/mua/mua-msg.el | 60 ++++++++++++++------- toys/mua/mua-view.el | 12 +++-- toys/mua/mua.el | 59 ++++++++++++++++++++- toys/mug/mug-msg-list-view.c | 6 +-- toys/mug2/mug-msg-list-view.c | 6 +-- toys/mug2/mug.c | 2 +- 9 files changed, 150 insertions(+), 155 deletions(-) diff --git a/toys/mua/Makefile b/toys/mua/Makefile index 87b865e1..d03fcd2e 100644 --- a/toys/mua/Makefile +++ b/toys/mua/Makefile @@ -5,6 +5,9 @@ ELCS=$(ELS:.el=.elc) .PHONY=install +top_srcdir=/home/djcb/src/mu/ + + BATCH=$(EMACS) -batch -q -no-site-file -eval \ "(setq load-path (cons (expand-file-name \".\") load-path))" @@ -13,6 +16,14 @@ BATCH=$(EMACS) -batch -q -no-site-file -eval \ all: $(ELCS) +BUILT_SOURCES=mu-errors.el + +mu-errors.el: ${top_srcdir}/src/mu-util.h + @cat ${top_srcdir}/src/mu-util.h \ + + + + docs: mua.info install_lisp: diff --git a/toys/mua/mua-common.el b/toys/mua/mua-common.el index ad827add..50ac474c 100644 --- a/toys/mua/mua-common.el +++ b/toys/mua/mua-common.el @@ -77,68 +77,10 @@ non-nill, return the fulpath (ie, mu-maildir prepended to the maildir." (interactive) (let* ((showfolders - (delete-dups - (append (list mua/inbox-folder mua/sent-folder) - mua/working-folders))) + (append (list mua/inbox-folder mua/drafts-folder mua/sent-folder) + mua/working-folders)) (chosen (ido-completing-read prompt showfolders))) (concat (if fullpath mua/maildir "") chosen))) - -(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)))))) - (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/maildir-flags-from-path (path) "Get the flags for the message at PATH, which does not have to exist. @@ -151,41 +93,6 @@ and `mua/maildir-flags-to-string'. (mua/maildir-string-to-flags (match-string 1 path)))) -;; TODO: make this async, but somehow serialize database access -(defun mua/mu-add (path) - "Add message file at PATH to the mu database (using the 'mu -add') command. Return t if it succeed or nil in case of error." - (if (not (file-readable-p path)) - (mua/warn "Cannot add unreadable file: %s" path) - (let* ((rv (mua/mu-run "add" path)) - (code (car rv)) (output (cdr rv))) - (if (/= code 0) - (mua/warn "mu add failed (%d): %s" code (if output output "error") - t))))) - -;; TODO: make this async, but somehow serialize database access -(defun mua/mu-remove (path) - "Remove message with PATH from the mu database (using the 'mu -remove') command. PATH does not have to exist. Return t if it -succeed or nil in case of error." - (let* ((rv (mua/mu-run "remove" path)) - (code (car rv)) (output (cdr rv))) - (if (/= code 0) - (mua/warn "mu remove failed (%d): %s" code (if output output "error") - t)))) - -(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")))))) (defun mua/maildir-from-path (path &optional dont-strip-prefix) "Get the maildir from path; in this context, 'maildir' is the @@ -249,5 +156,5 @@ Also see `mua/maildir-flags-to-string'. (?T 'trashed)))) (append (when flag (list flag)) (mua/maildir-string-to-flags (substring str 1)))))) - + (provide 'mua-common) diff --git a/toys/mua/mua-hdrs.el b/toys/mua/mua-hdrs.el index 27860c38..acb76431 100644 --- a/toys/mua/mua-hdrs.el +++ b/toys/mua/mua-hdrs.el @@ -71,7 +71,6 @@ the mu find output") (save-match-data (mua/hdrs-append-message msg)) (setq mua/buf (substring mua/buf (match-end 0))) (setq eom (string-match mua/eom mua/buf)))))))))) - (defun mua/hdrs-proc-sentinel (proc msg) "Check the process upon completion" @@ -83,20 +82,14 @@ the mu find output") (case status ('signal "Search process killed (results incomplete)") ('exit - (case exit-status - (0 "End of search results") - (1 "mu find error") - (2 "No matches found") - (4 "Database problem; try running 'mu index'") - (t (format "Some error occured; mu find returned %d" - exit-status))))))) - (with-current-buffer procbuf - (save-excursion - (goto-char (point-max)) - (mua/message msg))) - - (unless (= exit-status 0) - (mua/log "mu find exit with %d" exit-status)))))) + (if (= 0 exit-status) + "End of search results" + (mua/mu-error exit-status)))))) + + (with-current-buffer procbuf + (save-excursion + (goto-char (point-max)) + (mua/message msg))))))) (defun mua/hdrs-search-execute (expr buf) "search in the mu database; output the results in buffer BUF" @@ -107,8 +100,8 @@ the mu find output") (add-to-list args (concat "--sortfield=" mua/hdrs-sortfield))) (when mua/hdrs-sort-descending (add-to-list args "--descending")) - (mua/log "Searching for %s with %S" expr args) - + (mua/log (concat mua/mu-binary " find " expr + (mapconcat 'identity args " "))) ;; now, do it! (let ((proc (apply 'start-process "*mua-headers*" buf mua/mu-binary args))) (setq @@ -138,7 +131,6 @@ the mu find output") mua/last-expression expr mua/hdrs-hash (make-hash-table :size 256 :rehash-size 2) mua/hdrs-marks-hash (make-hash-table :size 16 :rehash-size 2)) - (mua/log "searching for %S" expr) (mua/hdrs-search-execute expr buf))) @@ -155,7 +147,7 @@ the mu find output") (make-local-variable 'mua/hdrs-marks-hash) (setq - major-mode 'mu-headers-mode mode-name "*headers*" + major-mode 'mua/mua-hdrs-mode mode-name "*mua-headers*" truncate-lines t buffer-read-only t overwrite-mode 'overwrite-mode-binary)) @@ -295,7 +287,6 @@ fitting in WIDTH" (define-key map "r" 'mua/hdrs-reply) (define-key map "f" 'mua/hdrs-forward) (define-key map "c" 'mua/hdrs-compose) - (define-key map (kbd "RET") 'mua/hdrs-view) map) @@ -436,10 +427,16 @@ pseudo-markings." (save-excursion (maphash (lambda(bol v) - (let ((src (car v)) (target (cdr v)) (inhibit-read-only t)) - (when (mua/msg-move src target) + (let* ((src (car v)) (target (cdr v)) (inhibit-read-only t) + (newpath (mua/msg-move src target))) + (when newpath + ;; remember the updated path -- for now not too useful + ;; as we're hiding the header, but... + (mua/hdrs-set-path newpath) (goto-char bol) (mua/hdrs-remove-marked) + (mua/warn "[%d %d]" (line-beginning-position 1) + (line-beginning-position 2)) (put-text-property (line-beginning-position 1) (line-beginning-position 2) 'invisible t)))) ;; when it succeedes, hide msg..) @@ -455,8 +452,7 @@ pseudo-markings." (str (when path (mua/mu-view-sexp path))) (msg (and str (mua/msg-from-string str)))) (if msg - (mua/msg-compose (mua/msg-create-reply msg - (yes-or-no-p "Reply to all? "))) + (mua/msg-reply msg) (mua/warn "No message at point")))) (defun mua/hdrs-forward () @@ -465,13 +461,13 @@ pseudo-markings." (let* ((path (mua/hdrs-get-path)) (msg (when path (mua/msg-from-path path)))) (if msg - (mua/msg-compose (mua/msg-create-forward msg)) + (mua/msg-forward msg) (mua/warn "No message at point")))) (defun mua/hdrs-compose () - "Create a new messge." + "Create a new message." (interactive) - (mua/msg-compose (mua/msg-create-new))) + (mua/msg-compose-new)) (provide 'mua-hdrs) diff --git a/toys/mua/mua-msg.el b/toys/mua/mua-msg.el index 8e910ff0..93a30b5f 100644 --- a/toys/mua/mua-msg.el +++ b/toys/mua/mua-msg.el @@ -106,7 +106,7 @@ 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 +resp. Deleted, Flagged, New, Passed Replied, Seen and g, as defined in [1]. See `mua/maildir-string-to-flags' and `mua/maildir-flags-to-string'. @@ -120,13 +120,11 @@ Function returns the target filename if the move succeeds, or \[1\] http://cr.yp.to/proto/maildir.html." (let ((fulltarget (mua/mu-mv src targetdir flags))) - (if fulltarget - (progn - (mua/mu-remove src) - (unless (string= targetdir "/dev/null") - (mua/mu-add fulltarget)) - fulltarget) - (mua/warn "Moving message %s=>%s %S failed" src targetdir flags)))) + (when fulltarget + (mua/mu-remove-async src) + (unless (string= targetdir "/dev/null") + (mua/mu-add-async fulltarget))) + fulltarget)) ;; functions for composing new messages (forward, reply and new) @@ -192,15 +190,13 @@ B , c@example.com\." (defun mua/msg-hidden-header (hdr val) "Return user-invisible header to the message (HDR: VAL\n)." - (format "%s: %s\n" hdr val)) - ;;(propertize (format "%s: %s\n" hdr val) 'invisible t)) + ;; (format "%s: %s\n" hdr val)) + (propertize (format "%s: %s\n" hdr val) 'invisible t)) (defun mua/msg-header (hdr val) "Return a header line of the form HDR: VAL\n. If VAL is nil, return nil." (when val (format "%s: %s\n" hdr val))) - ;;(propertize (format "%s: %s\n" hdr val) 'invisible t)) - (defun mua/msg-references-create (msg) "Construct the value of the References: header based on MSG as @@ -257,7 +253,7 @@ this function is either nil or a string to be used for the Cc: field." (let ((cc-lst (mua/msg-field msg :cc))) (when (and reply-all cc-lst) - (mu-message-recipients-to-string + (mua/msg-recipients-to-string (mua/msg-recipients-remove cc-lst user-mail-address))))) @@ -270,7 +266,6 @@ is nil, function returns nil." (format "%s <%s>" user-full-name user-mail-address) (format "%s" user-mail-address)))) - (defun mua/msg-create-reply (msg reply-all) "Create a draft message as a reply to MSG; if REPLY-ALL is non-nil, reply to all recipients. @@ -287,7 +282,7 @@ A reply message has fields: In-Reply-To: - message-id of MSG User-Agent - see `mua/msg-user-agent' -Then follows `mua-msg-separator' (for `message-mode' to separate +Then follows `mua/msg-separator' (for `message-mode' to separate body from headers) And finally, the cited body of MSG, as per `mua/msg-cite-original'." @@ -335,10 +330,8 @@ And finally, the cited body of MSG, as per `mua/msg-cite-original'." (mua/msg-header "Reply-To" mail-reply-to)) (mua/msg-header "To" "") - (mua/msg-hidden-header "User-agent" (mua/msg-user-agent)) (mua/msg-hidden-header "References" (mua/msg-references-for-reply msg)) - (mua/msg-header"Subject" (concat mua/msg-forward-prefix (mua/msg-field msg :subject))) @@ -361,7 +354,7 @@ then, the following fields, normally hidden from user: Then follows `mua-msg-separator' (for `message-mode' to separate body from headers)." (concat - (mua/msg-header "From" (or (mua/msg-from-for-new) "")) + (mua/msg-header "From" (or (mua/msg-from-create) "")) (when (boundp 'mail-reply-to) (mua/msg-header "Reply-To" mail-reply-to)) @@ -411,6 +404,31 @@ using Gnus' `message-mode'." (message-mode) (message-goto-body))) +(defun mua/msg-reply (msg) + "Create a draft reply to MSG, and swith to an edit buffer with +the draft message." + (let* ((recipnum (+ (length (mua/msg-field msg :to)) + (length (mua/msg-field msg :cc)))) + (replyall (when (> recipnum 1) + (yes-or-no-p (format "Reply to all ~%d recipients? " + (+ recipnum)))))) + ;; exact num depends on some more things + (when (mua/msg-compose (mua/msg-create-reply msg replyall)) + (message-goto-body)))) + +(defun mua/msg-forward (msg) + "Create a draft forward for MSG, and swith to an edit buffer with +the draft message." + (when (mua/msg-compose (mua/msg-create-forward msg)) + (message-goto-to))) + +(defun mua/msg-compose-new () + "Create a draft message, and swith to an edit buffer with the +draft message." + (when (mua/msg-compose (mua/msg-create-new)) + (message-goto-to))) + + (defun mua/msg-is-mua-message () "Check whether the current buffer refers a mua-message based on @@ -431,7 +449,9 @@ meant to be called from message mode's `message-sent-hook'." ((newflags ;; remove Draft; maybe set 'Seen' as well? (delq 'draft (mua/maildir-flags-from-path (buffer-file-name)))) (sent-msg - (mua/msg-move (buffer-file-name) mua/sent-folder newflagstr))) + (mua/msg-move (buffer-file-name) + (concat mua/maildir mua/sent-folder) ;; mua-sent-folder is only eg. "/sent" + (mua/maildir-flags-to-string newflags)))) (if sent-msg ;; change our buffer file-name (set-visited-file-name sent-msg t t) (mua/warn "Failed to save message to the Sent-folder"))))) @@ -444,7 +464,7 @@ flag. This is meant to be called from message mode's (if (mua/msg-is-mua-message) ;; only if we are mua (let ((msgid (mail-header-parse-addresses (message-field-value "In-Reply-To"))) - (path (and msgid (mua/mu-run + (path (and msgid (mua/mu-run ;; TODO: check we only get one msgid back "find" (concat "msgid:" msgid) "--exec=echo")))) (if path (let ((newflags (cons 'replied (mua/maildir-flags-from-path path)))) diff --git a/toys/mua/mua-view.el b/toys/mua/mua-view.el index c23bde9b..1b288f5a 100644 --- a/toys/mua/mua-view.el +++ b/toys/mua/mua-view.el @@ -75,9 +75,15 @@ buffer." \"cur/\" (if it's not yet there), and setting the \"S\" flag." (let ((flags (mua/maildir-flags-from-path path))) (unless (member 'seen flags) ;; do we need to do something? - (let ((newflags (delq 'new (cons 'seen flags))) - (newpath (mua/maildir-from-path path t))) - (unless (mua/msg-move path newpath newflags) + (let* ((newflags (delq 'new (cons 'seen flags))) + (target (mua/maildir-from-path path t)) + (newpath (mua/msg-move path target flags))) + ;; now, attempt to update our parent header list... + (if newpath + (mua/with-hdrs-buffer + (if (string= (mua/hdrs-get-path) path) ;; doublecheck we have the right one + (mua/hdrs-set-path newpath) + (mua/warn "Headers buffer not point at correct message"))) (mua/warn "Failed to mark message as read")))))) (defun mua/view-message (msg) diff --git a/toys/mua/mua.el b/toys/mua/mua.el index cda516e6..d56e26a0 100644 --- a/toys/mua/mua.el +++ b/toys/mua/mua.el @@ -31,6 +31,8 @@ (eval-when-compile (require 'cl)) (require 'mua-common) +(require 'mua-mu) +(require 'mua-msg) (require 'mua-hdrs) (require 'mua-view) @@ -64,7 +66,7 @@ quitted, it switches back to its parent buffer") (defvar mua/working-folders nil) (setq mua/working-folders - '("/archive" "/bulkarchive" "/todo")) + '("/bulk" "/archive" "/bulkarchive" "/todo")) (setq mua/header-fields '( (:date . 25) @@ -85,7 +87,7 @@ quitted, it switches back to its parent buffer") (define-key map "s" 'mua/hdrs-search) (define-key map "q" 'mua/quit-buffer) - (define-key map "o" 'mu-headers-change-sort) + (define-key map "o" 'mua/hdrs-change-sort) (define-key map "g" 'mua/hdrs-refresh) ;; navigation @@ -115,6 +117,59 @@ quitted, it switches back to its parent buffer") map)) (fset 'mua/hdrs-mode-map mua/hdrs-mode-map) +(defconst mua/buffer-name "*mua*" + "Name of the top-level mua buffer") + +(defun mua() + "Start mua, the mu e-mail client with an impressive dashboard." + (interactive) + (let ((buf (mua/new-buffer mua/buffer-name))) + (with-current-buffer buf + (insert (propertize "mua" 'face 'highlight) + (propertize " version: " 'face 'mua/header-title-face) + (propertize (mua/mu-binary-version) 'face 'mua/header-face) + (propertize " maildir: " 'face 'mua/header-title-face) + (propertize mua/maildir 'face 'mua/header-face) + "\n\n\n" + (propertize "* quick jump folders" 'face 'mua/header-title-face) + " (use " (propertize "j" 'face 'highlight) ")\n" + " " (mapconcat 'identity + (append (list mua/inbox-folder mua/sent-folder mua/drafts-folder) + mua/working-folders) " ") "\n\n" + + (propertize "* search" 'face 'mua/header-title-face) + " (use " (propertize "s" 'face 'highlight) ")\n\n" + + (propertize "* compose a new message" 'face 'mua/header-title-face) + " (use " (propertize "c" 'face 'highlight) ")\n\n" + )) + (switch-to-buffer buf) + (mua/mua-mode))) + + +(defvar mua/mua-mode-map + (let ((map (make-sparse-keymap))) + + (define-key map "s" 'mua/hdrs-search) + (define-key map "q" 'mua/quit-buffer) + (define-key map "j" 'mua/hdrs-jump-to-maildir) + (define-key map "c" 'mua/hdrs-compose) + + map) + "Keymap for *mua-headers* buffers.") +(fset 'mua/mua-mode-map mua/mua-mode-map) + +(defun mua/mua-mode () + "Major mode for the mua dashboard screen." + (interactive) + (kill-all-local-variables) + (use-local-map mua/mua-mode-map) + (make-local-variable 'mua/buf) + + (setq + major-mode 'mua/mua-mode mode-name "*mua*" + truncate-lines t buffer-read-only t + overwrite-mode 'overwrite-mode-binary)) (provide 'mua) diff --git a/toys/mug/mug-msg-list-view.c b/toys/mug/mug-msg-list-view.c index 302c2be4..d93dd33d 100644 --- a/toys/mug/mug-msg-list-view.c +++ b/toys/mug/mug-msg-list-view.c @@ -306,11 +306,11 @@ static MugError mu_result_to_mug_error (MuError r) { switch (r) { - case MU_ERROR_XAPIAN_DIR: + case MU_ERROR_XAPIAN_DIR_NOT_ACCESSIBLE: return MUG_ERROR_XAPIAN_DIR; - case MU_ERROR_XAPIAN_NOT_UPTODATE: + case MU_ERROR_XAPIAN_NOT_UP_TO_DATE: return MUG_ERROR_XAPIAN_NOT_UPTODATE; - case MU_ERROR_QUERY: + case MU_ERROR_XAPIAN_QUERY: return MUG_ERROR_QUERY; default: return MUG_ERROR_OTHER; diff --git a/toys/mug2/mug-msg-list-view.c b/toys/mug2/mug-msg-list-view.c index 755e1057..1361e58a 100644 --- a/toys/mug2/mug-msg-list-view.c +++ b/toys/mug2/mug-msg-list-view.c @@ -309,11 +309,11 @@ static MugError mu_result_to_mug_error (MuError r) { switch (r) { - case MU_ERROR_XAPIAN_DIR: + case MU_ERROR_XAPIAN_DIR_NOT_ACCESSIBLE: return MUG_ERROR_XAPIAN_DIR; - case MU_ERROR_XAPIAN_NOT_UPTODATE: + case MU_ERROR_XAPIAN_NOT_UP_TO_DATE: return MUG_ERROR_XAPIAN_NOT_UPTODATE; - case MU_ERROR_QUERY: + case MU_ERROR_XAPIAN_QUERY: return MUG_ERROR_QUERY; default: return MUG_ERROR_OTHER; diff --git a/toys/mug2/mug.c b/toys/mug2/mug.c index 07e29be0..1970c821 100644 --- a/toys/mug2/mug.c +++ b/toys/mug2/mug.c @@ -45,7 +45,7 @@ struct _MugData { }; typedef struct _MugData MugData; -MuResult +static MuError each_msg (MuIndexStats* stats, MugData *data) { static int i = 0;