* mua updates
This commit is contained in:
@ -72,9 +72,9 @@ old one first"
|
|||||||
(switch-to-buffer parentbuf))))
|
(switch-to-buffer parentbuf))))
|
||||||
|
|
||||||
(defun mua/ask-maildir (prompt &optional fullpath)
|
(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
|
non-nill, return the fulpath (ie, mu-maildir prepended to the
|
||||||
maildir"
|
maildir."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((showfolders
|
(let* ((showfolders
|
||||||
(delete-dups
|
(delete-dups
|
||||||
@ -89,11 +89,14 @@ where <exit-code> is the exit code of the program, or 1 if the
|
|||||||
process was killed. <str> contains whatever the command wrote on
|
process was killed. <str> contains whatever the command wrote on
|
||||||
standard output/error, or nil if there was none or in case of
|
standard output/error, or nil if there was none or in case of
|
||||||
error. Basically, `mua/mu-run' is like `shell-command-to-string',
|
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)
|
(let* ((rv)
|
||||||
|
(args (append args (when mua/mu-home
|
||||||
|
(list (concat "--muhome=" mua/mu-home)))))
|
||||||
(str (with-output-to-string
|
(str (with-output-to-string
|
||||||
(with-current-buffer standard-output ;; but we also get stderr...
|
(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))))))
|
args))))))
|
||||||
`(,(if (numberp rv) rv 1) . ,str)))
|
`(,(if (numberp rv) rv 1) . ,str)))
|
||||||
|
|
||||||
@ -105,18 +108,71 @@ to get it"
|
|||||||
(match-string 1 (cdr rv))
|
(match-string 1 (cdr rv))
|
||||||
(mua/warn "Failed to get version string"))))
|
(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)
|
(defun mua/mu-remove (path)
|
||||||
"Remove message at PATH from the database"
|
"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)
|
||||||
(defun mua/mu-mv (src target &optional flags))
|
(mua/warn "mu remove failed (%d): %s"
|
||||||
|
code (if (cdr rv) (cdr rv) "error"))
|
||||||
|
t)))
|
||||||
|
|
||||||
(defun mua/mu-view-sexp (path)
|
(defun mua/mu-view-sexp (path)
|
||||||
"Return a string with an s-expression representing the message
|
"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"
|
(mua/warn "mu view failed (%d): %s"
|
||||||
code (if str str "error"))))))
|
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)
|
(provide 'mua-common)
|
||||||
|
|||||||
@ -456,7 +456,8 @@ pseudo-markings."
|
|||||||
"Reply to message at point."
|
"Reply to message at point."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((path (mua/hdrs-get-path))
|
(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
|
(if msg
|
||||||
(mua/msg-compose (mua/msg-create-reply msg
|
(mua/msg-compose (mua/msg-create-reply msg
|
||||||
(yes-or-no-p "Reply to all? ")))
|
(yes-or-no-p "Reply to all? ")))
|
||||||
|
|||||||
@ -78,7 +78,7 @@ text, using `html2text'."
|
|||||||
(insert body)
|
(insert body)
|
||||||
(html2text)
|
(html2text)
|
||||||
(buffer-string)))))
|
(buffer-string)))))
|
||||||
body))
|
body))
|
||||||
|
|
||||||
(defun mua/msg-field (msg field)
|
(defun mua/msg-field (msg field)
|
||||||
"Get a field from this message, or nil. The fields are the
|
"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))))
|
(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)
|
(defun mua/msg-move (src targetdir &optional flags)
|
||||||
"Move message at SRC to TARGETDIR using 'mu mv'; SRC must be
|
"Move message at SRC to TARGETDIR using 'mu mv'; SRC must be
|
||||||
the full, absolute path to a message file, while TARGETDIR must
|
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.
|
will calculate the target directory and the exact file name.
|
||||||
|
|
||||||
Optionally, you can specify the FLAGS for the new file; this must
|
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
|
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
|
If TARGETDIR is '/dev/null', remove SRC. After the file system
|
||||||
move, the database will be updated as well, using the 'mu add'
|
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'.
|
`nil'.
|
||||||
|
|
||||||
\[1\] http://cr.yp.to/proto/maildir.html."
|
\[1\] http://cr.yp.to/proto/maildir.html."
|
||||||
|
(let ((fulltarget (mua/mu-mv str target flags)))
|
||||||
;; require the flags to be kosher
|
(when fulltarget
|
||||||
(when (and flags (let ((case-fold-search nil))
|
(mua/mu-remove src)
|
||||||
(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)
|
|
||||||
|
|
||||||
(unless (string= targetdir "/dev/null")
|
(unless (string= targetdir "/dev/null")
|
||||||
(mua/log "Adding to database: %s" fulltarget)
|
mua/mu-add fulltarget))
|
||||||
(start-process " *mu-add*" nil mua/mu-binary "add" fulltarget) t)
|
|
||||||
)
|
|
||||||
|
|
||||||
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
|
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
|
or e-mail address of its sender (or 'someone' if nothing
|
||||||
else)), followed of the quoted body of MSG, constructed by by
|
else)), followed of the quoted body of MSG, constructed by by
|
||||||
prepending `mua/msg-citation-prefix' to each line."
|
prepending `mua/msg-citation-prefix' to each line. If there is
|
||||||
(let ((from (mua/msg-field msg :from)))
|
no body in MSG, return nil."
|
||||||
(concat
|
(let* ((from (mua/msg-field msg :from))
|
||||||
(format "On %s, %s wrote:"
|
(body (mua/msg-body-txt-or-html msg)))
|
||||||
(format-time-string "%c" (mua/msg-field msg :date))
|
(when body
|
||||||
(if (and from (car from)) ;; a list ((<name> . <email>))
|
(concat
|
||||||
(or (caar from) (cdar from) "someone")
|
(format "On %s, %s wrote:"
|
||||||
"someone"))
|
(format-time-string "%c" (mua/msg-field msg :date))
|
||||||
"\n\n"
|
(if (and from (car from)) ;; a list ((<name> . <email>))
|
||||||
(replace-regexp-in-string "^" " > "
|
(or (caar from) (cdar from) "someone")
|
||||||
(mua/msg-body-txt-or-html msg)))))
|
"someone"))
|
||||||
|
"\n\n"
|
||||||
|
(replace-regexp-in-string "^" " > " body)))))
|
||||||
|
|
||||||
|
|
||||||
(defun mua/msg-recipients-remove (lst email-to-remove)
|
(defun mua/msg-recipients-remove (lst email-to-remove)
|
||||||
"Remove the recipient with EMAIL from the recipient list (of
|
"Remove the recipient with EMAIL from the recipient list (of
|
||||||
form '( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\"))."
|
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
|
"Create a Maildir-compatible[1], unique file name for a draft
|
||||||
message.
|
message.
|
||||||
[1]: see http://cr.yp.to/proto/maildir.html"
|
[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
|
mua/msg-file-prefix
|
||||||
(format-time-string "%Y%m%d" (current-time))
|
(format-time-string "%Y%m%d" (current-time))
|
||||||
(emacs-pid)
|
(emacs-pid)
|
||||||
@ -424,7 +405,6 @@ using Gnus' `message-mode'."
|
|||||||
(message-goto-body)))
|
(message-goto-body)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defun mua/msg-is-mua-message ()
|
(defun mua/msg-is-mua-message ()
|
||||||
"Check whether the current buffer refers a mua-message based on
|
"Check whether the current buffer refers a mua-message based on
|
||||||
the buffer file name; this is used in hooks we install on
|
the buffer file name; this is used in hooks we install on
|
||||||
|
|||||||
Reference in New Issue
Block a user