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-05 08:19:19 +03:00
parent 5e2e232e3b
commit 61ab894ab4
6 changed files with 205 additions and 208 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
emacs/Makefile
View File

@ -14,7 +14,7 @@ BATCH=$(EMACS) -batch -q -no-site-file -eval \
all: $(ELCS)
docs: mu.info
docs: mu.infogg
install_lisp:
mkdir -p $(DESTDIR)/$(PREFIX)/share/emacs/site-lisp

45
emacs/mu-common.el
View File

@ -104,6 +104,41 @@ etc.)"
(setq mu-own-address-regexp "djcb\\|diggler\\|bulkmeel")
(defvar mu-maildir nil "our maildir")
(defvar mu-folder nil "our list of special folders for jumping,
moving")
(defvar mu-maildir nil "location of your maildir, typically ~/Maildir")
(defvar mu-inbox-folder nil "location of your inbox folder")
(defvar mu-outbox-folder nil "location of your outbox folder")
(defvar mu-sent-folder nil "location of your sent folder")
(defvar mu-trash-folder nil "location of your trash-folder folder")
(setq
mu-maildir "/home/djcb/Maildir"
mu-inbox-folder "/inbox"
mu-outbox-folder "/outbox"
mu-sent-folder "/sent"
mu-trash-folder "/trash")
(defvar mu-quick-folders nil)
(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"
(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)))
(defun mu-ask-key (prompt)
"Get a char from user, only accepting characters marked with [x] in prompt,
e.g. 'Reply to [a]ll or [s]ender only; returns the character chosen"
@ -165,11 +200,6 @@ Lisp data as a plist. Returns nil in case of error"
(progn (message "Failed to parse message") nil)))))
(defun mu-move-to-updated-path (path newflags)
"move msg to an updated path based on newflags"
;; TODO
)
(defun mu-quit-buffer ()
"kill this buffer, and switch to it's parentbuf if it is alive"
(interactive)
@ -185,4 +215,9 @@ old one first"
(kill-buffer bufname))
(get-buffer-create bufname))
(defun mu-log (frm &rest args)
(with-current-buffer (get-buffer-create "*mu-log*")
(insert (apply 'format (concat frm "\n") args))))
(provide 'mu-common)

296
emacs/mu-headers.el
View File

@ -32,6 +32,35 @@
;;; one line descriptions of an e-mail message), based on the output of 'mu
;;; find'.
;; data is stored like the following: for each header-line, we take the (point)
;; at beginning-of-line (bol) and use that as the key in the mu-headers-hash
;; hash, which does
;;
;; point-of-bol -> path
;;
;; then, marks are stored in a seperate hash 'mu-headers-marks-hash, using
;;
;; point-of-bol -> (src . target)
;;
;; and note both 'delete' (target=/dev/null), trash (target=trash-folder), and
;; move can be expressed by that
;;
;; after the marks have been 'executed', the lines will be marked a *invisible*
;; instead of deleting them; that way, the 'point-of-bol' stays valid.
(defvar mu-headers-hash nil "internal: buffer-local hash table
which maps bol->path")
(defvar mu-headers-marks-hash nil "internal: buffer-local hash table
which maps bol->(src . target) for marked lines")
(defun mu-headers-set-path (path)
"map the bol of the current header to a path"
(puthash (line-beginning-position 1) path mu-headers-hash))
(defun mu-headers-get-path ()
"get the path for the header at point"
(gethash (line-beginning-position 1) mu-headers-hash))
(defvar mu-headers-fields
'( (:date . 25)
(:from-or-to . 22)
@ -55,7 +84,7 @@ the mu find output")
(defvar mu-headers-expression nil
"search expression for the current find buffer")
(defvar mu-buf "" "buffer for results data")
(defvar mu-buf "" "internal: buffer for results data")
(defun mu-headers-process-filter (proc str)
"process-filter for the 'mu find --format=sexp output; it
accumulates the strings into valid sexps by checking of the
@ -63,10 +92,11 @@ the mu find output")
(save-excursion
(setq mu-buf (concat mu-buf str))
(let ((eom (string-match mu-eom mu-buf)))
(while (numberp eom)
(while (numberp eom)
(let* ((msg (car (read-from-string (substring mu-buf 0 eom))))
(inhibit-read-only t))
(goto-char (point-max))
(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))))))
@ -116,14 +146,18 @@ the mu find output")
"--quiet"
expr)))
(switch-to-buffer buf)
(mu-headers-mode)
(setq
mu-buf "" ;; if the last query went wrong...
mu-headers-expression expr
mu-headers-process proc)
mu-headers-process proc
mu-headers-hash (make-hash-table :size 256 :rehash-size 2)
mu-headers-marks-hash (make-hash-table :size 16 :rehash-size 2))
(set-process-filter proc 'mu-headers-process-filter)
(set-process-sentinel proc 'mu-headers-process-sentinel)
(mu-headers-mode)))
(set-process-sentinel proc 'mu-headers-process-sentinel)))
(defun mu-headers-field-contact (lst width face)
"display a list of contacts, truncated for fitting in WIDTH"
@ -201,11 +235,10 @@ the mu find output")
(defun mu-headers-header (msg)
"convert a message s-expression into a header for display, and
set text property 'path"
(let ((fields (mapconcat
(lambda (fieldinfo)
(mu-headers-field msg fieldinfo)) mu-headers-fields " ")))
(propertize (concat " " fields) 'front-sticky t
'path (plist-get msg :path))))
(concat " "
(mapconcat
(lambda (fieldinfo)
(mu-headers-field msg fieldinfo)) mu-headers-fields " ")))
(defun mu-headers-mode ()
@ -213,11 +246,17 @@ set text property 'path"
(interactive)
(kill-all-local-variables)
(use-local-map mu-headers-mode-map)
(make-variable-buffer-local 'mu-parent-buffer)
(make-variable-buffer-local 'mu-headers-expression)
(make-variable-buffer-local 'mu-headers-process)
(make-local-variable 'mu-buf)
(make-local-variable 'mu-parent-buffer)
(make-local-variable 'mu-headers-expression)
(make-local-variable 'mu-headers-process)
(make-local-variable 'mu-headers-hash)
(make-local-variable 'mu-headers-marks-hash)
(setq
major-mode 'mu-headers-mode mode-name "*headers*"
mu-buf ""
truncate-lines t buffer-read-only t
overwrite-mode 'overwrite-mode-binary))
@ -245,13 +284,13 @@ set text property 'path"
(defun mu-headers-view ()
"display the message at the current line"
(interactive)
(let ((path (mu-get-path)))
(let ((path (mu-headers-get-path)))
(when path (mu-view path (current-buffer)))))
(defun mu-headers-next ()
"go to the next line; t if it worked, nil otherwise"
(interactive)
(if (or (/= 0 (forward-line 1)) (not (mu-get-path)))
(if (or (/= 0 (forward-line 1)) (not (mu-headers-get-path)))
(progn (message "No message after this one") nil)
t))
@ -310,171 +349,76 @@ 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)
(let ((bol (line-beginning-position 1)))
(if (gethash bol mu-headers-marks-hash)
(progn (message "Message is already marked") nil)
(progn (puthash bol (cons src dst) mu-headers-marks-hash) t))))
;; message are 'marked' for moving, deletion etc. by have a special propertized
;; character at the start of the line; this propertized character holds an
;; 'action property, which tells what to do with this one (e.g.,'d'-> trash,
;; 'D'->delete, 'm'->'move'). 'u' (unmark) removes this mark, 'U' removes
;; all-marks. 'x'->mu-headers-execute removes all marks
(defun mu-headers-mark (what)
"mark the current msg for 'trash, 'move, 'none; return t if it
worked, nil otherwise"
(when (mu-get-path)
(move-beginning-of-line 1)
(let ((inhibit-read-only t) (overwrite-mode nil))
(if (and (not (eq what 'none)) (get-text-property (point) 'action))
(progn (message "Message at point is already marked") nil)
(progn
(delete-char 1)
(case what
('trash (insert-and-inherit
(mu-str (propertize "d" 'action what 'target "/foo/bar"))))
('delete (insert-and-inherit
(mu-str (propertize "D" 'action what 'target "/foo/bar"))))
('move (insert-and-inherit
(mu-str (propertize "m" 'action what 'target "/foo/bar"))))
('none (insert-and-inherit " ")))
t)))))
(defun mu-headers-remove-marked ()
(let ((bol (line-beginning-position 1)))
(if (not (gethash bol mu-headers-marks-hash))
(progn (message "Message is not marked") nil)
(progn (remhash bol mu-headers-marks-hash) t))))
(defun mu-headers-get-marked ()
"get all marked messages in the current buffer as a list; each
element is a cell; with 'action', 'source' , 'target'). ie one of
three:
('delete <path>)
('trash <path> <target>)
('move <path> <target>)"
(let ((lst))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^." nil t)
(let* ((char0 (match-string 0))
(action (get-text-property 0 'action char0))
(path (get-text-property 0 'path char0))
(target (get-text-property 0 'target char0)))
(cond
((eq action 'trash)
(setq lst (cons (list 'trash path target) lst)))
((eq action 'delete)
(setq lst (cons (list 'delete path) lst)))
((eq action 'move)
(setq lst (cons (list 'move path target) lst)))))))
lst))
(defun mu-headers-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 kar " ") " ")))
(defun mu-headers-marked-execute ()
"execute marked actions on messages in the current buffer"
(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"))))))))
(defun mu-headers-marks-execute ()
"execute the actions for all marked messages"
(interactive)
(let* ((markedcount (mu-headers-count-marked))
(movenum (nth 0 markedcount)) (trashnum (nth 1 markedcount))
(deletenum (nth 2 markedcount)))
(if (= 0 (apply '+ markedcount))
(message "No messages are marked")
(if (and (< 0 movenum)
(y-or-n-p (format "Do you want to move %d message(s)?" movenum)))
(message "Moving message(s)"))
(if (and (< 0 trashnum)
(y-or-n-p (format "Do you want to move %d message(s) to trash?" trashnum)))
(message "Trashing message(s)"))
(if (and (< 0 deletenum)
(yes-or-no-p (format "Do you want to permanently delete %d message(s)?"
deletenum)))
(let ((failed (mu-headers-executed-marked 'delete)))
(if (/= 0 failed)
(message "Failed to delete %d of %d message(s)" failed deletenum)
(message "%d message(s) deleted" deletenum)
(mu-headers-refresh)))))))
(let ((n-marked (hash-table-count mu-headers-marks-hash)))
(if (= 0 n-marked)
(message "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 ((src (car v)) (target (cdr v)) (inhibit-read-only t))
(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))))))
(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-unmark () (interactive) (mu-headers-mark 'unmark))
(defun mu-headers-unmark-all () (interactive) (mu-headers-mark 'unmark-all))
(defun mu-headers-executed-marked (execute-action)
"handle marked headers for action; return the number of failed
actions"
(let ((failed 0))
(mu-headers-foreach-marked
(lambda (cell)
(let ((action (nth 0 cell)) (src (nth 1 cell)) (target (nth 2 cell)))
(when (eq action execute-action)
(unless
(case action
('delete (mu-message-delete src))
(t (message "Unsupported action")))
(setq failed (+ 1 failed)))))))
failed))
(defun mu-headers-foreach-marked (func)
"call FUNC for each marked message in BUFFER; the argument
to FUNC is a list, either: with 'action', 'source' ,
'target'). ie one of three:
('delete <path>)
('trash <path> <target>)
('move <path> <target>)"
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^." nil t)
(move-beginning-of-line 1)
(let* ((char0 (match-string 0))
(action (get-text-property 0 'action char0))
(path (get-text-property 0 'path char0))
(target (get-text-property 0 'target char0)))
(cond
((eq action 'trash) (funcall func (list 'trash path target)))
((eq action 'delete) (funcall func (list 'delete path)))
((eq action 'move) (funcall func (list 'move path target)))))
(move-end-of-line 1))))
(defun mu-headers-count-marked ()
"return a vector with three items (marked-move marked-trash
marked-delete) which are the number of messages marked for each
of those in the current buffer"
(let ((result (make-vector 3 0)))
(mu-headers-foreach-marked
(lambda (cell)
(case (car cell)
('move (aset result 0 (+ 1 (aref result 0))))
('trash (aset result 1 (+ 1 (aref result 1))))
('delete (aset result 2 (+ 1 (aref result 2)))))))
(append result nil))) ;; convert to list
(defun mu-headers-unmark-all ()
"unmark all messages in the current buffer"
(interactive)
(let ((marked 0))
(mu-headers-foreach-marked
(lambda(cell) (setq marked (+ 1 marked))))
(if (= 0 marked)
(message "No messages are marked")
(when (y-or-n-p (format "Unmark %d message(s)?" marked))
(mu-headers-foreach-marked
(lambda(cell)
(let ((inhibit-read-only t))
(delete-char 1)
(insert-and-inherit " "))))))))
(defun mu-headers-mark-for-trash ()
(interactive)
(when (mu-headers-mark 'trash)
(message "Message marked for trashing")
(forward-line)))
(defun mu-headers-mark-for-deletion ()
(interactive)
(when (mu-headers-mark 'delete)
(message "Message marked for deletion")
(forward-line)))
(defun mu-headers-mark-for-move ()
(interactive)
(when (mu-headers-mark 'move)
(message "Message marked for moving")
(forward-line)))
(defun mu-headers-unmark ()
(interactive)
(when (mu-headers-mark 'none)
(message "Message unmarked")
(forward-line)))
(provide 'mu-headers)

35
emacs/mu-message.el
View File

@ -129,14 +129,33 @@ to the message editor"
creation, switch to the message editor"
(mu-message-reply-or-forward path t))
(defun mu-message-delete (path)
"delete message at PATH using 'mu mv'; return t if succeeded, nil otherwise"
(let
((rv (call-process mu-binary nil nil nil "mv" path "/dev/null")))
(setq okay (and (numberp rv) (= rv 0)))
(message (if okay "Message has been deleted" "Message deletion failed"))
(defun mu-message-move (src targetdir)
"move message at PATH using 'mu mv'; if targetdir is
'/dev/null', move immediately. Return t if succeeded, nil
otherwise"
(let* ((cmd (concat
mu-binary " mv --printtarget "
(shell-quote-argument src) " "
(shell-quote-argument targetdir)))
(fulltarget (shell-command-to-string cmd)))
(mu-log cmd)
(mu-log
(if fulltarget (concat "Message has been moved to " fulltarget)
"Message moving failed"))
;; now, if saving worked, anynchronously try to update the database
(start-process " *mu-remove*" nil mu-binary "remove" path)
okay)) ;; note, we don't check the result of the db output
(when fulltarget
(start-process " *mu-remove*" nil mu-binary "remove" src)
(unless (string= targetdir "/dev/null")
(start-process " *mu-add*" nil mu-binary "add" fulltarget)))))
;; note, we don't check the result of the db output
(provide 'mu-message)

33
emacs/mu-view.el
View File

@ -110,20 +110,16 @@ buffer."
(let ((str (mu-view-message path))
(buf (mu-get-new-buffer mu-view-buffer-name)))
(when str
(with-current-buffer buf
(let ((inhibit-read-only t))
;; note, we set the path as a text-property
(insert (propertize str 'path path))))
(switch-to-buffer buf)
(mu-view-mode)
;; these are buffer-local
(setq mu-parent-buffer parentbuf)
(setq mu-view-headers-buffer parentbuf)
(goto-char (point-min)))))
(insert str))
(mu-view-mode)
(setq ;; these are buffer-local
mu-parent-buffer parentbuf
mu-view-headers-buffer parentbuf
mu-path path)
(goto-char (point-min))))
(defvar mu-view-mode-map
(let ((map (make-sparse-keymap)))
@ -152,8 +148,11 @@ buffer."
(interactive)
(kill-all-local-variables)
(use-local-map mu-view-mode-map)
(make-variable-buffer-local 'mu-parent-buffer)
(make-variable-buffer-local 'mu-headers-buffer)
(make-local-variable 'mu-parent-buffer)
(make-local-variable 'mu-headers-buffer)
(make-local-variable 'mu-path)
(setq major-mode 'mu-view-mode mode-name "*mu-view*")
(setq truncate-lines t buffer-read-only t))
@ -174,14 +173,14 @@ also `with-temp-buffer'."
(interactive)
(with-current-headers-buffer
(when (mu-headers-next)
(mu-view (mu-get-path) (current-buffer)))))
(mu-view (mu-headers-get-path) (current-buffer)))))
(defun mu-view-prev ()
"move to the previous message"
(interactive)
(with-current-headers-buffer
(when (mu-headers-prev)
(mu-view (mu-get-path) (current-buffer)))))
(mu-view (mu-headers-get-path) (current-buffer)))))
(defun mu-view-mark-for-trash ()
"mark for thrashing"

2
emacs/mu.el
View File

@ -44,7 +44,7 @@
(define-key mu-headers-mode-map "U" 'mu-headers-unmark-all)
(define-key mu-headers-mode-map "r" 'mu-headers-reply)
(define-key mu-headers-mode-map "f" 'mu-headers-forward)
(define-key mu-headers-mode-map "x" 'mu-headers-marked-execute)
(define-key mu-headers-mode-map "x" 'mu-headers-marks-execute)
(define-key mu-view-mode-map "q" 'mu-quit-buffer)