diff --git a/emacs/mu-common.el b/emacs/mu-common.el index 0f8aa812..43082aab 100644 --- a/emacs/mu-common.el +++ b/emacs/mu-common.el @@ -116,7 +116,7 @@ moving") (defvar mu-trash-folder nil "location of your trash-folder folder") (setq - mu-maildir "/home/djcb/Maildir" + mu-maildir "/home/djcb/Maildir" mu-inbox-folder "/inbox" mu-outbox-folder "/outbox" mu-sent-folder "/sent" @@ -127,17 +127,17 @@ moving") (setq mu-quick-folders '("/archive" "/bulkarchive" "/todo")) -(defun mu-ask-folder (prompt) - "ask user with PROMPT for a folder name, return the full path -the folder" +(defun mu-ask-maildir (prompt &optional fullpath) + "ask user with PROMPT for a maildir name, if fullpath is +non-nill, return the fulpath (ie, mu-maildir prepended to the +maildir" (interactive) (let* ((showfolders (delete-dups (append (list mu-inbox-folder mu-sent-folder) mu-quick-folders))) (chosen (ido-completing-read prompt showfolders))) - (concat mu-maildir chosen))) - + (concat (if fullpath mu-maildir "") chosen))) (defun mu-ask-key (prompt) "Get a char from user, only accepting characters marked with [x] in prompt, @@ -217,7 +217,11 @@ old one first" (defun mu-log (frm &rest args) (with-current-buffer (get-buffer-create "*mu-log*") - (insert (apply 'format (concat frm "\n") args)))) + (goto-char (point-max)) + (insert (apply 'format + (concat + (format-time-string "%x %X " (current-time)) + frm "\n") args)))) (provide 'mu-common) diff --git a/emacs/mu-headers.el b/emacs/mu-headers.el index 2a3234b2..7b890ee4 100644 --- a/emacs/mu-headers.el +++ b/emacs/mu-headers.el @@ -89,51 +89,54 @@ the mu find output") "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" - (save-excursion - (setq mu-buf (concat mu-buf str)) - (let ((eom (string-match mu-eom mu-buf))) - (while (numberp eom) - (let* ((msg (car (read-from-string (substring mu-buf 0 eom)))) - (inhibit-read-only t)) - (goto-char (point-max)) - (mu-headers-set-path (plist-get msg :path)) - (save-match-data (insert (mu-headers-header msg) ?\n))) - (setq mu-buf (substring mu-buf (match-end 0))) - (setq eom (string-match mu-eom mu-buf)))))) - - + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (save-excursion + (setq mu-buf (concat mu-buf str)) + (let ((eom (string-match mu-eom mu-buf))) + (while (numberp eom) + (let* ((msg (car (read-from-string (substring mu-buf 0 eom)))) + (inhibit-read-only t)) + (goto-char (point-max)) + (mu-headers-set-path (plist-get msg :path)) + (save-match-data (insert (mu-headers-header msg) ?\n))) + (setq mu-buf (substring mu-buf (match-end 0))) + (setq eom (string-match mu-eom mu-buf)))))))) + (defun mu-headers-process-sentinel (proc msg) "Check the mu-headers process upon completion" - (let ((status (process-status proc)) - (exit-status (process-exit-status proc))) - (if (memq status '(exit signal)) - (let ((inhibit-read-only t) - (text - (cond - ((eq status 'signal) - "Search process killed (results incomplete)") - ((eq status 'exit) + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (let ((status (process-status proc)) + (exit-status (process-exit-status proc))) + (if (memq status '(exit signal)) + (let ((inhibit-read-only t) + (text (cond - ((= 0 exit-status) "End of search results") - ((= 2 exit-status) "No matches found") - ((= 4 exit-status) "Database problem; try running 'mu index'") - (t (format "Some error occured; mu-headers returned %d" - exit-status)))) - (t "Unknown status")))) ;; shouldn't happen - (save-excursion - (goto-char (point-max)) - (insert (mu-str text))))))) - + ((eq status 'signal) + "Search process killed (results incomplete)") + ((eq status 'exit) + (cond + ((= 0 exit-status) "End of search results") + ((= 2 exit-status) "No matches found") + ((= 4 exit-status) "Database problem; try running 'mu index'") + (t (format "Some error occured; mu-headers returned %d" + exit-status)))) + (t "Unknown status")))) ;; shouldn't happen + (save-excursion + (goto-char (point-max)) + (insert (mu-str text))))))))) + ;; Note, the 'mu find --format=sexp' sexp is almost the same as the ones that ;; 'mu view --format=sexp' produces (see mu-get-message), with the difference ;; that former may give more than one result, and that mu-headers output comes ;; from the database rather than file, and does _not_ contain the message body -(defun mu-headers (expr) +(defun mu-headers-search (expr) "search in the mu database" - (interactive "s[mu] messages to find: ") + (interactive "s[mu] search for: ") (let* ((buf (mu-get-new-buffer mu-headers-buffer-name)) - (dummy-arg "--fields=\"dummy\"") ;; ignored + (dummy-arg "--fields=\"dummy\"") ;; ignored (proc (start-process mu-headers-buffer-name buf mu-binary "find" @@ -145,6 +148,7 @@ the mu find output") "--format=sexp" "--quiet" expr))) + (mu-log "search: '%s'" expr) (switch-to-buffer buf) (mu-headers-mode) @@ -262,17 +266,25 @@ set text property 'path" (defvar mu-headers-mode-map (let ((map (make-sparse-keymap))) + + (define-key map "s" 'mu-headers-search) (define-key map "q" 'mu-quit-buffer) (define-key map "s" 'mu-headers-change-sort) (define-key map "g" 'mu-headers-refresh) + + ;; navigation + (define-key map "n" 'mu-headers-next) + (define-key map "p" 'mu-headers-previous) + (define-key map "j" 'mu-headers-jump-to-maildir) ;; marking/unmarking/executing (define-key map "m" 'mu-headers-mark-for-move) (define-key map "d" 'mu-headers-mark-for-trash) (define-key map "D" 'mu-headers-mark-for-deletion) (define-key map "u" 'mu-headers-unmark) + (define-key map "U" 'mu-headers-unmark-all) (define-key map "x" 'mu-headers-marked-execute) - + ;; message composition (define-key map "r" 'mu-reply) (define-key map "f" 'mu-forward) @@ -301,6 +313,12 @@ set text property 'path" (progn (message "No message before this one") nil) t)) +(defun mu-headers-jump-to-maildir () + "show the messages in one of the standard folders" + (interactive) + (let ((fld (mu-ask-maildir "Jump to maildir: "))) + (mu-headers-search (concat "maildir:" fld)))) + (defun mu-headers-refresh () "re-run the query for the current search expression, but only if the search process is not already running" @@ -349,7 +367,7 @@ if the search process is not already running" (and (call-interactively 'mu-headers-change-sort-order) (call-interactively 'mu-headers-change-sort-direction))) -(defun mu-headers-add-marked (src dst) +(defun mu-headers-add-marked (src &optional dst) (let ((bol (line-beginning-position 1))) (if (gethash bol mu-headers-marks-hash) (progn (message "Message is already marked") nil) @@ -361,7 +379,6 @@ if the search process is not already running" (progn (message "Message is not marked") nil) (progn (remhash bol mu-headers-marks-hash) t)))) - (defun mu-headers-set-marker (kar) "set the marker at the beginning of this line" (beginning-of-line 1) @@ -372,28 +389,31 @@ if the search process is not already running" (defun mu-headers-mark (action) "mark the current msg for something: move, delete, trash, unmark" (let ((target) (src (mu-headers-get-path))) - (when (and src - (case action - (move - (when (mu-headers-add-marked src (mu-ask-folder "Target maildir: ")) - (mu-headers-set-marker ?m))) - (trash - (when (mu-headers-add-marked src mu-trash-folder) - (mu-headers-set-marker ?d))) - (delete - (when (mu-headers-add-marked src "/dev/null") - (mu-headers-set-marker ?D))) - (unmark - (when (mu-headers-remove-marked src "dummy") - (mu-headers-set-marker nil))) - (unmark-all - (when (y-or-n-p (format "Sure you want to remove all (%d) marks? " - (hash-table-count mu-headers-marks-hash))) - (save-excursion - (maphash (lambda (k v) (goto-char k) (mu-headers-mark 'unmark)) - mu-headers-marks-hash))) - (t (message "Unsupported mark type")))))))) - + (when src + (case action + (move + (when (mu-headers-add-marked src + (mu-ask-maildir "Target maildir: " t)) + (mu-headers-set-marker ?m))) + (trash + (when (mu-headers-add-marked src + (concat mu-maildir mu-trash-folder)) + (mu-headers-set-marker ?d))) + (delete + (when (mu-headers-add-marked src "/dev/null") + (mu-headers-set-marker ?D))) + (unmark + (when (mu-headers-remove-marked) + (mu-headers-set-marker nil))) + (unmark-all + (when (y-or-n-p (format "Sure you want to remove all (%d) marks? " + (hash-table-count mu-headers-marks-hash))) + (save-excursion + (maphash (lambda (k v) (goto-char k) (mu-headers-mark 'unmark)) + mu-headers-marks-hash))) + (t (message "Unsupported mark type")))) + (move-beginning-of-line 2)))) + (defun mu-headers-marks-execute () "execute the actions for all marked messages" (interactive) @@ -409,16 +429,36 @@ if the search process is not already running" (when (mu-message-move src target) (goto-char bol) (mu-headers-remove-marked) - (put-text-property bol (line-beginning-position 2) - 'face 'invisible)))) ;; when it succeedes, hide msg..) - mu-headers-marks-hash)))))) - + (put-text-property (line-beginning-position 1) + (line-beginning-position 2) + 'invisible t)))) ;; when it succeedes, hide msg..) + mu-headers-marks-hash)) + (message "Done") +)))) + (defun mu-headers-mark-for-move () (interactive) (mu-headers-mark 'move)) (defun mu-headers-mark-for-trash () (interactive) (mu-headers-mark 'trash)) (defun mu-headers-mark-for-delete () (interactive) (mu-headers-mark 'delete)) +(defun mu-headers-mark-for-deletion () (interactive) (mu-headers-mark 'delete)) (defun mu-headers-unmark () (interactive) (mu-headers-mark 'unmark)) (defun mu-headers-unmark-all () (interactive) (mu-headers-mark 'unmark-all)) +(defun mu-headers-reply () + "Reply to the message at point" + (interactive) + (let ((path (mu-headers-get-path))) + (if path + (mu-message-reply path) + (message "No message at point")))) + +(defun mu-headers-forward () + "Reply to the message at point" + (interactive) + (let ((path (mu-headers-get-path))) + (if path + (mu-message-forward path) + (message "No message at point")))) + (provide 'mu-headers) diff --git a/emacs/mu-message.el b/emacs/mu-message.el index e82e586c..54f273c3 100644 --- a/emacs/mu-message.el +++ b/emacs/mu-message.el @@ -57,77 +57,84 @@ ""))) (replace-regexp-in-string "^" " > " body))) -(defun mu-message-recipients-remove (email lst) +(defun mu-message-recipients-remove (lst email-to-remove) "remove the recipient with EMAIL from the recipient list (of form '( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\"))" - (remove-if (lambda (c) (string= email (downcase (cdr c))) lst))) + (remove-if (lambda (name-email) + (string= email-to-remove (downcase (cdr name-email)))) + lst)) (defun mu-message-recipients-to-string (lst) "convert a recipient list (of form '( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\") into a string useful for from/to headers" + (message "recips: %S" lst) (mapconcat (lambda (recip) - (let ((name (car recip) (email (cdr recip)))) - (format "%s <%s>" (or name "") email))) lst ",")) - + (let ((name (car recip)) (email (cdr recip))) + (format "%s <%s>" (or name "") email))) lst ", ")) (defun mu-message-hidden-header (hdr val) "return user-invisible header to the message (HDR: VAL\n)" (propertize (format "%s: %s\n" hdr val) 'invisible t)) -(defun mu-message-reply-or-forward (path &optional forward reply-all) - "create a reply to the message at PATH; if FORWARD is non-nil, -create a forwarded message. After creation, switch to the message editor" +(defun mu-message-reply (path) + "create a reply to the message at PATH. After creation, switch +to the message editor" + (let* ((cmd (concat mu-binary " view --format=sexp " path)) + (str (shell-command-to-string cmd)) + (msg (car (read-from-string str))) + (buf (get-buffer-create + (generate-new-buffer-name "*mu-draft*"))) + (to-lst (mu-message-recipients-remove + (append (plist-get msg :from) (plist-get msg :to)) + user-mail-address)) + (cc-lst (mu-message-recipients-remove (plist-get msg :cc) + user-mail-address))) + + (with-current-buffer buf + (insert + (format "From: %s <%s>\n" user-full-name user-mail-address) + (mu-message-hidden-header "User-agent" (mu-message-user-agent)) + (if (boundp 'mail-reply-to) (insert (format "Reply-To: %s\n" + mail-reply-to)) "") + (format "To: %s\n" (if to-lst (mu-message-recipients-to-string to-lst) "")) + (if cc-lst + (format "Cc: %s\n" (mu-message-recipients-to-string cc-lst))) + "Subject: " mu-message-reply-prefix (plist-get msg :subject) "\n" + "--text follows this line--\n\n" + + (mu-message-attribution msg) + (mu-message-cite msg))) + + (switch-to-buffer buf) + (message-mode) + (message-goto-body))) + + +(defun mu-message-forward (path) + "create a forward to the message at PATH. After creation, switch +to the message editor" (let* ((cmd (concat mu-binary " view --format=sexp " path)) (str (shell-command-to-string cmd)) (msg (car (read-from-string str))) (buf (get-buffer-create (generate-new-buffer-name "*mu-draft*")))) + (with-current-buffer buf (insert (format "From: %s <%s>\n" user-full-name user-mail-address) - (mu-message-hidden-header "User-agent" (mu-message-user-agent))) - - (when (boundp 'mail-reply-to) - (insert (format "Reply-To: %s\n" mail-reply-to))) - - (if forward - (insert - "To:\n" - "Subject: " mu-message-forward-prefix (plist-get msg :subject) "\n") - (insert - "To: " (car (car (plist-get msg :from))) "\n" - "Subject: " mu-message-reply-prefix (plist-get msg :subject) "\n")) - - (insert + (mu-message-hidden-header "User-agent" (mu-message-user-agent)) + "To: \n" + "Subject: " mu-message-forward-prefix (plist-get msg :subject) "\n" "--text follows this line--\n\n" + (mu-message-attribution msg) - (mu-message-cite msg)) - - ;; (when mail-signature (insert mail-signature)) - - (message-mode) - - (if forward - (message-goto-to) - (message-goto-body)) - - (switch-to-buffer buf)))) - - -(defun mu-message-reply () - "create a reply to the message at point; After creation, switch -to the message editor" - (let ((path (mu-get-path))) - (when path - (mu-ask-key "Reply to [s]ender only or to [a]ll?") - (mu-message-reply-or-forward path)))) + (mu-message-cite msg))) -(defun mu-message-forward (path) - "create a forward-message to the message at PATH; After -creation, switch to the message editor" - (mu-message-reply-or-forward path t)) + (switch-to-buffer buf) + (message-mode) + (message-goto-to))) (defun mu-message-move (src targetdir) "move message at PATH using 'mu mv'; if targetdir is @@ -145,17 +152,14 @@ otherwise" "Message moving failed")) ;; now, if saving worked, anynchronously try to update the database (when fulltarget + (mu-log "Removing from database: %s" src) (start-process " *mu-remove*" nil mu-binary "remove" src) - (unless (string= targetdir "/dev/null") - (start-process " *mu-add*" nil mu-binary "add" fulltarget))))) + + (if (string= targetdir "/dev/null") + t + (mu-log "Adding to database: %s" fulltarget) + (start-process " *mu-add*" nil mu-binary "add" fulltarget) t)))) ;; note, we don't check the result of the db output - - - - - - - (provide 'mu-message) diff --git a/emacs/mu-view.el b/emacs/mu-view.el index 3a7d7ac5..483d74f1 100644 --- a/emacs/mu-view.el +++ b/emacs/mu-view.el @@ -15,7 +15,7 @@ ;; 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 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theq ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License @@ -34,6 +34,7 @@ :to :subject :date + :attachments :path) "list of header fields to display in the message view") @@ -55,6 +56,25 @@ from which this buffer was invoked (buffer local)") lst ","))) (concat header val "\n")))) + +(defun mu-view-header-contact (field lst face) + (when lst + (let* ((header (concat (propertize field 'face 'mu-header-face) ": ")) + (val (mapconcat (lambda(c) + (propertize (or (car c) (cdr c) "?") 'face face)) + lst ", "))) + (concat header val "\n")))) + +(defun mu-view-header-attachments (field lst face) + (when lst + (let* ((header (concat (propertize field 'face 'mu-header-face) ": ")) + (val (mapconcat + (lambda(att) + (let ((idx (nth 0 att)) (fname (nth 1 att)) (ctype (nth 2 att))) + (propertize fname 'face face))) + lst ", "))) + (concat header val "\n")))) + (defun mu-view-body (msg face) "view the body; try text first, if that does not work, try html" (cond @@ -90,7 +110,11 @@ from which this buffer was invoked (buffer local)") (:date (mu-view-header "Date" (format-time-string mu-date-format-long - (plist-get msg :date)) 'mu-date-face)))) + (plist-get msg :date)) 'mu-date-face)) + (:attachments + (mu-view-header-attachments "Attachments" (plist-get msg :attachments) + 'mu-path-face) + ))) mu-view-header-fields "") "\n" (mu-view-body msg 'mu-body-face) @@ -131,12 +155,12 @@ buffer." ;; navigation between messages (define-key map "n" 'mu-view-next) (define-key map "p" 'mu-view-prev) - + ;; marking/unmarking - (define-key map "d" 'mu-view-mark-for-trash) - (define-key map "D" 'mu-view-mark-for-deletion) - (define-key map "m" 'mu-view-mark-for-move) - (define-key map "u" 'mu-view-unmark) + (define-key map "d" '(lambda (mu-view-mark 'trash))) + (define-key map "D" '(lambda (mu-view-mark 'delete))) + (define-key map "m" '(lambda (mu-view-mark 'move))) + (define-key map "u" '(lambda (mu-view-mark 'unmark))) (define-key map "x" 'mu-view-marked-execute) map) @@ -182,33 +206,10 @@ also `with-temp-buffer'." (when (mu-headers-prev) (mu-view (mu-headers-get-path) (current-buffer))))) -(defun mu-view-mark-for-trash () - "mark for thrashing" +(defun mu-view-mark (mark) + "mark for MARK" (interactive) - (with-current-headers-buffer - (when (mu-headers-mark 'trash) - (mu-view-next)))) - -(defun mu-view-mark-for-deletion () - "mark for deletion" - (interactive) - (with-current-headers-buffer - (when (mu-headers-mark 'delete) - (mu-view-next)))) - -(defun mu-view-mark-for-move () - "mark for moving" - (interactive) - (with-current-headers-buffer - (when (mu-headers-mark 'move) - (mu-view-next)))) - -(defun mu-view-unmark () - "unmark this message" - (interactive) - (with-current-headers-buffer - (when (mu-headers-mark 'none) - (mu-view-next)))) + (with-current-headers-buffer (mu-headers-mark mark))) ;; we don't allow executing marks from the view buffer, to protect user from ;; accidentally deleting stuff...