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

* emacs/ updates

Browse Source
This commit is contained in:
Dirk-Jan C. Binnema
2011-08-06 10:43:33 +03:00
parent 8e6429a764
commit d90208b0c5
4 changed files with 208 additions and 159 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
emacs/mu-common.el
View File

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

168
emacs/mu-headers.el
View File

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

114
emacs/mu-message.el
View File

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

67
emacs/mu-view.el
View File

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