diff --git a/toys/mua/mua-common.el b/toys/mua/mua-common.el index 20640ae6..14ff76a9 100644 --- a/toys/mua/mua-common.el +++ b/toys/mua/mua-common.el @@ -72,9 +72,9 @@ old one first" (switch-to-buffer parentbuf)))) (defun mua/ask-maildir (prompt &optional fullpath) - "ask user with PROMPT for a maildir name, if fullpath is + "Ask user with PROMPT for a maildir name, if fullpath is non-nill, return the fulpath (ie, mu-maildir prepended to the -maildir" +maildir." (interactive) (let* ((showfolders (delete-dups @@ -89,11 +89,14 @@ 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" +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))))) (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 + (setq rv (apply 'call-process mua/mu-binary nil t nil args)))))) `(,(if (numberp rv) rv 1) . ,str))) @@ -105,18 +108,71 @@ to get it" (match-string 1 (cdr rv)) (mua/warn "Failed to get version string")))) -(defun mua/mu-mv (src target &optional flags)) +(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. -(defun mua/mu-add (src target &optional flags)) +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 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) + "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 +and Trash, as defined in [1]. See `mua/maildir-string-to-flags' +and `mua/maildir-flags-to-string'. +\[1\] http://cr.yp.to/proto/maildir.html." + (when (string-match ",\\(\[A-Z\]*\\)$" path) + (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)))) + +;; TODO: make this async, but somehow serialize database access (defun mua/mu-remove (path) - "Remove message at PATH from the database" - - - ) - -(defun mua/mu-mv (src target &optional flags)) - + "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))) (defun mua/mu-view-sexp (path) "Return a string with an s-expression representing the message @@ -131,5 +187,49 @@ 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-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, +replied, seen, trashed and the string is the concatenation of the +uppercased first letters of these flags, as per [1]. Other flags +than the ones listed here are ignored. +Also see `mua/maildir-string-to-flags'. + +\[1\]: http://cr.yp.to/proto/maildir.html" + (when flags + (let ((kar + (case (car flags) + ('draft ?D) + ('flagged ?F) + ('new ?N) + ('passed ?P) + ('replied ?R) + ('seen ?S) + ('trashed ?T)))) + (concat (and kar (string kar)) + (mua/maildir-flags-to-string (cdr flags)))))) + +(defun mua/maildir-string-to-flags (str) + "Convert a string with message flags as seen in Maildir +messages into a list of flags in; flags are symbols draft, +flagged, new, passed, replied, seen, trashed and the string is +the concatenation of the uppercased first letters of these flags, +as per [1]. Other letters than the ones listed here are ignored. +Also see `mua/maildir-flags-to-string'. + +\[1\]: http://cr.yp.to/proto/maildir.html" + (when (/= 0 (length str)) + (let ((flag + (case (string-to-char str) + (?D 'draft) + (?F 'flagged) + (?N 'new) + (?P 'passed) + (?R 'replied) + (?S 'seen) + (?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 5bcff09e..d745fa89 100644 --- a/toys/mua/mua-hdrs.el +++ b/toys/mua/mua-hdrs.el @@ -456,7 +456,8 @@ pseudo-markings." "Reply to message at point." (interactive) (let* ((path (mua/hdrs-get-path)) - (msg (when path (mua/msg-from-path path)))) + (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? "))) diff --git a/toys/mua/mua-msg.el b/toys/mua/mua-msg.el index 54d59c79..76f6b89b 100644 --- a/toys/mua/mua-msg.el +++ b/toys/mua/mua-msg.el @@ -78,7 +78,7 @@ text, using `html2text'." (insert body) (html2text) (buffer-string))))) - body)) + body)) (defun mua/msg-field (msg field) "Get a field from this message, or nil. The fields are the @@ -92,9 +92,6 @@ or if not available, :body-html converted to text)." (t (plist-get msg field)))) -;; TODO: add better error-reporting to mua/msg-move, and make flag handling a -;; bit more lispy - (defun mua/msg-move (src targetdir &optional flags) "Move message at SRC to TARGETDIR using 'mu mv'; SRC must be the full, absolute path to a message file, while TARGETDIR must @@ -102,9 +99,10 @@ 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 string consisting of one or more of DFNPRST, mean +be a list consisting of one or more of DFNPRST, mean resp. Deleted, Flagged, New, Passed Replied, Seen and Trash, as -defined in [1]. +defined in [1]. See `mua/maildir-string-to-flags' and +`mua/maildir-flags-to-string'. If TARGETDIR is '/dev/null', remove SRC. After the file system move, the database will be updated as well, using the 'mu add' @@ -115,32 +113,12 @@ Function returns the target filename if the move succeeds, or `nil'. \[1\] http://cr.yp.to/proto/maildir.html." - -;; require the flags to be kosher - (when (and flags (let ((case-fold-search nil)) - (string-match "[^DFNPRST]" flags))) (error Illegal flags)) - - (let* ((cmd (concat - mua/mu-binary " mv --printtarget " - (when flags (concat "--flags=" flags " ")) - (shell-quote-argument src) " " - (shell-quote-argument targetdir))) - (fulltarget (shell-command-to-string cmd))) - (mua/log cmd) - (mua/log - (if fulltarget (concat "Message has been moved to " fulltarget) - "Message moving failed")) - ;; now, if saving worked, anynchronously try to update the database - (when fulltarget ;; note, we don't check the result of the db output - - (mua/log "Removing from database: %s" src) - (start-process " *mu-remove*" nil mua/mu-binary "remove" src) - + (let ((fulltarget (mua/mu-mv str target flags))) + (when fulltarget + (mua/mu-remove src) (unless (string= targetdir "/dev/null") - (mua/log "Adding to database: %s" fulltarget) - (start-process " *mu-add*" nil mua/mu-binary "add" fulltarget) t) - ) - + mua/mu-add fulltarget)) + fulltarget)) @@ -170,18 +148,21 @@ version of mua and emacs." line (with the %s's replaced with the date of MSG and the name or e-mail address of its sender (or 'someone' if nothing else)), followed of the quoted body of MSG, constructed by by - prepending `mua/msg-citation-prefix' to each line." - (let ((from (mua/msg-field msg :from))) - (concat - (format "On %s, %s wrote:" - (format-time-string "%c" (mua/msg-field msg :date)) - (if (and from (car from)) ;; a list (( . )) - (or (caar from) (cdar from) "someone") - "someone")) - "\n\n" - (replace-regexp-in-string "^" " > " - (mua/msg-body-txt-or-html msg))))) - + prepending `mua/msg-citation-prefix' to each line. If there is + no body in MSG, return nil." + (let* ((from (mua/msg-field msg :from)) + (body (mua/msg-body-txt-or-html msg))) + (when body + (concat + (format "On %s, %s wrote:" + (format-time-string "%c" (mua/msg-field msg :date)) + (if (and from (car from)) ;; a list (( . )) + (or (caar from) (cdar from) "someone") + "someone")) + "\n\n" + (replace-regexp-in-string "^" " > " body))))) + + (defun mua/msg-recipients-remove (lst email-to-remove) "Remove the recipient with EMAIL from the recipient list (of form '( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\"))." @@ -390,7 +371,7 @@ with non-mua-generated messages") "Create a Maildir-compatible[1], unique file name for a draft message. [1]: see http://cr.yp.to/proto/maildir.html" - (format "%s-%x-%x.%s:2,D" ;; 'D': rarely used, but hey, it's available + (format "%s-%s-%x.%s:2,D" ;; 'D': rarely used, but hey, it's available mua/msg-file-prefix (format-time-string "%Y%m%d" (current-time)) (emacs-pid) @@ -424,7 +405,6 @@ using Gnus' `message-mode'." (message-goto-body))) - (defun mua/msg-is-mua-message () "Check whether the current buffer refers a mua-message based on the buffer file name; this is used in hooks we install on