mirror of https://github.com/djcb/mu.git
* mua updates
This commit is contained in:
parent
a84d72e7cf
commit
43b1edbbe5
|
@ -53,8 +53,8 @@
|
|||
"*internal* The mu-find process.")
|
||||
(defvar mua/hdrs-hash nil
|
||||
"*internal* The bol->uid hash.")
|
||||
(defvar mua/hdrs-marks-hash nil
|
||||
"*internal* The hash for marked messages.")
|
||||
|
||||
|
||||
|
||||
(defconst mua/eom "\n;;eom\n"
|
||||
"*internal* Marker for the end of message in the mu find
|
||||
|
@ -191,8 +191,8 @@
|
|||
|
||||
(defun mua/hdrs-set-path (path)
|
||||
"Map the bol of the current header to an entry in
|
||||
`mua/msg-file-map', and return the uid"
|
||||
(let ((uid (mua/msg-file-register path)))
|
||||
`mua/msg-map', and return the uid."
|
||||
(let ((uid (mua/msg-map-add path)))
|
||||
(puthash (line-beginning-position 1) uid mua/hdrs-hash)
|
||||
uid))
|
||||
|
||||
|
@ -202,9 +202,7 @@
|
|||
|
||||
(defun mua/hdrs-get-path ()
|
||||
"Get the current path for the header at point."
|
||||
(let ((uid (mua/hdrs-get-uid)))
|
||||
(mua/msg-file-get-path uid)))
|
||||
|
||||
(mua/msg-map-get-path (mua/hdrs-get-uid)))
|
||||
|
||||
(defun mua/hdrs-append-message (msg)
|
||||
"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 ()
|
||||
"Change thee sort field and direction."
|
||||
"Change thee sort field and dirtrection."
|
||||
(interactive)
|
||||
(and (call-interactively 'mua/hdrs-change-sort-order)
|
||||
(call-interactively 'mua/hdrs-change-sort-direction)))
|
||||
|
@ -379,48 +377,89 @@ if the search process is not already running"
|
|||
|
||||
;;; functions for marking
|
||||
|
||||
(defun mua/hdrs-add-marked (uid &optional dst)
|
||||
"Add the message at point to the markings hash"
|
||||
(let ((bol (line-beginning-position 1)))
|
||||
(if (gethash bol mua/hdrs-marks-hash)
|
||||
(mua/warn "Message is already marked")
|
||||
(progn (puthash bol (cons uid dst) mua/hdrs-marks-hash) t))))
|
||||
(defvar mua/hdrs-marks-hash nil
|
||||
"*internal* The hash for marked messages. The hash maps
|
||||
bol (beginning-of-line) to a 3-tuple: [UID TARGET FLAGS], where UID is the
|
||||
the UID of the message file (see `mua/msg-map'), TARGET is the
|
||||
target maildir (ie., \"/inbox\", but can also be nil (for 'delete);
|
||||
and finally FLAGS is the flags to set when the message is moved.")
|
||||
|
||||
(defun mua/hdrs-remove-marked ()
|
||||
"Remove the message at point from the markings hash"
|
||||
(let ((bol (line-beginning-position 1)))
|
||||
(if (not (gethash bol mua/hdrs-marks-hash))
|
||||
(mua/warn "Message is not marked")
|
||||
(progn (remhash bol mua/hdrs-marks-hash) t))))
|
||||
(defun mua/hdrs-set-mark-ui (bol action)
|
||||
"Display (or undisplay) the mark for BOL for action ACTION."
|
||||
(unless (member action '(delete trash move unmark))
|
||||
(error "Invalid action %S" action))
|
||||
(save-excursion
|
||||
(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)
|
||||
"Mark the message at point with one of the symbols: move,
|
||||
delete, trash, unmark, unmark-all; the latter two are
|
||||
pseudo-markings."
|
||||
(let ((uid (mua/hdrs-get-uid)))
|
||||
"Mark the message at point BOL (the beginning of the line) with
|
||||
one of the symbols: move, delete, trash, unmark, unmark-all; the
|
||||
latter two are pseudo-markings."
|
||||
(let* ((bol (line-beginning-position 1)) (uid (mua/hdrs-get-uid)))
|
||||
(when uid
|
||||
(case action
|
||||
(move
|
||||
(when (mua/hdrs-add-marked uid
|
||||
(mua/ask-maildir "Target maildir: " t)) ;; t->return fullpath
|
||||
(mua/hdrs-set-marker ?m)))
|
||||
(mua/hdrs-set-mark bol uid (mua/ask-maildir "Target maildir: " t)))
|
||||
(trash
|
||||
(when (mua/hdrs-add-marked uid
|
||||
(concat mua/maildir mua/trash-folder))
|
||||
(mua/hdrs-set-marker ?d)))
|
||||
(if (member 'trashed (mua/msg-flags-from-path (mua/hdrs-get-path)))
|
||||
(mua/warn "Message is already trashed")
|
||||
(mua/hdrs-set-mark bol uid (concat mua/maildir mua/trash-folder) "+T")))
|
||||
(delete
|
||||
(when (mua/hdrs-add-marked uid "/dev/null")
|
||||
(mua/hdrs-set-marker ?D)))
|
||||
(mua/hdrs-set-mark bol action uid "/dev/null"))
|
||||
(unmark
|
||||
(when (mua/hdrs-remove-marked)
|
||||
(mua/hdrs-set-marker nil)))
|
||||
(mua/hdrs-remove-mark bol))
|
||||
(unmark-all
|
||||
(when (y-or-n-p (format "Sure you want to remove all (%d) marks? "
|
||||
(hash-table-count mua/hdrs-marks-hash)))
|
||||
|
@ -430,28 +469,6 @@ pseudo-markings."
|
|||
(t (error "Unsupported mark type")))
|
||||
(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
|
||||
|
|
|
@ -31,7 +31,7 @@
|
|||
(eval-when-compile (require 'cl))
|
||||
|
||||
|
||||
(defvar mua/msg-file-map nil
|
||||
(defvar mua/msg-map nil
|
||||
"*internal* a map of uid->message.
|
||||
|
||||
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).
|
||||
|
||||
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
|
||||
in `mua/msg-file-move', which will update the map after the
|
||||
moving (using `mua/msg-file-update')
|
||||
in `mua/msg-move', which will update the map after the
|
||||
moving (using `mua/msg-map-update')
|
||||
|
||||
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)
|
||||
"Register a message PATH in the `mua/msg-file-map', and return
|
||||
the uid for it."
|
||||
(unless mua/msg-file-map
|
||||
(setq mua/msg-file-map (make-hash-table :size 256 :rehash-size 2)))
|
||||
(defun mua/msg-map-add (path)
|
||||
"Add a message PATH to the `mua/msg-map', and return the uid
|
||||
for it."
|
||||
(unless mua/msg-map
|
||||
(setq mua/msg-map (make-hash-table :size 256 :rehash-size 2 :weakness t)))
|
||||
(let ((uid (sha1 path)))
|
||||
(puthash uid path mua/msg-file-map)
|
||||
(puthash uid path mua/msg-map)
|
||||
uid))
|
||||
|
||||
(defun mua/msg-file-update (uid path)
|
||||
"Set the new path for the message identified by UID to
|
||||
PATH."
|
||||
(if (gethash uid mua/msg-file-map)
|
||||
(puthash uid path mua/msg-file-map)
|
||||
(defun mua/msg-map-update (uid path)
|
||||
"Set the new path for the message identified by UID to PATH."
|
||||
(if (gethash uid mua/msg-map)
|
||||
(puthash uid path mua/msg-map)
|
||||
(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."
|
||||
(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
|
||||
update the database with the new situation. SRC must be the full,
|
||||
absolute path to a message file, while TARGETDIR must be a
|
||||
maildir - that is, the part _without_ cur/ or new/. 'mu mv' will
|
||||
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'
|
||||
and/or 'mu add' are invoked asynchronously to update the database
|
||||
with the changes.
|
||||
|
||||
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 g, as
|
||||
defined in [1]. See `mua/msg-file-string-to-flags' and
|
||||
`mua/msg-file-flags-to-string'.
|
||||
Optionally, you can specify the FLAGS for the new file. The FLAGS
|
||||
parameter can have the following forms:
|
||||
1. a list of flags such as '(passed replied seen)
|
||||
2. a string containing the one-char versions of the flags, e.g. \"PRS\"
|
||||
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
|
||||
move, the database will be updated as well, using the 'mu add'
|
||||
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
|
||||
`nil'.
|
||||
nil.
|
||||
|
||||
\[1\] http://cr.yp.to/proto/maildir.html."
|
||||
(let ((src (mua/msg-file-get-path uid)))
|
||||
(unless src (error "Source path not registered."))
|
||||
(let ((fulltarget (mua/mu-mv src targetdir flags)))
|
||||
(when (and fulltarget (not (string= src fulltarget)))
|
||||
(mua/msg-file-update uid fulltarget) ;; update the path
|
||||
(mua/mu-remove-async src)
|
||||
(unless (string= targetdir "/dev/null")
|
||||
(mua/mu-add-async fulltarget)))))
|
||||
t)
|
||||
|
||||
\[1\] URL `http://cr.yp.to/proto/maildir.html'."
|
||||
(condition-case err
|
||||
(let ((src (mua/msg-map-get-path uid)))
|
||||
(unless src (error "Source path not registered for %S" uid))
|
||||
(unless (or targetdir src) (error "Either targetdir or flags required"))
|
||||
(unless (file-readable-p src) (error "Source is unreadable (%S)" src))
|
||||
(let* ((flagstr
|
||||
(if (stringp flags) flags (mua/msg-flags-to-string flags)))
|
||||
(argl (append ;; build-up the command line
|
||||
'("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)
|
||||
"Mark the message identified by UID 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* ((path (mua/msg-file-get-path uid))
|
||||
(flags (and path (mua/msg-file-flags-from-path path))))
|
||||
(when (or (member 'new flags) (not (member 'seen flags)))
|
||||
(let* ((newflags (delq 'new (cons 'seen flags)))
|
||||
(target (mua/msg-file-maildir-from-path path t)))
|
||||
(unless (mua/msg-file-move-uid uid target newflags)
|
||||
(mua/warn "Failed to mark message as read"))))))
|
||||
(when (and targetpath (not (string= src targetpath)))
|
||||
;; update the UID-map
|
||||
(mua/msg-map-update uid targetpath)
|
||||
;; remove the src file
|
||||
(mua/mu-remove-async src)
|
||||
;; and add the target file, unless it's dead now
|
||||
(unless (string= targetdir "/dev/null")
|
||||
(mua/mu-add-async targetpath)))
|
||||
t)))
|
||||
|
||||
(error (mua/warn "error: %s" (error-message-string err)))))
|
||||
|
||||
|
||||
(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.
|
||||
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/msg-file-string-to-flags'
|
||||
and `mua/msg-file-flags-to-string'.
|
||||
and Trash, as defined in [1]. See `mua/msg-string-to-flags'
|
||||
and `mua/msg-flags-to-string'.
|
||||
\[1\] http://cr.yp.to/proto/maildir.html."
|
||||
(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
|
||||
part between the `mua/maildir' and the /cur or /new; so
|
||||
e.g. \"/home/user/Maildir/foo/bar/cur/12345:2,S\" would have
|
||||
|
@ -151,23 +167,21 @@ determined, return `nil'."
|
|||
mdir
|
||||
(substring mdir (length mua/maildir)))))))
|
||||
|
||||
|
||||
|
||||
(defun mua/msg-file-flags-to-string (flags)
|
||||
"Remove duplicates and sort the output of `mua/msg-file-flags-to-string-1'"
|
||||
(defun mua/msg-flags-to-string (flags)
|
||||
"Remove duplicates and sort the output of `mua/msg-flags-to-string-1'."
|
||||
(concat
|
||||
(sort
|
||||
(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
|
||||
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/msg-file-string-to-flags'.
|
||||
Also see `mua/msg-string-to-flags'.
|
||||
|
||||
\[1\]: http://cr.yp.to/proto/maildir.html"
|
||||
(when flags
|
||||
|
@ -180,20 +194,20 @@ Also see `mua/msg-file-string-to-flags'.
|
|||
('seen ?S)
|
||||
('trashed ?T))))
|
||||
(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)
|
||||
"Remove duplicates from the output of `mua/msg-file-string-to-flags-1'"
|
||||
(remove-duplicates (mua/msg-file-string-to-flags-1 str)))
|
||||
(defun mua/msg-string-to-flags (str)
|
||||
"Remove duplicates from the output of `mua/msg-string-to-flags-1'"
|
||||
(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
|
||||
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/msg-file-flags-to-string'.
|
||||
Also see `mua/msg-flags-to-string'.
|
||||
|
||||
\[1\]: http://cr.yp.to/proto/maildir.html"
|
||||
(when (/= 0 (length str))
|
||||
|
@ -206,6 +220,6 @@ Also see `mua/msg-file-flags-to-string'.
|
|||
(?S 'seen)
|
||||
(?T 'trashed))))
|
||||
(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)
|
||||
|
|
|
@ -94,7 +94,7 @@ or if not available, :body-html converted to text)."
|
|||
(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/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))))
|
||||
|
||||
|
||||
|
@ -334,7 +334,7 @@ body from headers)."
|
|||
(mua/msg-header "Subject" "")
|
||||
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
|
||||
with non-mua-generated messages")
|
||||
|
||||
|
@ -343,7 +343,7 @@ with non-mua-generated messages")
|
|||
message.
|
||||
[1]: see http://cr.yp.to/proto/maildir.html"
|
||||
(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))
|
||||
(emacs-pid)
|
||||
(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"))
|
||||
(let* ;; TODO: remove duplicate flags
|
||||
((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
|
||||
;; uid is referring to
|
||||
(uid (mua/msg-file-register (buffer-file-name)))
|
||||
(uid (mua/msg-register (buffer-file-name)))
|
||||
(if (mua/msg-move uid
|
||||
(concat mua/maildir mua/sent-folder)
|
||||
(mua/msg-file-flags-to-string newflags))
|
||||
(set-visited-file-name (mua/msg-file-get-path uid) t t)
|
||||
(mua/msg-flags-to-string newflags))
|
||||
(set-visited-file-name (mua/msg-get-path uid) t t)
|
||||
(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'."
|
||||
;; handle the replied-to message
|
||||
(when mua/msg-reply-uid
|
||||
(let* ((oldflags (mua/msg-file-flags-from-path (mua/msg-file-get-path uid)))
|
||||
(newflags (cons 'replied oldflags)))
|
||||
(mua/msg-file-move uid nil newflags)))
|
||||
(unless (mua/msg-move mua/msg-reply-uid nil "+R")
|
||||
(mua/warn "Failed to marked parent message as 'Replied'")))
|
||||
|
||||
;; handle the forwarded message
|
||||
(when mua/msg-forward-uid
|
||||
(let* ((oldflags (mua/msg-file-flags-from-path (mua/msg-file-get-path uid)))
|
||||
(newflags (cons 'passed oldflags)))
|
||||
(mua/msg-file-move uid nil newflags))))
|
||||
|
||||
|
||||
(unless (mua/msg-move mua/msg-forward-uid nil "+P")
|
||||
(mua/warn "Failed to marked parent message as 'Passed'"))))
|
||||
|
||||
|
||||
;; 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-or-passed-flag)
|
||||
|
|
|
@ -59,52 +59,6 @@ to get it"
|
|||
(match-string 1 (cdr rv))
|
||||
(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)
|
||||
"Return a string with an s-expression representing the message
|
||||
|
|
|
@ -59,9 +59,9 @@ commands (navigation, marking etc.) to be applied to this
|
|||
buffer.
|
||||
|
||||
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)))
|
||||
(msg (and sexp (mua/msg-from-string sexp))))
|
||||
(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/hdrs-buffer headersbuf
|
||||
mua/parent-buffer headersbuf)
|
||||
|
||||
(goto-char (point-min))
|
||||
(mua/msg-file-mark-as-read uid)))))
|
||||
;; mark as read
|
||||
(unless (mua/msg-move uid nil "+S-N" t)
|
||||
(mua/warn "Failed to mark message as read"))))))
|
||||
|
||||
|
||||
|
||||
(defun mua/view-message (msg)
|
||||
"construct a display string for the message"
|
||||
|
|
Loading…
Reference in New Issue