From 250aa91f5c2996913acdef434e6807c9714566d5 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Wed, 10 Aug 2011 23:58:47 +0300 Subject: [PATCH] * mua updates --- toys/mua/TODO | 10 ++++-- toys/mua/mua-common.el | 78 ++++++++++++++++++++++++++---------------- toys/mua/mua-hdrs.el | 8 ++--- toys/mua/mua-msg.el | 70 +++++++++++++++++++++---------------- toys/mua/mua-view.el | 17 +++++++-- 5 files changed, 112 insertions(+), 71 deletions(-) diff --git a/toys/mua/TODO b/toys/mua/TODO index fd6444e2..c1a35dfa 100644 --- a/toys/mua/TODO +++ b/toys/mua/TODO @@ -2,21 +2,25 @@ [ ] message un-new in find/view [ ] set 'Replied' flag on source when message is replied - [ ] update database after changes (CHECK) [ ] save message to draft, sent items [ ] attachment handling (open, play) in view - [ ] abstract away mu/binary, shell-command-to-string - [ ] make flag handling a bit more lispy + [ ] fix flags in src/ + [ ] version check + + [ ] make add, remove async (use async buffer) [ ] threads support [ ] expandable recipients list in view [ ] additive font props in mu find [ ] fix headers/view interaction + [ ] region commands [ ] menu [ ] mua-dashboard + + # Local Variables: diff --git a/toys/mua/mua-common.el b/toys/mua/mua-common.el index 14ff76a9..adf844f3 100644 --- a/toys/mua/mua-common.el +++ b/toys/mua/mua-common.el @@ -59,7 +59,7 @@ old one first" (get-buffer-create bufname)) (defun mua/message (frm &rest args) - "print a mua message at point" + "print a message at point" (let ((str (apply 'format frm args)) (inhibit-read-only t)) (insert (propertize str 'face 'italic)))) @@ -94,10 +94,12 @@ 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 cmdstr) `(,(if (numberp rv) rv 1) . ,str))) (defun mua/mu-binary-version () @@ -127,19 +129,18 @@ Function returns the target filename if the move succeeds, or \[1\] http://cr.yp.to/proto/maildir.html." (let ((flagstr (and flags (mua/maildir-flags-to-string flags)))) - (if (not (file-readable-p path)) - (mua/warn "Path is note a readable file") - (let ((rv (if flagstr - (mua/run "mv" "--printtarget" path target) - (mua/run "mv" "--printtarget" - (concat "--flags=" flagstr) path target)))) - (if (/= 0 (car rv)) - (mua/warn "Moving message file failed: %s" - (if (car rv) (car rv) "error")) - (car rv)))))) - - -(defun mua/mu-get-flags (path) + (if (not (file-readable-p src)) + (mua/warn "Source is not a readable file") + (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")) + output))))) ;; the full target path + +(defun mua/maildir-flags-from-path (path) "Get the flags for the message at PATH, which does not have to exist. The flags are returned as a list consisting of one or more of DFNPRST, mean resp. Deleted, Flagged, New, Passed Replied, Seen @@ -150,29 +151,28 @@ 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 "Path is note a readable file") - (let ((rv (mua/mu-run "add" path))) - (if (=/ (car rv) 0) - (mua/warn "mu add failed (%d): %s" - code (if (cdr rv) (cdr rv) "error")) - t)))) + (mua/warn "Path is not a readable 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))) - (when (=/ (car rv) 0) - (mua/warn "mu remove failed (%d): %s" - code (if (cdr rv) (cdr rv) "error")) - t))) + (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 @@ -187,6 +187,26 @@ that function converts the string into a Lisp object (plist)" (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 +part between the `mua/maildir' and the /cur or /new; so +e.g. \"/home/user/Maildir/foo/bar/cur/12345:2,S\" would have +\"/foo/bar\" as its maildir. If DONT-STRIP-PREFIX is non-nil, +function will instead _not_ remove the `mua/maildir' from the +front - so in that case, the example would return +\"/home/user/Maildir/foo/bar/\". If the maildir cannot be +determined, return `nil'." + (when (and (string-match "^\\(.*\\)/\\(cur\\|new\\)/\[^/\]*$" path)) + (let ((mdir (match-string 1 path))) + (when (and (< (length mua/maildir) (length mdir)) + (string= (substring mdir 0 (length mua/maildir)) mua/maildir)) + (if dont-strip-prefix + mdir + (substring mdir (length mua/maildir))))))) + +;; TODO: ensure flag string have the chars in ASCII-order (as per maildir spec) +;; TODO: filter-out duplicate flags + (defun mua/maildir-flags-to-string (flags) "Convert a list of flags into a string as seen in Maildir message files; flags are symbols draft, flagged, new, passed, @@ -199,10 +219,9 @@ Also see `mua/maildir-string-to-flags'. \[1\]: http://cr.yp.to/proto/maildir.html" (when flags (let ((kar - (case (car flags) - ('draft ?D) + (case (car flags) + ('draft ?D) ('flagged ?F) - ('new ?N) ('passed ?P) ('replied ?R) ('seen ?S) @@ -224,7 +243,6 @@ Also see `mua/maildir-flags-to-string'. (case (string-to-char str) (?D 'draft) (?F 'flagged) - (?N 'new) (?P 'passed) (?R 'replied) (?S 'seen) diff --git a/toys/mua/mua-hdrs.el b/toys/mua/mua-hdrs.el index d745fa89..27860c38 100644 --- a/toys/mua/mua-hdrs.el +++ b/toys/mua/mua-hdrs.el @@ -307,18 +307,14 @@ fitting in WIDTH" (interactive) ;; TODO: check if next line has path, if not, don't go there (if (or (/= 0 (forward-line 1)) (not (mua/hdrs-get-path))) (mua/warn "No message after this one") - (progn - (mua/log "At: %d [%S]" (point) (mua/hdrs-get-path)) t))) - + t)) (defun mua/hdrs-prev () "go to the previous line; t if it worked, nil otherwise" (interactive) (if (or (/= 0 (forward-line -1)) (not (mua/hdrs-get-path))) (mua/warn "No message before this one") - (progn - (mua/log "At: %d [%S]" (point) (mua/hdrs-get-path)) t))) - + t)) (defun mua/hdrs-view () (interactive) diff --git a/toys/mua/mua-msg.el b/toys/mua/mua-msg.el index 76f6b89b..ff46c802 100644 --- a/toys/mua/mua-msg.el +++ b/toys/mua/mua-msg.el @@ -38,9 +38,10 @@ (require 'mua-common) (defun mua/msg-from-string (str) - "Get the plist describing an email message, from a string -contain a message sexp; a message sexp looks something like: The -message sexp looks something like: + "Get the plist describing an email message, from STR containing +a message sexp. + + a message sexp looks something like: \( :from ((\"Donald Duck\" . \"donald@example.com\")) :to ((\"Mickey Mouse\" . \"mickey@example.com\")) @@ -50,6 +51,7 @@ message sexp looks something like: :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) @@ -88,7 +90,11 @@ as described in `mua/msg-from-string' There is also the special field :body (which is either :body-txt, or if not available, :body-html converted to text)." (case field - (:body (mua/msg-body-txt-or-html msg)) + (:body + (mua/msg-body-txt-or-html msg)) + (:maildir ;; messages gotten from mu-view don't have their maildir set... + (or (plist-get msg :maildir) + (mua/maildir-from-path (mua/msg-field msg :path)))) (t (plist-get msg field)))) @@ -113,13 +119,13 @@ Function returns the target filename if the move succeeds, or `nil'. \[1\] http://cr.yp.to/proto/maildir.html." - (let ((fulltarget (mua/mu-mv str target flags))) - (when fulltarget + (let ((fulltarget (mua/mu-mv src targetdir flags))) + (if fulltarget (mua/mu-remove src) (unless (string= targetdir "/dev/null") - mua/mu-add fulltarget)) - - fulltarget)) + (mua/mu-add fulltarget)) + fulltarget) + (mua/warn "Moving message failed"))) ;; functions for composing new messages (forward, reply and new) @@ -416,33 +422,37 @@ messages (mua is not the only user of `message-mode' after all)" ;; we simply check if file starts with `mu-msg-file-prefix' (defun mua/msg-save-to-sent () - "function that moves the current message to the sent folder" - (if (mua/msg-is-mua-message) + "Move the message in this buffer to the sent folder. This is +meant to be called from message mode's `message-sent-hook'." + (if (mua/msg-is-mua-message) ;; only if we are mua (unless mua/sent-folder (error "mua/sent-folder not set")) - - (let ((sent-msg ;; note, the "" parameter remove the D 'Draft'-flag - (mua/msg-move (buffer-file-name) mua/sent-folder ""))) - (if (sent-msg) ;; change our buffer file-name + (let* ;; TODO: remove duplicate flags + ((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))) + (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"))))) - -;; (defun mua/msg-set-replied-flag () -;; "find the message we replied to, and set its 'Replied' flag." -;; (if (mua/msg-is-mua-message) -;; (let ((msgid (mail-header-parse-addresses -;; (message-field-value "In-Reply-To"))) -;; (path (and msgid (shell-command-to-string -;; (concat mua/mu-binary -;; " find msgid:" msgid " --exec=echo | head -1"))))) -;; (if path -;; (mu-mv) - + +(defun mua/msg-set-replied-flag () + "Find the message we replied to, and set its 'Replied' +flag. This is meant to be called from message mode's +`message-sent-hook'." + (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 + "find" (concat "msgid:" msgid) "--exec=echo")))) + (if path + (let ((newflags (cons 'replied (mua/maildir-flags-from-path path)))) + (mua/msg-move path (mua/maildir-from-path path t) newflags)))))) - -;; add-hook -;; add-hook +;; hook our functions up with sending of the message +(add-hook 'message-sent-hook 'mua/msg-save-to-sent) +(add-hook 'message-sent-hook 'mua/msg-set-replied-flag) (provide 'mua-msg) diff --git a/toys/mua/mua-view.el b/toys/mua/mua-view.el index 57d4d48e..c23bde9b 100644 --- a/toys/mua/mua-view.el +++ b/toys/mua/mua-view.el @@ -38,7 +38,7 @@ "buffer name for mua/view buffers") (defvar mua/view-headers - '(:from :to :cc :subject :flags :date :attachments) + '(:from :to :cc :subject :flags :date :maildir :attachments) "fields to display in the message view") (defvar mua/hdrs-buffer nil @@ -66,7 +66,19 @@ buffer." (setq ;; these are buffer-local mua/hdrs-buffer headersbuf mua/parent-buffer headersbuf) - (goto-char (point-min))))) + (goto-char (point-min)) + (mua/view-mark-as-read path)))) + +(defun mua/view-mark-as-read (path) + "Mark the currently viewed as read if it is not so already. In + Maildir terms, this means moving the message from \"new/\" to + \"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) + (mua/warn "Failed to mark message as read")))))) (defun mua/view-message (msg) "construct a display string for the message" @@ -82,6 +94,7 @@ buffer." (:bcc (mua/view-contacts msg field)) (:date (mua/view-date msg)) (:flags (mua/view-flags msg)) + (:maildir (mua/view-header msg "Maildir" :maildir)) (:size (mua/view-size msg)) (:attachments (mua/view-attachments msg)) (t (error "Unsupported field: %S" field))))