alx/mu4e
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* mua updates

Browse Source
This commit is contained in:
Dirk-Jan C. Binnema
2011-08-16 23:44:08 +03:00
parent a84d72e7cf
commit 43b1edbbe5
5 changed files with 183 additions and 197 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -53,8 +53,8 @@
"*internal* The mu-find process.") "*internal* The mu-find process.")
(defvar mua/hdrs-hash nil (defvar mua/hdrs-hash nil
"*internal* The bol->uid hash.") "*internal* The bol->uid hash.")
(defvar mua/hdrs-marks-hash nil
"*internal* The hash for marked messages.")
(defconst mua/eom "\n;;eom\n" (defconst mua/eom "\n;;eom\n"
"*internal* Marker for the end of message in the mu find "*internal* Marker for the end of message in the mu find
@ -191,8 +191,8 @@
(defun mua/hdrs-set-path (path) (defun mua/hdrs-set-path (path)
"Map the bol of the current header to an entry in "Map the bol of the current header to an entry in
`mua/msg-file-map', and return the uid" `mua/msg-map', and return the uid."
(let ((uid (mua/msg-file-register path))) (let ((uid (mua/msg-map-add path)))
(puthash (line-beginning-position 1) uid mua/hdrs-hash) (puthash (line-beginning-position 1) uid mua/hdrs-hash)
uid)) uid))
@ -202,9 +202,7 @@
(defun mua/hdrs-get-path () (defun mua/hdrs-get-path ()
"Get the current path for the header at point." "Get the current path for the header at point."
(let ((uid (mua/hdrs-get-uid))) (mua/msg-map-get-path (mua/hdrs-get-uid)))
(mua/msg-file-get-path uid)))
(defun mua/hdrs-append-message (msg) (defun mua/hdrs-append-message (msg)
"append a message line to the buffer and register the message" "append a message line to the buffer and register the message"
@ -370,7 +368,7 @@ if the search process is not already running"
(defun mua/hdrs-change-sort () (defun mua/hdrs-change-sort ()
"Change thee sort field and direction." "Change thee sort field and dirtrection."
(interactive) (interactive)
(and (call-interactively 'mua/hdrs-change-sort-order) (and (call-interactively 'mua/hdrs-change-sort-order)
(call-interactively 'mua/hdrs-change-sort-direction))) (call-interactively 'mua/hdrs-change-sort-direction)))
@ -379,48 +377,89 @@ if the search process is not already running"
;;; functions for marking ;;; functions for marking
(defun mua/hdrs-add-marked (uid &optional dst) (defvar mua/hdrs-marks-hash nil
"Add the message at point to the markings hash" "*internal* The hash for marked messages. The hash maps
(let ((bol (line-beginning-position 1))) bol (beginning-of-line) to a 3-tuple: [UID TARGET FLAGS], where UID is the
(if (gethash bol mua/hdrs-marks-hash) the UID of the message file (see `mua/msg-map'), TARGET is the
(mua/warn "Message is already marked") target maildir (ie., \"/inbox\", but can also be nil (for 'delete);
(progn (puthash bol (cons uid dst) mua/hdrs-marks-hash) t)))) and finally FLAGS is the flags to set when the message is moved.")
(defun mua/hdrs-remove-marked () (defun mua/hdrs-set-mark-ui (bol action)
"Remove the message at point from the markings hash" "Display (or undisplay) the mark for BOL for action ACTION."
(let ((bol (line-beginning-position 1))) (unless (member action '(delete trash move unmark))
(if (not (gethash bol mua/hdrs-marks-hash)) (error "Invalid action %S" action))
(mua/warn "Message is not marked") (save-excursion
(progn (remhash bol mua/hdrs-marks-hash) t)))) (let ((inhibit-read-only t))
(delete-char 2)
(insert
(case action
(delete "d ")
(trash "D ")
(move "m ")
(unmark " "))))))
(defun mua/hdrs-set-mark (bol uid &optional target flags)
"Add a mark to `mua/hdrs-marks-hash', with BOL being the beginning of the line
of the marked message and (optionally) TARGET the target for the trash or move,
and FLAGS the flags to set for the message, either as a string or as a list (see
`mua/msg-move' for a discussion of the format)."
(if (gethash bol mua/hdrs-marks-hash)
(mua/warn "Message is already marked")
(let ((tuple `[,uid ,target ,flags]))
(puthash bol tuple mua/hdrs-marks-hash) ;; add to the hash...
(mua/hdrs-set-mark-ui bol action))))
(defun mua/hdrs-remove-mark (bol)
"Remove the mark for the message at BOL from the markings
hash. BOL must be the point at the beginning of the line."
(if (not (gethash bol mua/hdrs-marks-hash))
(mua/warn "Message is not marked")
(progn
(remhash bol mua/hdrs-marks-hash) ;; remove from the hash...
(mua/hdrs-set-mark-ui bol 'unmark))))
(defun mua/hdrs-marks-execute ()
"Execute the corresponding actions for all marked messages in
`mua/hdrs-marks-hash'."
(interactive)
(let ((n-marked (hash-table-count mua/hdrs-marks-hash)))
(if (= 0 n-marked)
(mua/warn "No marked messages")
(when (y-or-n-p
(format "Execute actions for %d marked message(s)? " n-marked))
(save-excursion
(maphash
(lambda(bol tuple)
(let* ((uid (aref tuple 0)) (target (aref tuple 1))
(flags (aref tuple 2)) (inhibit-read-only t))
(when (mua/msg-move uid target flags)
;; remember the updated path -- for now not too useful
;; as we're hiding the header, but...
(save-excursion
(mua/hdrs-remove-mark bol)
(goto-char bol)
;; when it succeedes, hide msg..)
(put-text-property (line-beginning-position 1)
(line-beginning-position 2) 'invisible t)))))
mua/hdrs-marks-hash))))))
(defun mua/hdrs-set-marker (kar)
"Set the marker at the beginning of this line."
(beginning-of-line 1)
(let ((inhibit-read-only t))
(delete-char 2)
(insert (if kar (format "%c " kar) " "))))
(defun mua/hdrs-mark (action) (defun mua/hdrs-mark (action)
"Mark the message at point with one of the symbols: move, "Mark the message at point BOL (the beginning of the line) with
delete, trash, unmark, unmark-all; the latter two are one of the symbols: move, delete, trash, unmark, unmark-all; the
pseudo-markings." latter two are pseudo-markings."
(let ((uid (mua/hdrs-get-uid))) (let* ((bol (line-beginning-position 1)) (uid (mua/hdrs-get-uid)))
(when uid (when uid
(case action (case action
(move (move
(when (mua/hdrs-add-marked uid (mua/hdrs-set-mark bol uid (mua/ask-maildir "Target maildir: " t)))
(mua/ask-maildir "Target maildir: " t)) ;; t->return fullpath
(mua/hdrs-set-marker ?m)))
(trash (trash
(when (mua/hdrs-add-marked uid (if (member 'trashed (mua/msg-flags-from-path (mua/hdrs-get-path)))
(concat mua/maildir mua/trash-folder)) (mua/warn "Message is already trashed")
(mua/hdrs-set-marker ?d))) (mua/hdrs-set-mark bol uid (concat mua/maildir mua/trash-folder) "+T")))
(delete (delete
(when (mua/hdrs-add-marked uid "/dev/null") (mua/hdrs-set-mark bol action uid "/dev/null"))
(mua/hdrs-set-marker ?D)))
(unmark (unmark
(when (mua/hdrs-remove-marked) (mua/hdrs-remove-mark bol))
(mua/hdrs-set-marker nil)))
(unmark-all (unmark-all
(when (y-or-n-p (format "Sure you want to remove all (%d) marks? " (when (y-or-n-p (format "Sure you want to remove all (%d) marks? "
(hash-table-count mua/hdrs-marks-hash))) (hash-table-count mua/hdrs-marks-hash)))
@ -430,28 +469,6 @@ pseudo-markings."
(t (error "Unsupported mark type"))) (t (error "Unsupported mark type")))
(move-beginning-of-line 2)))) (move-beginning-of-line 2))))
(defun mua/hdrs-marks-execute ()
"execute the actions for all marked messages"
(interactive)
(let ((n-marked (hash-table-count mua/hdrs-marks-hash)))
(if (= 0 n-marked)
(mua/warn "No marked messages")
(when (y-or-n-p
(format "Execute actions for %d marked message(s)? " n-marked))
(save-excursion
(maphash
(lambda(bol v)
(let* ((uid (car v)) (target (cdr v)) (inhibit-read-only t))
(when (mua/msg-file-move-uid uid target)
;; remember the updated path -- for now not too useful
;; as we're hiding the header, but...
(goto-char bol)
(mua/hdrs-remove-marked)
(put-text-property (line-beginning-position 1)
(line-beginning-position 2)
'invisible t)))) ;; when it succeedes, hide msg..)
mua/hdrs-marks-hash))))))
;; functions for creating new message -- reply, forward, and new ;; functions for creating new message -- reply, forward, and new

150
toys/mua/mua-msg-file.el
View File

@ -31,7 +31,7 @@
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(defvar mua/msg-file-map nil (defvar mua/msg-map nil
"*internal* a map of uid->message. "*internal* a map of uid->message.
This map adds a level of indirection for message files; many This map adds a level of indirection for message files; many
@ -42,99 +42,115 @@ message in the system (in practice, the lifetime of a particular
headers buffer). headers buffer).
When creating the headers buffer, the file names are registered When creating the headers buffer, the file names are registered
with `mua/msg-file-register'. with `mua/msg-map-add'.
All operation that change file names ultimately (should) end up All operation that change file names ultimately (should) end up
in `mua/msg-file-move', which will update the map after the in `mua/msg-move', which will update the map after the
moving (using `mua/msg-file-update') moving (using `mua/msg-map-update')
Other places of the code can use the uid to get the *current* Other places of the code can use the uid to get the *current*
path of the file using `mua/msg-file-get-path'. path of the file using `mua/msg-map-get-path'.
") ")
(defun mua/msg-file-register (path) (defun mua/msg-map-add (path)
"Register a message PATH in the `mua/msg-file-map', and return "Add a message PATH to the `mua/msg-map', and return the uid
the uid for it." for it."
(unless mua/msg-file-map (unless mua/msg-map
(setq mua/msg-file-map (make-hash-table :size 256 :rehash-size 2))) (setq mua/msg-map (make-hash-table :size 256 :rehash-size 2 :weakness t)))
(let ((uid (sha1 path))) (let ((uid (sha1 path)))
(puthash uid path mua/msg-file-map) (puthash uid path mua/msg-map)
uid)) uid))
(defun mua/msg-file-update (uid path) (defun mua/msg-map-update (uid path)
"Set the new path for the message identified by UID to "Set the new path for the message identified by UID to PATH."
PATH." (if (gethash uid mua/msg-map)
(if (gethash uid mua/msg-file-map) (puthash uid path mua/msg-map)
(puthash uid path mua/msg-file-map)
(mua/warn "No message file registered for uid"))) (mua/warn "No message file registered for uid")))
(defun mua/msg-file-get-path (uid) (defun mua/msg-map-get-path (uid)
"Get the current path for the message identified by UID." "Get the current path for the message identified by UID."
(gethash uid mua/msg-file-map)) (gethash uid mua/msg-map))
(defun mua/msg-file-move-uid (uid targetdir &optional flags) (defun mua/msg-move (uid &optional targetdir flags ignore-already)
"Move message identified by UID to TARGETDIR using 'mu mv', and "Move message identified by UID to TARGETDIR using 'mu mv', and
update the database with the new situation. SRC must be the full, update the database with the new situation. SRC must be the full,
absolute path to a message file, while TARGETDIR must be a absolute path to a message file, while TARGETDIR must be a
maildir - that is, the part _without_ cur/ or new/. 'mu mv' will maildir - that is, the part _without_ cur/ or new/. 'mu mv' will
calculate the target directory and the exact file name. See calculate the target directory and the exact file name. See
`mua/msg-file-map' for a discussion about UID. `mua/msg-map' for a discussion about UID.
After the file system move (rename) has been done, 'mu remove' After the file system move (rename) has been done, 'mu remove'
and/or 'mu add' are invoked asynchronously to update the database and/or 'mu add' are invoked asynchronously to update the database
with the changes. with the changes.
Optionally, you can specify the FLAGS for the new file; this must Optionally, you can specify the FLAGS for the new file. The FLAGS
be a list consisting of one or more of DFNPRST, mean parameter can have the following forms:
resp. Deleted, Flagged, New, Passed Replied, Seen and g, as 1. a list of flags such as '(passed replied seen)
defined in [1]. See `mua/msg-file-string-to-flags' and 2. a string containing the one-char versions of the flags, e.g. \"PRS\"
`mua/msg-file-flags-to-string'. 3. a delta-string specifying the changes with +/- and the one-char flags,
e.g. \"+S-N\" to set Seen and remove New.
The flags are any of `deleted', `flagged', `new', `passed', `replied' `seen' or
`trashed', or the corresponding \"DFNPRST\" as defined in [1]. See
`mua/msg-string-to-flags' and `mua/msg-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'
and 'mu remove' commands. and 'mu remove' commands.
If IGNORE-ALREADY is non-nil, don't consider it an error when the target file is
the same as the source file.
Function returns t the move succeeds, in other cases, it returns Function returns t the move succeeds, in other cases, it returns
`nil'. nil.
\[1\] http://cr.yp.to/proto/maildir.html." \[1\] URL `http://cr.yp.to/proto/maildir.html'."
(let ((src (mua/msg-file-get-path uid))) (condition-case err
(unless src (error "Source path not registered.")) (let ((src (mua/msg-map-get-path uid)))
(let ((fulltarget (mua/mu-mv src targetdir flags))) (unless src (error "Source path not registered for %S" uid))
(when (and fulltarget (not (string= src fulltarget))) (unless (or targetdir src) (error "Either targetdir or flags required"))
(mua/msg-file-update uid fulltarget) ;; update the path (unless (file-readable-p src) (error "Source is unreadable (%S)" src))
(mua/mu-remove-async src) (let* ((flagstr
(unless (string= targetdir "/dev/null") (if (stringp flags) flags (mua/msg-flags-to-string flags)))
(mua/mu-add-async fulltarget))))) (argl (append ;; build-up the command line
t) '("mv" "--print-target" "--ignore-dups")
(when flagstr (list (concat "--flags=" flagstr)))
(list src)
(when targetdir (list targetdir))))
;; execute it, and get the results
(rv (apply 'mua/mu-run argl))
(code (car rv)) (output (cdr rv)))
(unless (= 0 code)
(error "Moving message failed: %S" output))
;; success!
(let ((targetpath (substring output 0 -1)))
(defun mua/msg-file-mark-as-read (uid) (when (and targetpath (not (string= src targetpath)))
"Mark the message identified by UID as read if it is not so ;; update the UID-map
already. In Maildir terms, this means moving the message from (mua/msg-map-update uid targetpath)
\"new/\" to \"cur/\" (if it's not yet there), and setting the ;; remove the src file
\"S\" flag." (mua/mu-remove-async src)
(let* ((path (mua/msg-file-get-path uid)) ;; and add the target file, unless it's dead now
(flags (and path (mua/msg-file-flags-from-path path)))) (unless (string= targetdir "/dev/null")
(when (or (member 'new flags) (not (member 'seen flags))) (mua/mu-add-async targetpath)))
(let* ((newflags (delq 'new (cons 'seen flags))) t)))
(target (mua/msg-file-maildir-from-path path t)))
(unless (mua/msg-file-move-uid uid target newflags) (error (mua/warn "error: %s" (error-message-string err)))))
(mua/warn "Failed to mark message as read"))))))
(defun mua/msg-file-flags-from-path (path) (defun mua/msg-flags-from-path (path)
"Get the flags for the message at PATH, which does not have to exist. "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 The flags are returned as a list consisting of one or more of
DFNPRST, mean resp. Deleted, Flagged, New, Passed Replied, Seen DFNPRST, mean resp. Deleted, Flagged, New, Passed Replied, Seen
and Trash, as defined in [1]. See `mua/msg-file-string-to-flags' and Trash, as defined in [1]. See `mua/msg-string-to-flags'
and `mua/msg-file-flags-to-string'. and `mua/msg-flags-to-string'.
\[1\] http://cr.yp.to/proto/maildir.html." \[1\] http://cr.yp.to/proto/maildir.html."
(when (string-match ",\\(\[A-Z\]*\\)$" path) (when (string-match ",\\(\[A-Z\]*\\)$" path)
(mua/msg-file-string-to-flags (match-string 1 path)))) (mua/msg-string-to-flags (match-string 1 path))))
(defun mua/msg-file-maildir-from-path (path &optional dont-strip-prefix) (defun mua/msg-maildir-from-path (path &optional dont-strip-prefix)
"Get the maildir from PATH; in this context, 'maildir' is the "Get the maildir from PATH; in this context, 'maildir' is the
part between the `mua/maildir' and the /cur or /new; so part between the `mua/maildir' and the /cur or /new; so
e.g. \"/home/user/Maildir/foo/bar/cur/12345:2,S\" would have e.g. \"/home/user/Maildir/foo/bar/cur/12345:2,S\" would have
@ -151,23 +167,21 @@ determined, return `nil'."
mdir mdir
(substring mdir (length mua/maildir))))))) (substring mdir (length mua/maildir)))))))
(defun mua/msg-flags-to-string (flags)
"Remove duplicates and sort the output of `mua/msg-flags-to-string-1'."
(defun mua/msg-file-flags-to-string (flags)
"Remove duplicates and sort the output of `mua/msg-file-flags-to-string-1'"
(concat (concat
(sort (sort
(remove-duplicates (remove-duplicates
(append (mua/msg-file-flags-to-string-1 flags) nil)) '>))) (append (mua/msg-flags-to-string-1 flags) nil)) '>)))
(defun mua/msg-file-flags-to-string-1 (flags) (defun mua/msg-flags-to-string-1 (flags)
"Convert a list of flags into a string as seen in Maildir "Convert a list of flags into a string as seen in Maildir
message files; flags are symbols draft, flagged, new, passed, message files; flags are symbols draft, flagged, new, passed,
replied, seen, trashed and the string is the concatenation of the replied, seen, trashed and the string is the concatenation of the
uppercased first letters of these flags, as per [1]. Other flags uppercased first letters of these flags, as per [1]. Other flags
than the ones listed here are ignored. than the ones listed here are ignored.
Also see `mua/msg-file-string-to-flags'. Also see `mua/msg-string-to-flags'.
\[1\]: http://cr.yp.to/proto/maildir.html" \[1\]: http://cr.yp.to/proto/maildir.html"
(when flags (when flags
@ -180,20 +194,20 @@ Also see `mua/msg-file-string-to-flags'.
('seen ?S) ('seen ?S)
('trashed ?T)))) ('trashed ?T))))
(concat (and kar (string kar)) (concat (and kar (string kar))
(mua/msg-file-flags-to-string-1 (cdr flags)))))) (mua/msg-flags-to-string-1 (cdr flags))))))
(defun mua/msg-file-string-to-flags (str) (defun mua/msg-string-to-flags (str)
"Remove duplicates from the output of `mua/msg-file-string-to-flags-1'" "Remove duplicates from the output of `mua/msg-string-to-flags-1'"
(remove-duplicates (mua/msg-file-string-to-flags-1 str))) (remove-duplicates (mua/msg-string-to-flags-1 str)))
(defun mua/msg-file-string-to-flags-1 (str) (defun mua/msg-string-to-flags-1 (str)
"Convert a string with message flags as seen in Maildir "Convert a string with message flags as seen in Maildir
messages into a list of flags in; flags are symbols draft, messages into a list of flags in; flags are symbols draft,
flagged, new, passed, replied, seen, trashed and the string is flagged, new, passed, replied, seen, trashed and the string is
the concatenation of the uppercased first letters of these flags, the concatenation of the uppercased first letters of these flags,
as per [1]. Other letters than the ones listed here are ignored. as per [1]. Other letters than the ones listed here are ignored.
Also see `mua/msg-file-flags-to-string'. Also see `mua/msg-flags-to-string'.
\[1\]: http://cr.yp.to/proto/maildir.html" \[1\]: http://cr.yp.to/proto/maildir.html"
(when (/= 0 (length str)) (when (/= 0 (length str))
@ -206,6 +220,6 @@ Also see `mua/msg-file-flags-to-string'.
(?S 'seen) (?S 'seen)
(?T 'trashed)))) (?T 'trashed))))
(append (when flag (list flag)) (append (when flag (list flag))
(mua/msg-file-string-to-flags-1 (substring str 1)))))) (mua/msg-string-to-flags-1 (substring str 1))))))
(provide 'mua-msg-file) (provide 'mua-msg-file)

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

@ -94,7 +94,7 @@ or if not available, :body-html converted to text)."
(mua/msg-body-txt-or-html msg)) (mua/msg-body-txt-or-html msg))
(:maildir ;; messages gotten from mu-view don't have their maildir set... (:maildir ;; messages gotten from mu-view don't have their maildir set...
(or (plist-get msg :maildir) (or (plist-get msg :maildir)
(mua/msg-file-maildir-from-path (mua/msg-field msg :path)))) (mua/msg-maildir-from-path (mua/msg-field msg :path))))
(t (plist-get msg field)))) (t (plist-get msg field))))
@ -334,7 +334,7 @@ body from headers)."
(mua/msg-header "Subject" "") (mua/msg-header "Subject" "")
mua/msg-separator)) mua/msg-separator))
(defconst mua/msg-file-prefix "mua" "prefix for mua-generated (defconst mua/msg-prefix "mua" "prefix for mua-generated
mail files; we use this to ensure that our hooks don't mess mail files; we use this to ensure that our hooks don't mess
with non-mua-generated messages") with non-mua-generated messages")
@ -343,7 +343,7 @@ with non-mua-generated messages")
message. message.
[1]: see http://cr.yp.to/proto/maildir.html" [1]: see http://cr.yp.to/proto/maildir.html"
(format "%s-%s-%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-prefix
(format-time-string "%Y%m%d" (current-time)) (format-time-string "%Y%m%d" (current-time))
(emacs-pid) (emacs-pid)
(random t) (random t)
@ -414,14 +414,14 @@ meant to be called from message mode's `message-sent-hook'."
(unless mua/sent-folder (error "mua/sent-folder not set")) (unless mua/sent-folder (error "mua/sent-folder not set"))
(let* ;; TODO: remove duplicate flags (let* ;; TODO: remove duplicate flags
((newflags ;; remove Draft; maybe set 'Seen' as well? ((newflags ;; remove Draft; maybe set 'Seen' as well?
(delq 'draft (mua/msg-file-flags-from-path (buffer-file-name)))) (delq 'draft (mua/msg-flags-from-path (buffer-file-name))))
;; so, we register path => uid, then we move uid, then check the name ;; so, we register path => uid, then we move uid, then check the name
;; uid is referring to ;; uid is referring to
(uid (mua/msg-file-register (buffer-file-name))) (uid (mua/msg-register (buffer-file-name)))
(if (mua/msg-move uid (if (mua/msg-move uid
(concat mua/maildir mua/sent-folder) (concat mua/maildir mua/sent-folder)
(mua/msg-file-flags-to-string newflags)) (mua/msg-flags-to-string newflags))
(set-visited-file-name (mua/msg-file-get-path uid) t t) (set-visited-file-name (mua/msg-get-path uid) t t)
(mua/warn "Failed to save message to the Sent-folder")))))) (mua/warn "Failed to save message to the Sent-folder"))))))
@ -438,16 +438,15 @@ This is meant to be called from message mode's
`message-sent-hook'." `message-sent-hook'."
;; handle the replied-to message ;; handle the replied-to message
(when mua/msg-reply-uid (when mua/msg-reply-uid
(let* ((oldflags (mua/msg-file-flags-from-path (mua/msg-file-get-path uid))) (unless (mua/msg-move mua/msg-reply-uid nil "+R")
(newflags (cons 'replied oldflags))) (mua/warn "Failed to marked parent message as 'Replied'")))
(mua/msg-file-move uid nil newflags)))
;; handle the forwarded message ;; handle the forwarded message
(when mua/msg-forward-uid (when mua/msg-forward-uid
(let* ((oldflags (mua/msg-file-flags-from-path (mua/msg-file-get-path uid))) (unless (mua/msg-move mua/msg-forward-uid nil "+P")
(newflags (cons 'passed oldflags))) (mua/warn "Failed to marked parent message as 'Passed'"))))
(mua/msg-file-move uid nil newflags))))
;; hook our functions up with sending of the message ;; 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-save-to-sent)
(add-hook 'message-sent-hook 'mua/msg-set-replied-or-passed-flag) (add-hook 'message-sent-hook 'mua/msg-set-replied-or-passed-flag)

46
toys/mua/mua-mu.el
View File

@ -59,52 +59,6 @@ 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 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/. FLAGS sets
the flags of the message.
TARGET can be nil, in which case only the flags are
changed (which on the file-system level still implies a rename or
even a move if directory if the 'new' flags is added or
removed). FLAGS can also be nil, in which they are not changed.
If both TARGET and FLAGS are nil, nothing happens.
'mu mv' will calculate the full path to target directory and file
based on SRC, TARGET and FLAGS.
FLAGS must be either nil or 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/msg-file-string-to-flags'
and `mua/msg-file-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."
;; precondition
(unless (or target flags) (error "Either target or flags must
be provided."))
(if (not (file-readable-p src))
(mua/warn "Cannot move unreadable file %s" src)
(let ((argl '("mv" "--printtarget")))
(when flags (add-to-list 'argl (concat "--flags="
(mua/msg-file-flags-to-string flags)) t))
(add-to-list 'argl src t)
(when target (add-to-list 'argl target t))
(let* ((rv (apply 'mua/mu-run argl))
(code (car rv)) (output (cdr rv)))
;; we ignore the error where the target file already exists, as it is
;; likely due to the database not being fully up-to-date and/or sync'ed
;; with what we have on the screen
(if (not (member code `(0 ,mu-error-file-target-equals-source)))
(mua/warn "Moving message file failed: %s" (if output output "error"))
(substring output 0 -1)))))) ;; the full target path, minus the \n
(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

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

@ -59,9 +59,9 @@ commands (navigation, marking etc.) to be applied to this
buffer. buffer.
For the reasoning to use UID here instead of just the path, see For the reasoning to use UID here instead of just the path, see
`mua/msg-file-map'. `mua/msg-map'.
" "
(let* ((path (mua/msg-file-get-path uid)) (let* ((path (mua/msg-map-get-path uid))
(sexp (and path (mua/mu-view-sexp path))) (sexp (and path (mua/mu-view-sexp path)))
(msg (and sexp (mua/msg-from-string sexp)))) (msg (and sexp (mua/msg-from-string sexp))))
(if (not msg) (if (not msg)
@ -78,9 +78,11 @@ For the reasoning to use UID here instead of just the path, see
mua/view-uid uid mua/view-uid uid
mua/hdrs-buffer headersbuf mua/hdrs-buffer headersbuf
mua/parent-buffer headersbuf) mua/parent-buffer headersbuf)
;; mark as read
(goto-char (point-min)) (unless (mua/msg-move uid nil "+S-N" t)
(mua/msg-file-mark-as-read uid))))) (mua/warn "Failed to mark message as read"))))))
(defun mua/view-message (msg) (defun mua/view-message (msg)
"construct a display string for the message" "construct a display string for the message"