emacs
/
mu
mirror of https://github.com/djcb/mu.git
1
0
Fork 0
Code Issues Releases Wiki Activity

* mua updates

This commit is contained in:
Dirk-Jan C. Binnema 2011-08-10 23:58:47 +03:00
parent 93753f56ba
commit 250aa91f5c
5 changed files with 112 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
toys/mua/TODO
View File

@ -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:

78
toys/mua/mua-common.el
View File

@ -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)

8
toys/mua/mua-hdrs.el
View File

@ -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)

70
toys/mua/mua-msg.el
View File

@ -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)

17
toys/mua/mua-view.el
View File

@ -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))))