mirror of https://github.com/djcb/mu.git
* rough beginnings of an emacs client for mu
This commit is contained in:
Dirk-Jan C. Binnema
parent
abeeb33100
commit
f35c144192
|
|
@ -0,0 +1,31 @@
|
|||
VERSION=$(shell git describe --tags --dirty)
|
||||
EMACS=emacs
|
||||
PREFIX=/usr/local
|
||||
ELS=mu.el mu-common.el mu-view.el mu-find.el
|
||||
ELCS=$(ELS:.el=.elc)
|
||||
|
||||
.PHONY=install
|
||||
|
||||
BATCH=$(EMACS) -batch -q -no-site-file -eval \
|
||||
"(setq load-path (cons (expand-file-name \".\") load-path))"
|
||||
|
||||
%.elc: %.el
|
||||
$(BATCH) --eval '(byte-compile-file "$<")'
|
||||
|
||||
all: $(ELCS)
|
||||
|
||||
docs: mu.info
|
||||
|
||||
install_lisp:
|
||||
mkdir -p $(DESTDIR)/$(PREFIX)/share/emacs/site-lisp
|
||||
install -m 644 $(ELS) $(ELCS) $(DESTDIR)/$(PREFIX)/share/emacs/site-lisp
|
||||
|
||||
install_docs: docs
|
||||
mkdir -p $(DESTDIR)/$(PREFIX)/share/info
|
||||
install -m 644 mu.info $(DESTDIR)/$(PREFIX)/share/info
|
||||
install-info --info-dir=$(DESTDIR)/$(PREFIX)/share/info $(DESTDIR)/$(PREFIX)/share/info/mu.info
|
||||
|
||||
install: install_lisp install_docs
|
||||
|
||||
clean:
|
||||
rm -fr mu.info $(ELCS)
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
;;; mu-common.el -- part of mu
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; 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
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu message has functions to display a message
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
|
||||
(defvar mu-binary "/home/djcb/src/mu/src/mu" "name/path of the mu executable")
|
||||
(defvar mu-muile-binary "/home/djcb/src/mu/toys/muile/muile"
|
||||
"name/path of the muile executable")
|
||||
(defvar mu-home nil
|
||||
"path where mu stores it's data or nil for the defaults (typically, ~/.mu)")
|
||||
|
||||
(defvar mu-date-format-short "%x %X" "date format (in strftime(2)
|
||||
notation) e.g. for mail headers")
|
||||
|
||||
(defvar mu-date-format-long "%c" "date format (in strftime(2)
|
||||
notation) for the mail view and in replied/forwarded message quotations")
|
||||
|
||||
|
||||
(defvar mu-folder-draft "/home/djcb/Maildir/")
|
||||
|
||||
(defface mu-date-face '((t (:foreground "#8c5353"))) "")
|
||||
(defface mu-subject-face '((t (:foreground "#dfaf8f"))) "")
|
||||
(defface mu-from-face '((t (:foreground "#7f9f7f"))) "")
|
||||
(defface mu-to-face '((t (:foreground "#7f6655"))) "")
|
||||
(defface mu-cc-face '((t (:foreground "#7f6666"))) "")
|
||||
(defface mu-bcc-face '((t (:foreground "#7f6677"))) "")
|
||||
(defface mu-body-face '((t (:foreground "#8cd0d3"))) "")
|
||||
(defface mu-header-face '((t (:foreground "#7f9f7f"))) "")
|
||||
(defface mu-size-face '((t (:foreground "#889f7f"))) "")
|
||||
(defface mu-body-face '((t (:foreground "#dcdccc"))) "")
|
||||
(defface mu-flag-face '((t (:foreground "#dc56cc"))) "")
|
||||
|
||||
(defface mu-unread-face '((t (:bold t))) "")
|
||||
(defface mu-face '((t (:foreground "Gray" :italic t))) "")
|
||||
|
||||
(defvar mu-own-address "djcb" "regexp matching my own address")
|
||||
|
||||
(defun mu-binary-version ()
|
||||
"get the version of the mu binary"
|
||||
(let ((cmd (concat mu-binary
|
||||
" --version | head -1 | sed 's/.*version //'")))
|
||||
(substring (shell-command-to-string cmd) 0 -1)))
|
||||
|
||||
(defun mu-inspect (path)
|
||||
"inspect message in a guile environment"
|
||||
(let ((cmd (concat mu-muile-binary " --msg='" path "'")))
|
||||
(ansi-term cmd "*mu-inspect")))
|
||||
|
||||
;; (defalias mu-find mu-headers-find)
|
||||
;; (defalias mu-display mu-message-display)
|
||||
|
||||
(defun mu-str (str)
|
||||
"return STR propertized as a mu string (for info, warnings
|
||||
etc.)"
|
||||
(propertize str 'face 'mu-face 'intangible t))
|
||||
|
||||
(setq mu-find-fields
|
||||
'(
|
||||
(:date . 20)
|
||||
(:flags . 4)
|
||||
(:from-or-to . 22)
|
||||
(:size . 8)
|
||||
(:subject . 40)))
|
||||
(setq mu-find-date-format "%x %X")
|
||||
|
||||
(setq mu-own-address-regexp "djcb\\|diggler\\|bulkmeel")
|
||||
|
||||
|
||||
(provide 'mu-common)
|
||||
|
|
@ -0,0 +1,365 @@
|
|||
;;; mu-find.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; 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
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mu-common)
|
||||
|
||||
(defvar mu-find-fields
|
||||
'( (:date . 25)
|
||||
(:from-or-to . 22)
|
||||
(:subject . 40))
|
||||
"a list of fields and their widths")
|
||||
|
||||
(defvar mu-find-sort-field "date"
|
||||
"shortcut of the field to sort on (see mu-find (1))")
|
||||
(defvar mu-find-sort-descending nil
|
||||
"whether to sort in descending order")
|
||||
|
||||
;; internal stuff
|
||||
(defconst mu-find-buffer-name " *mu-find*" "name of the mu
|
||||
results buffer; name should start with a space")
|
||||
(defvar mu-find-process nil "the possibly running find process")
|
||||
(defconst mu-find-process-name "*<mu-find-process>*" "name of the mu
|
||||
results buffer; name should start with a space")
|
||||
(defconst mu-eom "\n;;eom\n" "marker for the end of message in
|
||||
the mu find output")
|
||||
(defvar mu-find-expression nil
|
||||
"search expression for the current find buffer")
|
||||
|
||||
(defvar mu-buf "" "buffer for results data")
|
||||
(defun mu-find-process-filter (proc str)
|
||||
"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"
|
||||
(with-current-buffer mu-find-buffer-name
|
||||
(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))
|
||||
(save-match-data (insert (mu-find-header msg) ?\n)))
|
||||
(setq mu-buf (substring mu-buf (match-end 0)))
|
||||
(setq eom (string-match mu-eom mu-buf)))))))
|
||||
|
||||
(defun mu-find-process-sentinel (proc msg)
|
||||
"Check the mu-find 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)
|
||||
(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-find returned %d"
|
||||
exit-status))))
|
||||
(t "Unknown status")))) ;; shouldn't happen
|
||||
(when (get-buffer mu-find-buffer-name)
|
||||
(with-current-buffer mu-find-buffer-name
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert (mu-str text)))))))))
|
||||
|
||||
(defun mu-find (expr)
|
||||
"search in the mu database"
|
||||
(interactive "s[mu] match expr: ")
|
||||
(let* ((output (get-buffer mu-find-buffer-name)))
|
||||
(when output (kill-buffer output))
|
||||
(setq output (get-buffer-create mu-find-buffer-name) mu-buf "")
|
||||
(let* ((dummy-arg "--fields=\"dummy\"") ;; ignored
|
||||
(proc
|
||||
(start-process mu-find-process-name mu-find-process-name
|
||||
mu-binary
|
||||
"find"
|
||||
(if mu-home
|
||||
(concat "--muhome=" mu-home) dummy-arg)
|
||||
(if mu-find-sort-field
|
||||
(concat "--sortfield=" mu-find-sort-field) dummy-arg)
|
||||
(if mu-find-sort-descending "--descending" dummy-arg)
|
||||
"--format=sexp"
|
||||
"--quiet"
|
||||
expr)))
|
||||
(set-process-filter proc 'mu-find-process-filter)
|
||||
(set-process-sentinel proc 'mu-find-process-sentinel)
|
||||
(setq mu-find-process proc)
|
||||
(switch-to-buffer output)
|
||||
(setq mu-find-expression expr)
|
||||
;; (make-variable-buffer-local mu-find-expression)
|
||||
(mu-find-mode))))
|
||||
|
||||
(defun mu-find-display-contact (lst width face)
|
||||
"display a list of contacts, truncated for fitting in WIDTH"
|
||||
(if lst
|
||||
(let* ((len (length lst))
|
||||
(str (if (= len 0) "<none>"
|
||||
;; try name -> email -> ?
|
||||
(or (car(car lst)) (cdr(car lst)) "?")))
|
||||
(others (if (> len 1) (mu-str (format " [+%d]" (- len 1))) "")))
|
||||
(truncate-string-to-width
|
||||
(concat(propertize (truncate-string-to-width str
|
||||
(- width (length others)) 0 ?\s "...") 'face face) others)
|
||||
width 0 ?\s))
|
||||
(make-string width ?\s)))
|
||||
|
||||
|
||||
(defun mu-find-display-from-or-to (fromlst tolst width from-face to-face)
|
||||
"return a propertized string for FROM unless TO matches
|
||||
mu-own-address, in which case it returns TO, prefixed with To:"
|
||||
(if (and fromlst tolst)
|
||||
(let ((fromaddr (cdr(car fromlst))))
|
||||
(if (and fromaddr (string-match mu-own-address fromaddr))
|
||||
(concat (mu-str "To ") (mu-find-display-contact tolst (- width 3) to-face))
|
||||
(mu-find-display-contact fromlst width from-face)))
|
||||
(make-string width ?\s)))
|
||||
|
||||
(defun mu-find-display-size (size width face)
|
||||
"return a string for SIZE of WIDTH with FACE"
|
||||
(let* ((str
|
||||
(cond
|
||||
((>= size 1000000) (format "%2.1fM" (/ size 1000000.0)))
|
||||
((and (>= size 1000) (< size 1000000)) (format "%2.1fK" (/ size 1000.0)))
|
||||
((< size 1000) (format "%d" size)))))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
||||
|
||||
|
||||
(defun mu-find-display-str (str width face)
|
||||
"print a STR, at WIDTH (truncate or ' '-pad) with FACE"
|
||||
(let ((str (if str str "")))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s t) 'face face)))
|
||||
|
||||
(defun mu-find-display-flags (flags width face)
|
||||
(let ((str
|
||||
(mapconcat
|
||||
(lambda(flag)
|
||||
(let ((flagname (symbol-name flag)))
|
||||
(cond
|
||||
((string= flagname "unread") "U")
|
||||
((string= flagname "seen") "S")
|
||||
((string= flagname "replied") "R")
|
||||
((string= flagname "attach") "a")
|
||||
((string= flagname "encrypted") "x")
|
||||
((string= flagname "signed") "s")))) flags "")))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
||||
|
||||
(defun mu-find-header (msg)
|
||||
"convert a message s-expression into a header for display"
|
||||
(let ((hdr (concat " " (mapconcat
|
||||
(lambda (fieldinfo)
|
||||
(let ((field (car fieldinfo)) (width (cdr fieldinfo)))
|
||||
(case field
|
||||
(:date
|
||||
(mu-find-display-str (format-time-string mu-date-format-short
|
||||
(plist-get msg :date)) width 'mu-date-face))
|
||||
(:from
|
||||
(mu-find-display-contact (plist-get msg :from) width 'mu-from-face))
|
||||
(:to
|
||||
(mu-find-display-contact (plist-get msg :to) width 'mu-to-face))
|
||||
(:cc
|
||||
(mu-find-display-contact (plist-get msg :cc) width 'mu-cc-face))
|
||||
(:bcc
|
||||
(mu-find-display-contact (plist-get msg :bcc) width 'mu-bcc-face))
|
||||
(:flags
|
||||
(mu-find-display-flags (plist-get msg :flags) width 'mu-flag-face))
|
||||
(:size
|
||||
(mu-find-display-size (plist-get msg :size) width 'mu-size-face))
|
||||
(:from-or-to
|
||||
(mu-find-display-from-or-to (plist-get msg :from)
|
||||
(plist-get msg :to) width 'mu-from-face 'mu-to-face))
|
||||
(:subject
|
||||
(mu-find-display-str (plist-get msg :subject) width
|
||||
'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))))
|
||||
|
||||
(defun mu-find-set-props-for-flags (hdr flags)
|
||||
"set text properties/faces based on flags"
|
||||
(if (memq 'unread flags)
|
||||
(add-text-properties 0 (- (length hdr) 1) '(face (:weight bold)) hdr))
|
||||
hdr)
|
||||
|
||||
|
||||
(defun mu-find-mode ()
|
||||
"major mode for displaying search results"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mu-find-mode-map)
|
||||
(setq
|
||||
major-mode 'mu-find-mode mode-name "*headers*"
|
||||
truncate-lines t buffer-read-only t
|
||||
overwrite-mode 'overwrite-mode-binary))
|
||||
|
||||
(defvar mu-find-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "q" 'mu-find-quit)
|
||||
(define-key map "s" 'mu-find-change-sort)
|
||||
(define-key map "g" 'mu-find-refresh)
|
||||
(define-key map "m" 'mu-find-mark-for-move)
|
||||
(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)
|
||||
map)
|
||||
"Keymap for \"mu-find\" buffers.")
|
||||
(fset 'mu-find-mode-map mu-find-mode-map)
|
||||
|
||||
|
||||
(defun mu-find-message-display ()
|
||||
"display the message at the current line"
|
||||
(interactive)
|
||||
(let ((path (mu-find-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)))
|
||||
(progn (message "No message after this one") nil)
|
||||
t))
|
||||
|
||||
(defun mu-find-prev ()
|
||||
"go to the next line; t if it worked, nil otherwise"
|
||||
(interactive)
|
||||
(if (/= 0 (forward-line -1))
|
||||
(progn (message "No message before this one") nil)
|
||||
t))
|
||||
|
||||
(defun mu-find-refresh ()
|
||||
"re-run the query for the current search expression"
|
||||
(interactive)
|
||||
(unless (and mu-find-process
|
||||
(eq (process-status mu-find-process) 'run))
|
||||
(when mu-find-expression
|
||||
(mu-find mu-find-expression))))
|
||||
|
||||
(defun mu-find-change-sort-order (fieldchar)
|
||||
"change the sortfield to FIELDCHAR"
|
||||
(interactive"cField to sort by ('d', 's', etc.; see mu-find(1)):\n")
|
||||
(let
|
||||
((field
|
||||
(case fieldchar
|
||||
(?b "bcc")
|
||||
(?c "cc")
|
||||
(?d "date")
|
||||
(?f "from")
|
||||
(?i "msgid")
|
||||
(?m "maildir")
|
||||
(?p "prio")
|
||||
(?s "subject")
|
||||
(?t "to")
|
||||
(?z "size"))))
|
||||
(if field
|
||||
(setq mu-find-sort-field field)
|
||||
(message "Invalid sort-field; use one of bcdfimpstz (see mu-find(1)"))
|
||||
field))
|
||||
|
||||
(defun mu-find-change-sort-direction (dirchar)
|
||||
"change the sort direction, either [a]scending or [d]escending"
|
||||
(interactive
|
||||
"cSorting direction ([a]scending or [d]escending):")
|
||||
(cond
|
||||
(?d (setq mu-find-sort-descending t) t)
|
||||
(?a (setq mu-find-sort-descending nil) t)
|
||||
(t (message
|
||||
"Invalid sort-direction; choose either [a]scending or [d]escending") nil)))
|
||||
|
||||
(defun mu-find-mark (what)
|
||||
"mark the current msg for 'trash, 'move, 'none"
|
||||
(when (mu-find-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")
|
||||
(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 " ")))
|
||||
(forward-line))))))
|
||||
|
||||
(defun mu-find-mark-for-deletion ()
|
||||
(interactive)
|
||||
(mu-find-mark 'trash))
|
||||
|
||||
(defun mu-find-mark-for-move ()
|
||||
(interactive)
|
||||
(mu-find-mark 'move))
|
||||
|
||||
(defun mu-find-unmark ()
|
||||
(interactive)
|
||||
(mu-find-mark 'none))
|
||||
|
||||
(defun mu-find-change-sort ()
|
||||
"change sort field and direction"
|
||||
(interactive)
|
||||
(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)
|
||||
|
||||
|
|
@ -0,0 +1,114 @@
|
|||
;;; mu-message.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; 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
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu-message contains code to generate a message for composing, replying or
|
||||
;; forwarding
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar mu-message-citation-prefix " > "
|
||||
"string to prefix cited message parts with")
|
||||
|
||||
(defvar mu-message-reply-prefix "Re:"
|
||||
"string to prefix the subject of replied messages with")
|
||||
|
||||
(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
|
||||
|
||||
(defun mu-message-attribution (msg)
|
||||
"get an attribution line for a quoted message"
|
||||
(format "On %s, %s wrote:\n"
|
||||
(format-time-string mu-date-format-long (plist-get msg :date))
|
||||
(cdr (car (plist-get msg :from)))))
|
||||
|
||||
(defun mu-message-cite (msg)
|
||||
"cite an existing message"
|
||||
(let ((body
|
||||
(or (plist-get msg :body-txt)
|
||||
(let ((html (plist-get msg :body-html)))
|
||||
(when html
|
||||
(with-temp-buffer (insert html) (html2text) (buffer-string))))
|
||||
"")))
|
||||
(replace-regexp-in-string "^" " > " body)))
|
||||
|
||||
|
||||
(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)
|
||||
"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*"))))
|
||||
(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
|
||||
(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
|
||||
"--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 (path)
|
||||
"create a reply to the message at PATH; After creation, switch
|
||||
to the message editor"
|
||||
(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))
|
||||
|
|
@ -0,0 +1,153 @@
|
|||
;;; mu-view.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; 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
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu message has functions to display a message
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mu-common)
|
||||
|
||||
(defvar mu-view-header-fields
|
||||
'( :from
|
||||
:to
|
||||
:subject
|
||||
:date)
|
||||
"list of header fields to display in the message view")
|
||||
|
||||
(defconst mu-view-buffer-name " *mu-view*")
|
||||
|
||||
(defun mu-view-get (path)
|
||||
"display the email message at PATH"
|
||||
(let* ((cmd (concat mu-binary " view --format=sexp " path))
|
||||
(str (shell-command-to-string cmd))
|
||||
(msglst (read-from-string str)))
|
||||
(when msglst (car msglst))))
|
||||
|
||||
(defun mu-view-header (field val val-face)
|
||||
"get a header string (like 'Subject: foo')"
|
||||
(when val
|
||||
(concat (propertize field 'face 'mu-header-face) ": "
|
||||
(propertize val 'face val-face) "\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-body (msg face)
|
||||
"view the body; try text first, if that does not work, try html"
|
||||
(cond
|
||||
((plist-get msg :body-txt) (propertize (plist-get msg :body-txt) 'face face))
|
||||
((plist-get msg :body-html)
|
||||
(propertize
|
||||
(with-temp-buffer
|
||||
(insert (plist-get msg :body-html))
|
||||
(html2text)
|
||||
(buffer-string))'face face))
|
||||
(t "")))
|
||||
|
||||
(defun mu-view-message (path)
|
||||
"display the email message at PATH"
|
||||
(let ((msg (mu-view-get path)))
|
||||
(when msg
|
||||
(concat
|
||||
(mapconcat
|
||||
(lambda (field)
|
||||
(case field
|
||||
(:from (mu-view-header-contact "From"
|
||||
(plist-get msg :from) 'mu-from-face))
|
||||
(:to
|
||||
(mu-view-header-contact "To" (plist-get msg :to) 'mu-to-face))
|
||||
(:cc
|
||||
(mu-view-header-contact "Cc" (plist-get msg :cc) 'mu-to-face))
|
||||
(:bcc
|
||||
(mu-view-header-contact "Bcc" (plist-get msg :bcc) 'mu-to-face))
|
||||
(:subject
|
||||
(mu-view-header "Subject" (plist-get msg :subject) 'mu-subject-face))
|
||||
(:date
|
||||
(mu-view-header "Date"
|
||||
(format-time-string mu-date-format-long
|
||||
(plist-get msg :date)) 'mu-date-face))))
|
||||
mu-view-header-fields "")
|
||||
"\n"
|
||||
(mu-view-body msg 'mu-body-face)
|
||||
))))
|
||||
|
||||
(defun mu-view (path)
|
||||
"display message at PATH in a new buffer"
|
||||
(interactive)
|
||||
(let ((str (mu-view-message path))
|
||||
(buf (get-buffer mu-view-buffer-name)))
|
||||
(when str
|
||||
(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))
|
||||
(switch-to-buffer mu-view-buffer-name)
|
||||
(mu-view-mode)
|
||||
(goto-char (point-min))))))
|
||||
|
||||
(defun mu-view-mode ()
|
||||
"major mode for viewing an e-mail message"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mu-view-mode-map)
|
||||
(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)))))
|
||||
|
||||
(defun mu-view-prev ()
|
||||
(interactive)
|
||||
(with-current-buffer mu-find-buffer-name
|
||||
(when (mu-find-prev)
|
||||
(mu-view (mu-find-get-path)))))
|
||||
|
||||
(provide 'mu-view)
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
;;; mu.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; 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
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'mu-find)
|
||||
(require 'mu-view)
|
||||
(require 'mu-message)
|
||||
|
||||
(define-key mu-find-mode-map "q" 'mu-find-quit)
|
||||
(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 "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 "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-view-mode-map "q" 'mu-view-quit)
|
||||
(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)
|
||||
|
||||
|
||||
(provide 'mu)
|
||||
|
||||
Loading…
Reference in New Issue