* emacs updates

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

View File

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

View File

@ -104,6 +104,41 @@ etc.)"
(setq mu-own-address-regexp "djcb\\|diggler\\|bulkmeel") (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) (defun mu-ask-key (prompt)
"Get a char from user, only accepting characters marked with [x] in 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" 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))))) (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 () (defun mu-quit-buffer ()
"kill this buffer, and switch to it's parentbuf if it is alive" "kill this buffer, and switch to it's parentbuf if it is alive"
(interactive) (interactive)
@ -185,4 +215,9 @@ old one first"
(kill-buffer bufname)) (kill-buffer bufname))
(get-buffer-create 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) (provide 'mu-common)

View File

@ -32,6 +32,35 @@
;;; one line descriptions of an e-mail message), based on the output of 'mu ;;; one line descriptions of an e-mail message), based on the output of 'mu
;;; find'. ;;; 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 (defvar mu-headers-fields
'( (:date . 25) '( (:date . 25)
(:from-or-to . 22) (:from-or-to . 22)
@ -55,7 +84,7 @@ the mu find output")
(defvar mu-headers-expression nil (defvar mu-headers-expression nil
"search expression for the current find buffer") "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) (defun mu-headers-process-filter (proc str)
"process-filter for the 'mu find --format=sexp output; it "process-filter for the 'mu find --format=sexp output; it
accumulates the strings into valid sexps by checking of the accumulates the strings into valid sexps by checking of the
@ -63,10 +92,11 @@ the mu find output")
(save-excursion (save-excursion
(setq mu-buf (concat mu-buf str)) (setq mu-buf (concat mu-buf str))
(let ((eom (string-match mu-eom mu-buf))) (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)))) (let* ((msg (car (read-from-string (substring mu-buf 0 eom))))
(inhibit-read-only t)) (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))) (save-match-data (insert (mu-headers-header msg) ?\n)))
(setq mu-buf (substring mu-buf (match-end 0))) (setq mu-buf (substring mu-buf (match-end 0)))
(setq eom (string-match mu-eom mu-buf)))))) (setq eom (string-match mu-eom mu-buf))))))
@ -116,14 +146,18 @@ the mu find output")
"--quiet" "--quiet"
expr))) expr)))
(switch-to-buffer buf) (switch-to-buffer buf)
(mu-headers-mode)
(setq (setq
mu-buf "" ;; if the last query went wrong... mu-buf "" ;; if the last query went wrong...
mu-headers-expression expr 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-filter proc 'mu-headers-process-filter)
(set-process-sentinel proc 'mu-headers-process-sentinel) (set-process-sentinel proc 'mu-headers-process-sentinel)))
(mu-headers-mode)))
(defun mu-headers-field-contact (lst width face) (defun mu-headers-field-contact (lst width face)
"display a list of contacts, truncated for fitting in WIDTH" "display a list of contacts, truncated for fitting in WIDTH"
@ -201,11 +235,10 @@ the mu find output")
(defun mu-headers-header (msg) (defun mu-headers-header (msg)
"convert a message s-expression into a header for display, and "convert a message s-expression into a header for display, and
set text property 'path" set text property 'path"
(let ((fields (mapconcat (concat " "
(lambda (fieldinfo) (mapconcat
(mu-headers-field msg fieldinfo)) mu-headers-fields " "))) (lambda (fieldinfo)
(propertize (concat " " fields) 'front-sticky t (mu-headers-field msg fieldinfo)) mu-headers-fields " ")))
'path (plist-get msg :path))))
(defun mu-headers-mode () (defun mu-headers-mode ()
@ -213,11 +246,17 @@ set text property 'path"
(interactive) (interactive)
(kill-all-local-variables) (kill-all-local-variables)
(use-local-map mu-headers-mode-map) (use-local-map mu-headers-mode-map)
(make-variable-buffer-local 'mu-parent-buffer)
(make-variable-buffer-local 'mu-headers-expression) (make-local-variable 'mu-buf)
(make-variable-buffer-local 'mu-headers-process) (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 (setq
major-mode 'mu-headers-mode mode-name "*headers*" major-mode 'mu-headers-mode mode-name "*headers*"
mu-buf ""
truncate-lines t buffer-read-only t truncate-lines t buffer-read-only t
overwrite-mode 'overwrite-mode-binary)) overwrite-mode 'overwrite-mode-binary))
@ -245,13 +284,13 @@ set text property 'path"
(defun mu-headers-view () (defun mu-headers-view ()
"display the message at the current line" "display the message at the current line"
(interactive) (interactive)
(let ((path (mu-get-path))) (let ((path (mu-headers-get-path)))
(when path (mu-view path (current-buffer))))) (when path (mu-view path (current-buffer)))))
(defun mu-headers-next () (defun mu-headers-next ()
"go to the next line; t if it worked, nil otherwise" "go to the next line; t if it worked, nil otherwise"
(interactive) (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) (progn (message "No message after this one") nil)
t)) t))
@ -310,170 +349,75 @@ if the search process is not already running"
(and (call-interactively 'mu-headers-change-sort-order) (and (call-interactively 'mu-headers-change-sort-order)
(call-interactively 'mu-headers-change-sort-direction))) (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 (defun mu-headers-remove-marked ()
;; character at the start of the line; this propertized character holds an (let ((bol (line-beginning-position 1)))
;; 'action property, which tells what to do with this one (e.g.,'d'-> trash, (if (not (gethash bol mu-headers-marks-hash))
;; 'D'->delete, 'm'->'move'). 'u' (unmark) removes this mark, 'U' removes (progn (message "Message is not marked") nil)
;; all-marks. 'x'->mu-headers-execute removes all marks (progn (remhash bol mu-headers-marks-hash) t))))
(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-get-marked () (defun mu-headers-set-marker (kar)
"get all marked messages in the current buffer as a list; each "set the marker at the beginning of this line"
element is a cell; with 'action', 'source' , 'target'). ie one of (beginning-of-line 1)
three: (let ((inhibit-read-only t))
('delete <path>) (delete-char 2)
('trash <path> <target>) (insert (if kar kar " ") " ")))
('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-marked-execute () (defun mu-headers-mark (action)
"execute marked actions on messages in the current buffer" "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) (interactive)
(let* ((markedcount (mu-headers-count-marked)) (let ((n-marked (hash-table-count mu-headers-marks-hash)))
(movenum (nth 0 markedcount)) (trashnum (nth 1 markedcount)) (if (= 0 n-marked)
(deletenum (nth 2 markedcount))) (message "No marked messages")
(if (= 0 (apply '+ markedcount)) (when (y-or-n-p
(message "No messages are marked") (format "Execute actions for %d marked message(s)? " n-marked))
(if (and (< 0 movenum) (save-excursion
(y-or-n-p (format "Do you want to move %d message(s)?" movenum))) (maphash
(message "Moving message(s)")) (lambda(bol v)
(if (and (< 0 trashnum) (let ((src (car v)) (target (cdr v)) (inhibit-read-only t))
(y-or-n-p (format "Do you want to move %d message(s) to trash?" trashnum))) (when (mu-message-move src target)
(message "Trashing message(s)")) (goto-char bol)
(if (and (< 0 deletenum) (mu-headers-remove-marked)
(yes-or-no-p (format "Do you want to permanently delete %d message(s)?" (put-text-property bol (line-beginning-position 2)
deletenum))) 'face 'invisible)))) ;; when it succeedes, hide msg..)
(let ((failed (mu-headers-executed-marked 'delete))) mu-headers-marks-hash))))))
(if (/= 0 failed)
(message "Failed to delete %d of %d message(s)" failed deletenum)
(message "%d message(s) deleted" deletenum)
(mu-headers-refresh)))))))
(defun mu-headers-mark-for-move () (interactive) (mu-headers-mark 'move))
(defun mu-headers-executed-marked (execute-action) (defun mu-headers-mark-for-trash () (interactive) (mu-headers-mark 'trash))
"handle marked headers for action; return the number of failed (defun mu-headers-mark-for-delete () (interactive) (mu-headers-mark 'delete))
actions" (defun mu-headers-unmark () (interactive) (mu-headers-mark 'unmark))
(let ((failed 0)) (defun mu-headers-unmark-all () (interactive) (mu-headers-mark 'unmark-all))
(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) (provide 'mu-headers)

View File

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

View File

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

View File

@ -44,7 +44,7 @@
(define-key mu-headers-mode-map "U" 'mu-headers-unmark-all) (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 "r" 'mu-headers-reply)
(define-key mu-headers-mode-map "f" 'mu-headers-forward) (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) (define-key mu-view-mode-map "q" 'mu-quit-buffer)