* emacs/*: many changes, still in initial stages...

This commit is contained in:
Dirk-Jan C. Binnema 2011-08-01 21:22:03 +03:00
parent f35c144192
commit 8ee5427975
5 changed files with 151 additions and 96 deletions

View File

@ -92,5 +92,60 @@ etc.)"
(setq mu-own-address-regexp "djcb\\|diggler\\|bulkmeel")
(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"
(let ((match 0) (kars '()))
(while match
(setq match (string-match "\\[\\(.\\)\\]" prompt match))
(when match
(setq kars (cons (match-string 1 prompt) kars))
(setq match (+ 1 match))))
(let ((kar)
(prompt (replace-regexp-in-string
"\\[\\(.\\)\\]"
(lambda(s) (propertize (substring s 1 -1) 'face 'highlight))
prompt)))
(while (not kar)
(setq kar (read-char-exclusive prompt))
(unless (member (string kar) kars)
(setq kar nil)))
kar)))
;; both in mu-find.el and mu-view.el we have the path as a text property; in the
;; latter case we could have use a buffer-local variable, but using a
;; text-property makes this function work for both
(defun mu-get-path ()
"get the path (a string) of the message at point or nil if it
is not found; this works both for the header list and when
viewing a message"
(let ((path (get-text-property (point) 'path)))
(unless path (message "No message at point"))
path))
(defun mu-reply ()
"reply to the message at point"
(interactive)
(let ((path (mu-get-path)))
(when path (mu-message-reply path))))
(defun mu-forward ()
"forward the message at point"
(interactive)
(let ((path (mu-find-get-path)))
(when path (mu-message-forward path))))
;; todo: check for unhandled marks
(defun mu-quit-buffer ()
"kill this find or view buffer"
(interactive)
(if (or (equalp major-mode 'mu-find-mode)
(equalp major-mode 'mu-view-mode))
(kill-buffer)))
(provide 'mu-common)

View File

@ -200,7 +200,7 @@ the mu find output")
'mu-subject-face)))))
mu-find-fields " "))))
(setq hdr (mu-find-set-props-for-flags hdr (plist-get msg :flags)))
(propertize hdr 'path (plist-get msg :path))))
(propertize hdr 'path (plist-get msg :path) 'front-sticky t)))
(defun mu-find-set-props-for-flags (hdr flags)
"set text properties/faces based on flags"
@ -221,37 +221,34 @@ the mu find output")
(defvar mu-find-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" 'mu-find-quit)
(define-key map "q" 'mu-quit-buffer)
(define-key map "s" 'mu-find-change-sort)
(define-key map "g" 'mu-find-refresh)
;; marking/unmarking
(define-key map "m" 'mu-find-mark-for-move)
(define-key map "d" 'mu-find-mark-for-deletion)
(define-key map "d" 'mu-find-mark-for-trash)
(define-key map "D" 'mu-find-mark-for-deletion)
(define-key map "u" 'mu-find-unmark)
(define-key map "r" 'mu-find-reply)
(define-key map "f" 'mu-find-forward)
(define-key map (kbd "RET") 'mu-find-message-display)
;; message composition
(define-key map "r" 'mu-reply)
(define-key map "f" 'mu-forward)
(define-key map (kbd "RET") 'mu-find-view)
map)
"Keymap for \"mu-find\" buffers.")
(fset 'mu-find-mode-map mu-find-mode-map)
(defun mu-find-message-display ()
(defun mu-find-view ()
"display the message at the current line"
(interactive)
(let ((path (mu-find-get-path)))
(let ((path (mu-get-path)))
(when path (mu-view path))))
(defun mu-find-quit ()
"kill this headers buffer"
(interactive)
(when (equalp major-mode 'mu-find-mode)
(kill-buffer)))
(defun mu-find-next ()
"go to the next line; t if it worked, nil otherwise"
(interactive)
(if (or (/= 0 (forward-line 1)) (not (mu-find-get-path)))
(if (or (/= 0 (forward-line 1)) (not (mu-get-path)))
(progn (message "No message after this one") nil)
t))
@ -303,23 +300,31 @@ the mu find output")
(defun mu-find-mark (what)
"mark the current msg for 'trash, 'move, 'none"
(when (mu-find-get-path)
(when (mu-get-path)
(move-beginning-of-line 1)
(let ((inhibit-read-only t) (overwrite-mode nil))
(if (get-text-property (point) 'action)
(message "Message is already marked")
(if (and (not (eq what 'none)) (get-text-property (point) 'action))
(message "Message at pooint is already marked")
(progn
(delete-char 1)
(case what
('trash (insert-and-inherit (mu-str (propertize "d" 'action what))))
('move (insert-and-inherit (mu-str (propertize "m" 'action what))))
('none (insert-and-inherit " ")))
(delete-char 1)
(case what
('trash (insert-and-inherit
(mu-str (propertize "d" 'action what))))
('delete (insert-and-inherit
(mu-str (propertize "D" 'action what))))
('move (insert-and-inherit
(mu-str (propertize "m" 'action what))))
('none (insert-and-inherit " ")))
(forward-line))))))
(defun mu-find-mark-for-deletion ()
(defun mu-find-mark-for-trash ()
(interactive)
(mu-find-mark 'trash))
(defun mu-find-mark-for-deletion ()
(interactive)
(mu-find-mark 'delete))
(defun mu-find-mark-for-move ()
(interactive)
(mu-find-mark 'move))
@ -334,32 +339,5 @@ the mu find output")
(and (call-interactively 'mu-find-change-sort-order)
(call-interactively 'mu-find-change-sort-direction)))
(defun mu-find-inspect ()
"inspect this message in a Scheme environment"
(interactive)
(let ((path (mu-find-get-path)))
(when path (mu-inspect path))))
(defun mu-find-get-path ()
"get the path of the message at point"
(let ((path (get-text-property (point) 'path)))
(unless path (message "No message at this line"))
path))
(defun mu-find-reply ()
"reply to the message at point"
(interactive)
(let ((path (mu-find-get-path)))
(when path
(mu-message-reply (mu-find-get-path)))))
(defun mu-find-forward ()
"forward the message at point"
(interactive)
(let ((path (mu-find-get-path)))
(when path
(mu-message-forward (mu-find-get-path)))))
(provide 'mu-find)

View File

@ -27,8 +27,9 @@
;; forwarding
;;; Code:
(require 'mu-common)
(defvar mu-message-citation-prefix " > "
(defvar mu-message-citation-prefix "> "
"string to prefix cited message parts with")
(defvar mu-message-reply-prefix "Re:"
@ -37,9 +38,12 @@
(defvar mu-message-forward-prefix "Fwd:"
"string to prefix the subject of forwarded messages with")
(defun mu-message-user-agent ()
(format "mu %s; emacs %s" (mu-binary-version) emacs-version))7
(format "mu %s; emacs %s" (mu-binary-version) emacs-version))
(defun mu-message-attribution (msg)
"get an attribution line for a quoted message"
@ -57,28 +61,41 @@
"")))
(replace-regexp-in-string "^" " > " body)))
(defun mu-message-recipients-remove (email lst)
"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)))
(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"
(mapconcat
(lambda (recip)
(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)
(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"
(let* ((cmd (concat mu-binary " view --format=sexp " path))
(str (shell-command-to-string cmd))
(msglst (read-from-string str))
(msg (car msglst))
(buf (get-buffer-create (generate-new-buffer-name "*mu-draft*"))))
(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 mail-reply-to
(when (boundp 'mail-reply-to)
(insert (format "Reply-To: %s\n" mail-reply-to)))
(if forward
(insert
"To:\n"
@ -92,7 +109,7 @@ create a forwarded message. After creation, switch to the message editor"
(mu-message-attribution msg)
(mu-message-cite msg))
(when mail-signature (insert mail-signature))
;; (when mail-signature (insert mail-signature))
(message-mode)
@ -106,9 +123,12 @@ 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"
(mu-ask-key "Reply to [s]ender only or to [a]ll?")
(mu-message-reply-or-forward path))
(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))
(provide 'mu-message)

View File

@ -107,11 +107,25 @@
(when buf (kill-buffer buf))
(get-buffer-create mu-view-buffer-name)
(with-current-buffer mu-view-buffer-name
(let ((inhibit-read-only t)) (insert str))
(let ((inhibit-read-only t))
;; note, we set the path as a text-property
(insert (propertize str 'path path)))
(switch-to-buffer mu-view-buffer-name)
(mu-view-mode)
(goto-char (point-min))))))
(defvar mu-view-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" 'mu-view-quit-buffer)
(define-key map "s" 'mu-find)
(define-key map "f" 'mu-forward)
(define-key map "r" 'mu-reply)
(define-key map "n" 'mu-view-next)
(define-key map "p" 'mu-view-prev)
map)
"Keymap for \"mu-view\" buffers.")
(fset 'mu-view-mode-map mu-view-mode-map)
(defun mu-view-mode ()
"major mode for viewing an e-mail message"
(interactive)
@ -120,34 +134,22 @@
(setq major-mode 'mu-view-mode mode-name "*mu-view*")
(setq truncate-lines t buffer-read-only t))
(defvar mu-view-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" 'mu-view-quit)
(define-key map "s" 'mu-find)
(define-key map "n" 'mu-view-next)
(define-key map "p" 'mu-view-prev)
map)
"Keymap for \"mu-view\" buffers.")
(fset 'mu-view-mode-map mu-view-mode-map)
(defun mu-view-quit ()
"kill this headers buffer"
(interactive)
(when (equalp major-mode 'mu-view-mode)
(kill-buffer)
(if (get-buffer mu-find-buffer-name)
(switch-to-buffer mu-find-buffer-name))))
(defun mu-view-next ()
(interactive)
(with-current-buffer mu-find-buffer-name
(when (mu-find-next)
(mu-view (mu-find-get-path)))))
(mu-view (mu-get-path)))))
(defun mu-view-prev ()
(interactive)
(with-current-buffer mu-find-buffer-name
(when (mu-find-prev)
(mu-view (mu-find-get-path)))))
(mu-view (mu-get-path)))))
(defun mu-view-quit-buffer ()
"quit this buffer and return to the find buffer"
(interactive)
(mu-quit-buffer)
(switch-to-buffer mu-find-buffer-name))
(provide 'mu-view)

View File

@ -28,28 +28,28 @@
(require 'mu-view)
(require 'mu-message)
(define-key mu-find-mode-map "q" 'mu-find-quit)
(define-key mu-find-mode-map "q" 'mu-quit-buffer)
(define-key mu-find-mode-map "f" 'mu-find)
(define-key mu-find-mode-map "i" 'mu-find-inspect)
(define-key mu-find-mode-map (kbd "<up>") 'mu-find-prev)
(define-key mu-find-mode-map (kbd "<down>") 'mu-find-next)
(define-key mu-find-mode-map (kbd "RET") 'mu-find-message-display)
(define-key mu-find-mode-map (kbd "RET") 'mu-find-view)
(define-key mu-find-mode-map "n" 'mu-find-next)
(define-key mu-find-mode-map "p" 'mu-find-prev)
(define-key mu-find-mode-map "o" 'mu-find-change-sort)
(define-key mu-find-mode-map "g" 'mu-find-refresh)
(define-key mu-find-mode-map "m" 'mu-find-mark-for-move)
(define-key mu-find-mode-map "d" 'mu-find-mark-for-deletion)
(define-key mu-find-mode-map "d" 'mu-find-mark-for-thrash)
(define-key mu-find-mode-map "D" 'mu-find-mark-for-deletion)
(define-key mu-find-mode-map "u" 'mu-find-unmark)
(define-key mu-find-mode-map "r" 'mu-find-reply)
(define-key mu-view-mode-map "f" 'mu-find-forward)
(define-key mu-find-mode-map "r" 'mu-reply)
(define-key mu-view-mode-map "f" 'mu-forward)
(define-key mu-view-mode-map "q" 'mu-view-quit)
(define-key mu-view-mode-map "q" 'mu-view-quit-buffer)
(define-key mu-view-mode-map "f" 'mu-view-find)
(define-key mu-view-mode-map "n" 'mu-view-next)
(define-key mu-view-mode-map "p" 'mu-view-prev
(define-key mu-view-mode-map "r" 'mu-view-reply)
(define-key mu-view-mode-map "f" 'mu-view-forward)
(define-key mu-view-mode-map "p" 'mu-view-prev)
(define-key mu-view-mode-map "r" 'mu-reply)
(define-key mu-view-mode-map "f" 'mu-forward)
(provide 'mu)