* mua updates
This commit is contained in:
Dirk-Jan C. Binnema
@ -30,6 +30,8 @@
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(require 'ido)
|
||||
|
||||
(defconst mua/log-buffer-name "*mua-log*" "name of the logging buffer")
|
||||
|
||||
(defun mua/warn (frm &rest args)
|
||||
@ -82,79 +84,5 @@ maildir."
|
||||
(chosen (ido-completing-read prompt showfolders)))
|
||||
(concat (if fullpath mua/maildir "") chosen)))
|
||||
|
||||
(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
|
||||
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))))
|
||||
|
||||
|
||||
|
||||
(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,
|
||||
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)
|
||||
('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)
|
||||
(?P 'passed)
|
||||
(?R 'replied)
|
||||
(?S 'seen)
|
||||
(?T 'trashed))))
|
||||
(append (when flag (list flag))
|
||||
(mua/maildir-string-to-flags (substring str 1))))))
|
||||
|
||||
(provide 'mua-common)
|
||||
|
||||
@ -51,15 +51,15 @@
|
||||
(defvar mua/hdrs-hash nil "the bol->path hash")
|
||||
(defvar mua/hdrs-marks-hash nil "the hash for marked messages")
|
||||
|
||||
(defconst mua/eom "\n;;eom\n" "marker for the end of message in
|
||||
the mu find output")
|
||||
(defconst mua/eom "\n;;eom\n" "*internal* Marker for the end of message in
|
||||
the mu find output.")
|
||||
(defconst mua/hdrs-buffer-name "*mua-headers*"
|
||||
"name of the mua headers buffer")
|
||||
"*internal* Name of the mua headers buffer.")
|
||||
|
||||
(defun mua/hdrs-proc-filter (proc str)
|
||||
"process-filter for the 'mu find --format=sexp output; it
|
||||
"A process-filter for the 'mu find --format=sexp output; it
|
||||
accumulates the strings into valid sexps by checking of the
|
||||
';;eom' end-of-msg marker, and then evaluating them"
|
||||
';;eom' end-of-msg marker, and then evaluating them."
|
||||
(let ((procbuf (process-buffer proc)))
|
||||
(when (buffer-live-p procbuf)
|
||||
(with-current-buffer procbuf
|
||||
@ -73,7 +73,7 @@ the mu find output")
|
||||
(setq eom (string-match mua/eom mua/buf))))))))))
|
||||
|
||||
(defun mua/hdrs-proc-sentinel (proc msg)
|
||||
"Check the process upon completion"
|
||||
"Check the process upon completion."
|
||||
(let ((procbuf (process-buffer proc))
|
||||
(status (process-status proc))
|
||||
(exit-status (process-exit-status proc)))
|
||||
@ -89,7 +89,7 @@ the mu find output")
|
||||
(with-current-buffer procbuf
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(mua/message msg)))))))
|
||||
(mua/message "%s" msg)))))))
|
||||
|
||||
(defun mua/hdrs-search-execute (expr buf)
|
||||
"search in the mu database; output the results in buffer BUF"
|
||||
@ -100,8 +100,7 @@ the mu find output")
|
||||
(add-to-list args (concat "--sortfield=" mua/hdrs-sortfield)))
|
||||
(when mua/hdrs-sort-descending
|
||||
(add-to-list args "--descending"))
|
||||
(mua/log (concat mua/mu-binary " find " expr
|
||||
(mapconcat 'identity args " ")))
|
||||
(mua/log (concat mua/mu-binary " " (mapconcat 'identity args " ")))
|
||||
;; now, do it!
|
||||
(let ((proc (apply 'start-process "*mua-headers*" buf mua/mu-binary args)))
|
||||
(setq
|
||||
@ -147,7 +146,7 @@ the mu find output")
|
||||
(make-local-variable 'mua/hdrs-marks-hash)
|
||||
|
||||
(setq
|
||||
major-mode 'mua/mua-hdrs-mode mode-name "*mua-headers*"
|
||||
major-mode 'mua/mua/hdrs-mode mode-name "*mua-headers*"
|
||||
truncate-lines t buffer-read-only t
|
||||
overwrite-mode 'overwrite-mode-binary))
|
||||
|
||||
@ -185,12 +184,21 @@ the mu find output")
|
||||
;;
|
||||
|
||||
(defun mua/hdrs-set-path (path)
|
||||
"map the bol of the current header to a path"
|
||||
(puthash (line-beginning-position 1) path mua/hdrs-hash))
|
||||
"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)))
|
||||
(puthash (line-beginning-position 1) uid mua/hdrs-hash)
|
||||
uid))
|
||||
|
||||
(defun mua/hdrs-get-uid ()
|
||||
"Get the uid for the message header at point."
|
||||
(gethash (line-beginning-position 1) mua/hdrs-hash))
|
||||
|
||||
(defun mua/hdrs-get-path ()
|
||||
"get the path for the header at point"
|
||||
(gethash (line-beginning-position 1) mua/hdrs-hash))
|
||||
"Get the current path for the header at point."
|
||||
(let ((uid (mua/hdrs-get-uid)))
|
||||
(mua/msg-file-get-path uid)))
|
||||
|
||||
|
||||
(defun mua/hdrs-append-message (msg)
|
||||
"append a message line to the buffer and register the message"
|
||||
@ -309,9 +317,9 @@ fitting in WIDTH"
|
||||
|
||||
(defun mua/hdrs-view ()
|
||||
(interactive)
|
||||
(let ((path (mua/hdrs-get-path)))
|
||||
(if path
|
||||
(mua/view path (current-buffer))
|
||||
(let ((uid (mua/hdrs-get-uid)))
|
||||
(if uid
|
||||
(mua/view uid (current-buffer))
|
||||
(mua/warn "No message at point"))))
|
||||
|
||||
(defun mua/hdrs-jump-to-maildir ()
|
||||
@ -365,12 +373,12 @@ if the search process is not already running"
|
||||
|
||||
;;; functions for marking
|
||||
|
||||
(defun mua/hdrs-add-marked (src &optional dst)
|
||||
(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 src dst) mua/hdrs-marks-hash) t))))
|
||||
(progn (puthash bol (cons uid dst) mua/hdrs-marks-hash) t))))
|
||||
|
||||
(defun mua/hdrs-remove-marked ()
|
||||
"Remove the message at point from the markings hash"
|
||||
@ -390,19 +398,19 @@ if the search process is not already running"
|
||||
"Mark the message at point with one of the symbols: move,
|
||||
delete, trash, unmark, unmark-all; the latter two are
|
||||
pseudo-markings."
|
||||
(let ((target) (src (mua/hdrs-get-path)))
|
||||
(when src
|
||||
(let ((uid (mua/hdrs-get-uid)))
|
||||
(when uid
|
||||
(case action
|
||||
(move
|
||||
(when (mua/hdrs-add-marked src
|
||||
(when (mua/hdrs-add-marked uid
|
||||
(mua/ask-maildir "Target maildir: " t)) ;; t->return fullpath
|
||||
(mua/hdrs-set-marker ?m)))
|
||||
(trash
|
||||
(when (mua/hdrs-add-marked src
|
||||
(when (mua/hdrs-add-marked uid
|
||||
(concat mua/maildir mua/trash-folder))
|
||||
(mua/hdrs-set-marker ?d)))
|
||||
(delete
|
||||
(when (mua/hdrs-add-marked src "/dev/null")
|
||||
(when (mua/hdrs-add-marked uid "/dev/null")
|
||||
(mua/hdrs-set-marker ?D)))
|
||||
(unmark
|
||||
(when (mua/hdrs-remove-marked)
|
||||
@ -427,12 +435,10 @@ pseudo-markings."
|
||||
(save-excursion
|
||||
(maphash
|
||||
(lambda(bol v)
|
||||
(let* ((src (car v)) (target (cdr v)) (inhibit-read-only t)
|
||||
(newpath (mua/msg-move src target)))
|
||||
(when newpath
|
||||
(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...
|
||||
(mua/hdrs-set-path newpath)
|
||||
(goto-char bol)
|
||||
(mua/hdrs-remove-marked)
|
||||
(put-text-property (line-beginning-position 1)
|
||||
@ -446,20 +452,23 @@ pseudo-markings."
|
||||
(defun mua/hdrs-reply ()
|
||||
"Reply to message at point."
|
||||
(interactive)
|
||||
(let* ((path (mua/hdrs-get-path))
|
||||
(let* ((uid (mua/hdrs-get-uid))
|
||||
(path (mua/hdrs-get-path))
|
||||
(str (when path (mua/mu-view-sexp path)))
|
||||
(msg (and str (mua/msg-from-string str))))
|
||||
(if msg
|
||||
(mua/msg-reply msg)
|
||||
(mua/msg-reply msg uid)
|
||||
(mua/warn "No message at point"))))
|
||||
|
||||
(defun mua/hdrs-forward ()
|
||||
(defun mua/hdrs-for ()
|
||||
"Forward the message at point."
|
||||
(interactive)
|
||||
(let* ((path (mua/hdrs-get-path))
|
||||
(msg (when path (mua/msg-from-path path))))
|
||||
(let* ((uid (mua/hdrs-get-uid))
|
||||
(path (mua/hdrs-get-path))
|
||||
(str (when path (mua/mu-view-sexp path)))
|
||||
(msg (and str (mua/msg-from-string str))))
|
||||
(if msg
|
||||
(mua/msg-forward msg)
|
||||
(mua/msg-reply msg uid)
|
||||
(mua/warn "No message at point"))))
|
||||
|
||||
(defun mua/hdrs-compose ()
|
||||
|
||||
211
toys/mua/mua-msg-file.el
Normal file
211
toys/mua/mua-msg-file.el
Normal file
@ -0,0 +1,211 @@
|
||||
;;; mua-msg.el -- part of mua, the mu mail user agent
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mua
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
|
||||
(defvar mua/msg-file-map nil
|
||||
"*internal* a map of uid->message.
|
||||
|
||||
This map adds a level of indirection for message files; many
|
||||
actions (such moving, responding to or even reading a message)
|
||||
cause the file names to change. Here we map the initial file to a
|
||||
uid, the latter which stays constant over the lifetime of a
|
||||
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'.
|
||||
|
||||
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')
|
||||
|
||||
Other places of the code can use the uid to get the *current*
|
||||
path of the file using `mua/msg-file-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)))
|
||||
(let ((uid (sha1 path)))
|
||||
(puthash uid path mua/msg-file-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)
|
||||
(mua/warn "No message file registered for uid")))
|
||||
|
||||
(defun mua/msg-file-get-path (uid)
|
||||
"Get the current path for the message identified by UID."
|
||||
(gethash uid mua/msg-file-map))
|
||||
|
||||
(defun mua/msg-file-move-uid (uid targetdir &optional flags)
|
||||
"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.
|
||||
|
||||
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'.
|
||||
|
||||
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.
|
||||
|
||||
Function returns t the move succeeds, in other cases, it returns
|
||||
`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)
|
||||
|
||||
|
||||
(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"))))))
|
||||
|
||||
|
||||
(defun mua/msg-file-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'.
|
||||
\[1\] http://cr.yp.to/proto/maildir.html."
|
||||
(when (string-match ",\\(\[A-Z\]*\\)$" path)
|
||||
(mua/msg-file-string-to-flags (match-string 1 path))))
|
||||
|
||||
|
||||
(defun mua/msg-file-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)))))))
|
||||
|
||||
|
||||
|
||||
(defun mua/msg-file-flags-to-string (flags)
|
||||
"Remove duplicates and sort the output of `mua/msg-file-flags-to-string-1'"
|
||||
(concat
|
||||
(sort
|
||||
(remove-duplicates
|
||||
(append (mua/msg-file-flags-to-string-1 flags) nil)) '>)))
|
||||
|
||||
(defun mua/msg-file-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'.
|
||||
|
||||
\[1\]: http://cr.yp.to/proto/maildir.html"
|
||||
(when flags
|
||||
(let ((kar
|
||||
(case (car flags)
|
||||
('draft ?D)
|
||||
('flagged ?F)
|
||||
('passed ?P)
|
||||
('replied ?R)
|
||||
('seen ?S)
|
||||
('trashed ?T))))
|
||||
(concat (and kar (string kar))
|
||||
(mua/msg-file-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-file-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'.
|
||||
|
||||
\[1\]: http://cr.yp.to/proto/maildir.html"
|
||||
(when (/= 0 (length str))
|
||||
(let ((flag
|
||||
(case (string-to-char str)
|
||||
(?D 'draft)
|
||||
(?F 'flagged)
|
||||
(?P 'passed)
|
||||
(?R 'replied)
|
||||
(?S 'seen)
|
||||
(?T 'trashed))))
|
||||
(append (when flag (list flag))
|
||||
(mua/msg-file-string-to-flags-1 (substring str 1))))))
|
||||
|
||||
(provide 'mua-msg-file)
|
||||
@ -94,38 +94,9 @@ 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/maildir-from-path (mua/msg-field msg :path))))
|
||||
(mua/msg-file-maildir-from-path (mua/msg-field msg :path))))
|
||||
(t (plist-get msg field))))
|
||||
|
||||
|
||||
(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
|
||||
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 list consisting of one or more of DFNPRST, mean
|
||||
resp. Deleted, Flagged, New, Passed Replied, Seen and g, as
|
||||
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'
|
||||
and 'mu remove' commands.
|
||||
|
||||
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 ((fulltarget (mua/mu-mv src targetdir flags)))
|
||||
(when fulltarget
|
||||
(mua/mu-remove-async src)
|
||||
(unless (string= targetdir "/dev/null")
|
||||
(mua/mu-add-async fulltarget)))
|
||||
fulltarget))
|
||||
|
||||
|
||||
;; functions for composing new messages (forward, reply and new)
|
||||
|
||||
@ -378,10 +349,13 @@ message.
|
||||
(random t)
|
||||
(replace-regexp-in-string "[:/]" "_" (system-name))))
|
||||
|
||||
(defvar mua/msg-reply-uid nil "UID of the message this is a reply to.")
|
||||
(defvar mua/msg-forward-uid nil "UID of the message being forwarded.")
|
||||
|
||||
(defun mua/msg-compose (str)
|
||||
"Create a new draft message in the drafts folder with STR as
|
||||
its contents, and open this message file for editing
|
||||
its contents, and open this message file for editing. Optionally
|
||||
specify PARENT-UID,
|
||||
|
||||
The name of the draft folder is constructed from the concatenation of
|
||||
`mua/maildir' and `mua/drafts-folder' (therefore, these must be set).
|
||||
@ -399,14 +373,15 @@ using Gnus' `message-mode'."
|
||||
(let ((draftfile (concat mua/maildir "/" mua/drafts-folder "/cur/"
|
||||
(mua/msg-draft-file-name))))
|
||||
(with-temp-file draftfile (insert str))
|
||||
(find-file draftfile)
|
||||
(rename-buffer mua/msg-draft-name t)
|
||||
(find-file draftfile) (rename-buffer mua/msg-draft-name t)
|
||||
(message-mode)
|
||||
(make-local-variable 'mua/msg-forward-uid)
|
||||
|
||||
(message-goto-body)))
|
||||
|
||||
(defun mua/msg-reply (msg)
|
||||
(defun mua/msg-reply (msg &optional reply-uid)
|
||||
"Create a draft reply to MSG, and swith to an edit buffer with
|
||||
the draft message."
|
||||
the draft message. PARENT-UID refers to the UID of the message wer"
|
||||
(let* ((recipnum (+ (length (mua/msg-field msg :to))
|
||||
(length (mua/msg-field msg :cc))))
|
||||
(replyall (when (> recipnum 1)
|
||||
@ -414,12 +389,14 @@ the draft message."
|
||||
(+ recipnum))))))
|
||||
;; exact num depends on some more things
|
||||
(when (mua/msg-compose (mua/msg-create-reply msg replyall))
|
||||
(when reply-uid (setq mua/msg-reply-uid reply-uid))
|
||||
(message-goto-body))))
|
||||
|
||||
(defun mua/msg-forward (msg)
|
||||
(defun mua/msg-forward (msg &optional forward-uid)
|
||||
"Create a draft forward for MSG, and swith to an edit buffer with
|
||||
the draft message."
|
||||
(when (mua/msg-compose (mua/msg-create-forward msg))
|
||||
(when forward-uid (setq mua/msg-forward-uid forward-uid))
|
||||
(message-goto-to)))
|
||||
|
||||
(defun mua/msg-compose-new ()
|
||||
@ -430,16 +407,6 @@ draft message."
|
||||
|
||||
|
||||
|
||||
(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
|
||||
message-mode to ensure we only do things with mua-generated
|
||||
messages (mua is not the only user of `message-mode' after all)"
|
||||
(let* ((fname (buffer-file-name))
|
||||
(match (and fname (string-match mua/msg-file-prefix fname))))
|
||||
(and (numberp match) (= 0 match))))
|
||||
;; we simply check if file starts with `mu-msg-file-prefix'
|
||||
|
||||
(defun mua/msg-save-to-sent ()
|
||||
"Move the message in this buffer to the sent folder. This is
|
||||
meant to be called from message mode's `message-sent-hook'."
|
||||
@ -447,33 +414,43 @@ 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/maildir-flags-from-path (buffer-file-name))))
|
||||
(sent-msg
|
||||
(mua/msg-move (buffer-file-name)
|
||||
(concat mua/maildir mua/sent-folder) ;; mua-sent-folder is only eg. "/sent"
|
||||
(mua/maildir-flags-to-string newflags))))
|
||||
(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")))))
|
||||
(delq 'draft (mua/msg-file-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)))
|
||||
(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/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. This is meant to be called from message mode's
|
||||
(defun mua/msg-set-replied-or-passed-flag ()
|
||||
"Set the 'replied' flag on messages we replied to, and the
|
||||
'passed' flag on message we have forwarded. This uses
|
||||
`mua/msg-reply-uid' and `mua/msg-forward-uid', repectively.
|
||||
|
||||
NOTE: This does not handle the case yet of message which are
|
||||
edited from drafts. That case could be solved by searching for
|
||||
the In-Reply-To message-id for replies.
|
||||
|
||||
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 ;; TODO: check we only get one msgid back
|
||||
"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))))))
|
||||
;; 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)))
|
||||
;; 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))))
|
||||
|
||||
|
||||
;; 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)
|
||||
(add-hook 'message-sent-hook 'mua/msg-set-replied-or-passed-flag)
|
||||
|
||||
|
||||
(provide 'mua-msg)
|
||||
|
||||
@ -59,36 +59,53 @@ 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 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.
|
||||
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.
|
||||
|
||||
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'.
|
||||
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."
|
||||
(let ((flagstr
|
||||
(and flags (mua/maildir-flags-to-string flags))))
|
||||
|
||||
;; 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* ((rv (if flagstr
|
||||
(mua/mu-run "mv" "--printtarget"
|
||||
(concat "--flags=" flagstr) src target)
|
||||
(mua/mu-run "mv" "--printtarget" src target)))
|
||||
(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)))
|
||||
(if (/= 0 code)
|
||||
;; 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
|
||||
at PATH; the format is described in `mua/msg-from-string', and
|
||||
@ -198,36 +215,38 @@ them."
|
||||
(defconst mu-error-file-stat-failed 77)
|
||||
(defconst mu-error-file-readdir-failed 78)
|
||||
(defconst mu-error-file-invalid-source 79)
|
||||
(defconst mu-error-file-target-equals-source 80)
|
||||
|
||||
|
||||
(defun mua/mu-error (err)
|
||||
"Convert an exit code from mu into a string."
|
||||
(case err
|
||||
(mu-error "General error")
|
||||
(mu-error-in-parameters "Error in parameters")
|
||||
(mu-error-internal "Internal error")
|
||||
(mu-error-no-matches "No matches")
|
||||
(mu-error-xapian "Xapian error")
|
||||
(mu-error-xapian-query "Error in query")
|
||||
(mu-error-xapian-dir-not-accessible "Database dir is not accessible")
|
||||
(mu-error-xapian-not-up-to-date "Database is not up-to-date")
|
||||
(mu-error-xapian-missing-data "Missing data")
|
||||
(mu-error-xapian-corruption "Database seems to be corrupted")
|
||||
(mu-error-xapian-cannot-get-writelock "Database is locked")
|
||||
(mu-error-gmime "GMime-related error")
|
||||
(mu-error-contacts "Contacts-related error")
|
||||
(mu-error-contacts-cannot-retrieve "Failed to retrieve contacts-cache")
|
||||
(mu-error-file "File error")
|
||||
(mu-error-file-invalid-name "Invalid file name")
|
||||
(mu-error-file-cannot-link "Failed to link file")
|
||||
(mu-error-file-cannot-open "Cannot open file")
|
||||
(mu-error-file-cannot-read "Cannot read file")
|
||||
(mu-error-file-cannot-create "Cannot create file")
|
||||
(mu-error-file-cannot-mkdir "mu-mkdir failed")
|
||||
(mu-error-file-stat-failed "stat(2) failed")
|
||||
(mu-error-file-readdir-failed "readdir failed")
|
||||
(mu-error-file-invalid-source "Invalid source file")
|
||||
(t "Unknown error")))
|
||||
(cond
|
||||
((eql err mu-error) "General error")
|
||||
((eql err mu-error-in-parameters) "Error in parameters")
|
||||
((eql err mu-error-internal) "Internal error")
|
||||
((eql err mu-error-no-matches) "No matches")
|
||||
((eql err mu-error-xapian) "Xapian error")
|
||||
((eql err mu-error-xapian-query) "Error in query")
|
||||
((eql err mu-error-xapian-dir-not-accessible) "Database dir not accessible")
|
||||
((eql err mu-error-xapian-not-up-to-date) "Database is not up-to-date")
|
||||
((eql err mu-error-xapian-missing-data) "Missing data")
|
||||
((eql err mu-error-xapian-corruption) "Database seems to be corrupted")
|
||||
((eql err mu-error-xapian-cannot-get-writelock) "Database is locked")
|
||||
((eql err mu-error-gmime) "GMime-related error")
|
||||
((eql err mu-error-contacts) "Contacts-related error")
|
||||
((eql err mu-error-contacts-cannot-retrieve) "Failed to retrieve contacts")
|
||||
((eql err mu-error-file) "File error")
|
||||
((eql err mu-error-file-invalid-name) "Invalid file name")
|
||||
((eql err mu-error-file-cannot-link) "Failed to link file")
|
||||
((eql err mu-error-file-cannot-open) "Cannot open file")
|
||||
((eql err mu-error-file-cannot-read) "Cannot read file")
|
||||
((eql err mu-error-file-cannot-create) "Cannot create file")
|
||||
((eql err mu-error-file-cannot-mkdir) "mu-mkdir failed")
|
||||
((eql err mu-error-file-stat-failed) "stat(2) failed")
|
||||
((eql err mu-error-file-readdir-failed) "readdir failed")
|
||||
((eql err mu-error-file-invalid-source) "Invalid source file")
|
||||
((eql err mu-error-file-target-equals-source) "Source is same as target")
|
||||
(t (format "Unknown error (%d)" err))))
|
||||
|
||||
|
||||
(provide 'mua-mu)
|
||||
|
||||
@ -38,24 +38,35 @@
|
||||
"buffer name for mua/view buffers")
|
||||
|
||||
(defvar mua/view-headers
|
||||
'(:from :to :cc :subject :flags :date :maildir :attachments)
|
||||
"fields to display in the message view")
|
||||
'(:from :to :cc :subject :flags :date :maildir :path :attachments)
|
||||
"Fields to display in the message view buffer.")
|
||||
|
||||
(defvar mua/hdrs-buffer nil
|
||||
"headers buffer for the view")
|
||||
"Headers buffer for the view in this buffer.")
|
||||
|
||||
(defun mua/view (path headersbuf)
|
||||
"display message at PATH in a new buffer; note that the action
|
||||
of viewing a message may cause it to be moved/renamed; this
|
||||
function returns the resulting name. PARENTBUF refers to the
|
||||
(defvar mua/view-uid nil
|
||||
"The UID for the message being viewed in this buffer.")
|
||||
|
||||
|
||||
(defun mua/view (uid headersbuf)
|
||||
"display message identified by UID in a new buffer. Note that
|
||||
the action of viewing a message may cause it to be moved/renamed;
|
||||
this function returns the resulting name. PARENTBUF refers to the
|
||||
buffer who invoked this view; this allows us to return there when
|
||||
we quit from this view. Also, if PARENTBUF is a find buffer (ie.,
|
||||
has mu-headers-mode as its major mode), this allows various
|
||||
commands (navigation, marking etc.) to be applied to this
|
||||
buffer."
|
||||
(let* ((sexp (mua/mu-view-sexp path))
|
||||
buffer.
|
||||
|
||||
For the reasoning to use UID here instead of just the path, see
|
||||
`mua/msg-file-map'.
|
||||
"
|
||||
(let* ((path (mua/msg-file-get-path uid))
|
||||
(sexp (and path (mua/mu-view-sexp path)))
|
||||
(msg (and sexp (mua/msg-from-string sexp))))
|
||||
(when msg
|
||||
(if (not msg)
|
||||
(mua/warn "Cannot view message %S %S" uid path)
|
||||
(progn
|
||||
(switch-to-buffer (get-buffer-create mua/view-buffer-name))
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
@ -64,27 +75,12 @@ buffer."
|
||||
(mua/view-mode)
|
||||
|
||||
(setq ;; these are buffer-local
|
||||
mua/view-uid uid
|
||||
mua/hdrs-buffer headersbuf
|
||||
mua/parent-buffer headersbuf)
|
||||
(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)))
|
||||
(target (mua/maildir-from-path path t))
|
||||
(newpath (mua/msg-move path target flags)))
|
||||
;; now, attempt to update our parent header list...
|
||||
(if newpath
|
||||
(mua/with-hdrs-buffer
|
||||
(if (string= (mua/hdrs-get-path) path) ;; doublecheck we have the right one
|
||||
(mua/hdrs-set-path newpath)
|
||||
(mua/warn "Headers buffer not point at correct message")))
|
||||
(mua/warn "Failed to mark message as read"))))))
|
||||
(goto-char (point-min))
|
||||
(mua/msg-file-mark-as-read uid)))))
|
||||
|
||||
(defun mua/view-message (msg)
|
||||
"construct a display string for the message"
|
||||
@ -157,7 +153,6 @@ buffer."
|
||||
)
|
||||
|
||||
|
||||
|
||||
(defvar mua/view-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "q" 'mua/quit-buffer)
|
||||
@ -172,10 +167,10 @@ buffer."
|
||||
(define-key map "p" 'mua/view-prev)
|
||||
|
||||
;; marking/unmarking
|
||||
(define-key map "d" '(lambda (mua/view-mark 'trash)))
|
||||
(define-key map "D" '(lambda (mua/view-mark 'delete)))
|
||||
(define-key map "m" '(lambda (mua/view-mark 'move)))
|
||||
(define-key map "u" '(lambda (mua/view-mark 'unmark)))
|
||||
(define-key map "d" '(lambda() (mua/view-mark 'trash)))
|
||||
(define-key map "D" '(lambda() (mua/view-mark 'delete)))
|
||||
(define-key map "m" '(lambda() (mua/view-mark 'move)))
|
||||
(define-key map "u" '(lambda() (mua/view-mark 'unmark)))
|
||||
(define-key map "x" 'mua/view-marked-execute)
|
||||
map)
|
||||
"Keymap for \"*mua-view*\" buffers.")
|
||||
@ -189,7 +184,7 @@ buffer."
|
||||
|
||||
(make-local-variable 'mua/parent-buffer)
|
||||
(make-local-variable 'mua/hdrs-buffer)
|
||||
(make-local-variable 'mua/path)
|
||||
(make-local-variable 'mua/view-uid)
|
||||
|
||||
(setq major-mode 'mua/view-mode mode-name "*mu-view*")
|
||||
(setq truncate-lines t buffer-read-only t))
|
||||
@ -208,6 +203,25 @@ etc. persist."
|
||||
(set-buffer oldbuf))
|
||||
(mua/warn "hdrs buffer is dead"))))
|
||||
|
||||
|
||||
(defun mua/view-mark (action)
|
||||
"Set/unset marks for the current message."
|
||||
(interactive)
|
||||
(mua/with-hdrs-buffer (mua/hdrs-mark action)))
|
||||
|
||||
(defun mua/view-marked-execute ()
|
||||
"Warn user that marks cannot be executed from here (for his/her
|
||||
own safety)."
|
||||
(interactive)
|
||||
(mua/warn "You cannot execute marks from here"))
|
||||
|
||||
|
||||
(defun mua/view-search()
|
||||
"Start a new search."
|
||||
(interactive)
|
||||
(mua/with-hdrs-buffer
|
||||
(call-interactively 'mua/hdrs-search)))
|
||||
|
||||
(defun mua/view-next ()
|
||||
"move to the next message; note, this will replace the current
|
||||
buffer"
|
||||
|
||||
@ -35,6 +35,8 @@
|
||||
(require 'mua-msg)
|
||||
(require 'mua-hdrs)
|
||||
(require 'mua-view)
|
||||
(require 'mua-msg-file)
|
||||
|
||||
|
||||
(defvar mua/mu-home nil "location of the mu homedir, or nil for
|
||||
the default")
|
||||
@ -82,6 +84,7 @@ quitted, it switches back to its parent buffer")
|
||||
(defface mua/body-face '((t (:foreground "#8cd0d3"))) "")
|
||||
|
||||
|
||||
|
||||
(setq mua/hdrs-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
||||
@ -146,7 +149,6 @@ quitted, it switches back to its parent buffer")
|
||||
(switch-to-buffer buf)
|
||||
(mua/mua-mode)))
|
||||
|
||||
|
||||
(defvar mua/mua-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user